行星号查询程序APPGETNAME.F90/星历表星号功用/

执行结果

E:/Fortran_G95>appgetname 3 4 11 15 16 12 星号 星名 NAME 方式 3 地球 EARTH 地月+月球 4 火星 MARS 火星 11 太阳 SUN 太阳 15 月球天平动 LIBRATIONS 天平动 12 太阳系质心 SOLARBARY 太阳系置0 OK E:/Fortran_G95>

源码：

!C--------------------------------------------------------------- !主程式开始! !C--------------------------------------------------------------- Program Main IMPLICIT DOUBLE PRECISION (A-G) integer nargin, I, QI(16), QLEN,IN,J,XH CHARACTER*128 argum(10) CHARACTER*130 tmpStr !参数处理 nargin=iargc() do i=1,nargin call getarg(i,argum(i),QLEN) end do if (nargin.EQ.0) go to 11 !测试函数 write(*,'(A4,3A12)') "星号","星名","NAME","方式" do i=1,nargin READ(argum(I),'(I2)',ERR=11) XH if (XH.LE.0.or.XH.GT.15) CYCLE CALL ShowXXNames(XH) end do STOP "OK" !// 11 do i=1,15 CALL ShowXXNames(I) end do stop "参数错误，请输入指定星号。格式：exe II[1-15](N个)" End Program !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !主程式结束 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ include "GETNAME.F90"

 

源码：GETNAME.F90

 !C--------------------------------------------------------------- !输出指定星号三项名称 !C--------------------------------------------------------------- SUBROUTINE ShowXXNames(XH) INTEGER I,XH !函数声明 CHARACTER*10 GETXXNAME_CN,GETXXNAME_EN,GETXXDATA_CN,GETXXTYPE_CN EXTERNAL GETXXNAME_CN,GETXXNAME_EN,GETXXDATA_CN,GETXXTYPE_CN Write(*,'(i4,3A12)') XH,GETXXNAME_CN(XH),GETXXNAME_EN(XH),GETXXTYPE_CN(XH) END !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !取星名 !C--------------------------------------------------------------- Function GETXXNAME_CN (XH) CHARACTER*10 XNAME(15),GETXXNAME_CN INTEGER I,XH DATA (XNAME(i),i=1,5) /'水星','金星','地球','火星','木星'/ DATA (XNAME(i),i=6,9) /'土星','海王星','天王星','冥王星'/ DATA (XNAME(i),i=10,12) /'月球','太阳','太阳系质心'/ DATA (XNAME(i),i=13,15) /'地月系质心','章动','月球天平动'/ GETXXNAME_CN=XNAME(XH) RETURN End !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !取星名 !C--------------------------------------------------------------- Function GETXXNAME_EN (XH) CHARACTER*10 XNAME(15),GETXXNAME_EN INTEGER I,XH DATA (XNAME(i),i=1,4) /'MERCURY','VENUS','EARTH','MARS'/ DATA (XNAME(i),i=5,8) /'JUPITER','SATURN','URANUS','NEPTUNE'/ DATA (XNAME(i),i=9,12) /'PLUTO','MOON','SUN','SOLARBARY'/ DATA (XNAME(i),i=13,14) /'EARTHMBARY','NUTATIONS'/ DATA (XNAME(i),i=15,15) /'LIBRATIONS'/ GETXXNAME_EN=XNAME(XH) RETURN End !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !取数据星名 !C--------------------------------------------------------------- Function GETXXDATA_CN (XH) CHARACTER*10 XNAME(15),GETXXDATA_CN INTEGER I,XH DATA (XNAME(i),i=1,5) /'水星','金星','地月系','火星','木星'/ DATA (XNAME(i),i=6,9) /'土星','海王星','天王星','冥王星'/ DATA (XNAME(i),i=10,12) /'月球','太阳','章动'/ DATA (XNAME(i),i=13,13) /'月球天平动'/ GETXXDATA_CN=XNAME(XH) RETURN End !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !取数据方式 !C--------------------------------------------------------------- Function GETXXTYPE_CN (XH) CHARACTER*10 XNAME(15),GETXXTYPE_CN INTEGER I,XH DATA (XNAME(i),i=1,5) /'水星','金星','地月+月球','火星','木星'/ DATA (XNAME(i),i=6,9) /'土星','海王星','天王星','冥王星'/ DATA (XNAME(i),i=10,12) /'地月-月球.','太阳','太阳系置0'/ DATA (XNAME(i),i=13,15) /'地月系','章动','天平动'/ GETXXTYPE_CN=XNAME(XH) RETURN End !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !程式结束 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 

注意，从现在开始代码都将使用F90的格式。

 

GROUP   1050
 
     3   171   231   309   342   366   387   405   423   441   753   819   899
    14    10    13    11     8     7     6     6     6    13    11    10    10
     4     2     2     1     1     1     1     1     1     8     2     4     4
 
GROUP   1070

第一行表示开始数据项。

第二行表示系数项数

第三行表示日期分块

 

隐含项，属性项。

除章动是2*2，共4项外，其它都是3*2，共6项。

第二行*第三行*属性项数=行星总项数

 

各行星项数相加+2即得KSIZE/2。