c Main program to test the subroutine READING c The following heading (part constraned with >>> and <<<) should be c copied to your own main program. c >>> implicit integer (i,j) implicit real*8 (a-h,k-z) CHARACTER*1 A1,RC,RH,QU1,QU2 CHARACTER*2 FQ,FE,QNT,ERR,SHN,QU CHARACTER*3 RET3 CHARACTER*4 AMPS,LIST,FLAG CHARACTER*7 MN CHARACTER*8 AIC CHARACTER*22 SELCAT DIMENSION LIST(31),YY(1000000,31),DYY(1000000,31) DIMENSION RC(1000000),RH(1000000) DIMENSION FQ(1000000,31),FE(1000000,31),AIC(1000000),MN(1000000) DIMENSION SHN(1000000),QU(1000000) SELCAT='CAMS_California_v2.d15' c <<< 10 continue write(*,*) 'Give a serial number (not IC) of a meteor:' read(*,*) jm 20 continue write(*,*) 'Give the number of parameter, which should be displaye *d for the above specified meteor:' write(*,*) '(The list of parameters with their numbers can be foun *d in the source code of this program,' write(*,*) 'in the beginning of sunroutine READING.)' read(*,*) jp if(jp.gt.31) then write(*,*) 'The database contains 31 parameters.' write(*,*) 'The chosen number of parameter must be equal or smal *ler than 31.' goto 20 endif call READING(SELCAT,FQ,FE,AIC,MN,QU,RC,RH,SHN,YY,DYY,J) if(jm.gt.J) then write(*,*) 'The total number of meteors in the selected catalog' write(*,*) '(SELCAT) is',J write(*,*) 'The chosen serial number of meteor is larger than',J goto 10 endif if(FQ(jm,jp).eq.' 0') then write(*,*) 'The data does not contain the chosen parameter abou *t the chosen meteor.' write(*,*) 'Program terminated.' stop endif if(jp.eq.2) then write(*,*) 'Original-author meteor number =',MN(jm) goto 50 endif if(jp.eq.17) then write(*,*) 'Quality =',QU(jm) goto 50 endif if(jp.eq.27) then write(*,*) 'Shower number =',SHN(jm) goto 50 endif if(jp.eq.30) then write(*,*) 'Correction mark =',RC(jm) goto 50 endif if(jp.eq.31) then write(*,*) 'Extreme-hyperbolicity mark =',RH(jm) goto 50 endif if(FE(jm,jp).eq.' 0') then write(*,*) 'Chosen parameter =',YY(jm,jp) else write(*,*) 'Chosen parameter =',YY(jm,jp),'+/-',DYY(jm,jp) endif 50 continue stop end C ===================================================================== SUBROUTINE READING(SELCAT,FQ,FE,AIC,MN,QU,RC,RH,SHN,YY,DYY,J) C --------------------------------------------------------------------- C The subroutine for the reading of the data in the version-2013 format C INPUT: SELCAT = variable of type character*22, e.g., C SELCAT='CAMS_California_v2.d15' denoting the chosen catalog C OUTPUT: read data; see the specification in the list below C J - the total number of the meteors read from the chosen C catalog (integer) C IMPLICIT REAL*8 (A-H,K-Z) IMPLICIT INTEGER (I,J) CHARACTER*1 A1,RC,RH,QU1,QU2 CHARACTER*2 FQ,FE,QNT,ERR,SHN,QU CHARACTER*3 RET3 CHARACTER*4 AMPS,LIST,FLAG CHARACTER*7 MN CHARACTER*8 AIC CHARACTER*22 SELCAT DIMENSION LIST(31),YY(1000000,31),DYY(1000000,31) DIMENSION RC(1000000),RH(1000000) DIMENSION FQ(1000000,31),FE(1000000,31),AIC(1000000),MN(1000000) DIMENSION SHN(1000000),QU(1000000) C C This version of subroutine (issued on August, 2013) is designed for C the reading of data containing 31 (IQNT=31) quantities listed below: IQNT=31 C C The variable LIST(IQ) below specifies the given, IQ-th, quantity by C its 3-character code followed by the colon; in the remark above C LIST-variable, the specification of the quantity with its denotation C used and type of FORTRAN variable are given C C J-th meteor IAU MDC identification code; character*5 AIC(J): LIST(1)='#IC:' C Number of J-th meteor (assigned by the original author); character*5 MN(J): LIST(2)='ANo:' C Date of J-th meteor fall - year; real*8 YY(J,3): LIST(3)='Yr :' C Date of J-th meteor fall - month; real*8 YY(J,4): LIST(4)='Mn :' C Date of J-th meteor fall - day and fraction of day; real*8 YY(J,5): LIST(5)='Day:' C Solar longitude of J-th meteor fall [DEG]; real*8 YY(J,6): LIST(6)='LS :' C Visual magnitude at the maximum of J-th meteor brightness [MAG]; real*8 YY(J,7): LIST(7)='mv :' C Height of beginning of J-th meteor trail [km]; real*8 YY(J,8): LIST(8)='HB :' C Height of the maximum of J-th meteor trail [km]; real*8 YY(J,9): LIST(9)='HM :' C Height of the end of J-th meteor trail [km]; real*8 YY(J,10): LIST(10)='HE :' C Right ascension of geocentric radiant of J-th meteor [DEG]; real*8 YY(J,11): LIST(11)='RA :' C Declination of geocentric radiant of J-th meteor [DEG]; real*8 YY(J,12): LIST(12)='DEC:' C Extra atmospheric velocity of J-th meteor [km/s]; real*8 YY(J,13): LIST(13)='Vi :' C Geocentric velocity of J-th meteor [km/s]; real*8 YY(J,14): LIST(14)='Vg :' C Heliocentric velocity of J-th meteor [km/s]; real*8 YY(J,15): LIST(15)='Vh :' C cos(Z) of J-th meteor; real*8 YY(J,16): LIST(16)='cZ :' C Quality mark of J-th meteor; character*2 QU(J): LIST(17)='Qm :' C Perihelion distance of J-th meteor orbit [AU]; real*8 YY(J,18): LIST(18)='q :' C Eccentricity of J-th meteor orbit; real*8 YY(J,19): LIST(19)='e :' C Reciprocal semi-major axis of J-th meteor orbit [1/AU]; real*8 YY(J,20): LIST(20)='1/a:' C Semi-major axis of J-th meteor orbit [AU]; real*8 YY(J,21): LIST(21)='a :' C Aphelion distance of J-th meteor orbit [AU]; real*8 YY(J,22): LIST(22)='Q :' C Inclination to the ecliptic of J-th meteor orbit [DEG]; real*8 YY(J,23): LIST(23)='i :' C Argument of perihelion of J-th meteor orbit [DEG]; real*8 YY(J,24): LIST(24)='arg:' C Longitude of ascending node of J-th meteor orbit [DEG]; real*8 YY(J,25): LIST(25)='nod:' C Longitude of perihelion of J-th meteor orbit [DEG]; real*8 YY(J,26): LIST(26)='pi :' C Shower number of J-th meteor; character*2 SHN(J): LIST(27)='Sh :' C Mass of J-th meteor [g]; real*8 YY(J,28): LIST(28)='Mas:' C Decadic logarithm of mass (given in [g]) of J-th meteor; real*8 YY(J,29): LIST(29)='lgM:' C Correction mark of J-th meteor; character*1 RC(J): LIST(30)='cor:' C Extreme-hyperbolicity mark of J-th meteor; character*1 RH(J): LIST(31)='crh:' C The mark of the end of record about the given meteor: AMPS=' &' C C The existence of IQ-th parameter (IQ ranges from 1 to IQNT) of J-th C meteor and its determination error is indicated by two auxiliary state C variables FQ(J,IQ) and FE(J,IQ) (both being of type character*2); C if FQ(J,IQ)=' 1', then the corresponding quantity exists; C if FE(J,IQ)=' 1', then the quantity, YY(J,IQ), is given with its C determination error written in DYY(J,IQ) (which is of type real*8; C only real*8 quantities YY(J,IQ) are assumed to have the determination C error) C C ------------------------------------------------------------------- C The proper code of the subroutine... C DO 77 JX=1,1000000 QU(JX)=' ' RC(JX)=' ' RH(JX)=' ' SHN(JX)=' ' DO 66 JY=1,IQNT FQ(JX,JY)=' 0' FE(JX,JY)=' 0' YY(JX,JY)=0.0d0 DYY(JX,JY)=0.0d0 66 CONTINUE 77 CONTINUE C OPEN(UNIT=10,FILE=SELCAT,STATUS='OLD',ACCESS='SEQUENTIAL',ERR=80) C J=0 10 CONTINUE J=J+1 20 CONTINUE READ(10,500,END=50) FLAG,QNT,ERR IF(FLAG.EQ.' &') GOTO 10 IF(FLAG.EQ.'#IC:') THEN READ(10,510) AIC(J) C WRITE(*,*) J,' ',AIC(J) FQ(J,1)=QNT FE(J,1)=ERR GOTO 20 END IF IF(FLAG.EQ.'ANo:') THEN IF(QNT.EQ.' 1') READ(10,520) A1,MN(J) FQ(J,2)=QNT FE(J,2)=ERR GOTO 20 END IF IF(FLAG.EQ.'Qm :') THEN IF(QNT.EQ.' 1') THEN READ(10,545) QU1,QU2 IF(QU2.EQ.'0') QU2=' ' QU(J)=QU1//QU2 FQ(J,17)=QNT FE(J,17)=ERR ELSE READ(10,*) QU(J)=' ' ENDIF GOTO 20 END IF IF(FLAG.EQ.'cor:') THEN IF(QNT.EQ.' 1') THEN READ(10,530) RC(J) FQ(J,30)=QNT FE(J,30)=ERR ELSE READ(10,*) RC(J)=' ' ENDIF GOTO 20 END IF IF(FLAG.EQ.'crh:') THEN IF(QNT.EQ.' 1') THEN READ(10,530) RH(J) FQ(J,31)=QNT FE(J,31)=ERR ELSE READ(10,*) RH(J)=' ' ENDIF GOTO 20 END IF IF(FLAG.EQ.'Sh :') THEN IF(QNT.EQ.' 1') THEN READ(10,540) SHN(J) FQ(J,27)=QNT FE(J,27)=ERR ELSE READ(10,*) SHN(J)=' ' ENDIF GOTO 20 END IF IF(QNT.EQ.' 0') THEN READ(10,*) GOTO 20 END IF IF(ERR.EQ.' 1') THEN READ(10,*) XX,DXX ELSE READ(10,*) XX END IF IDENT=-1 DO 30 JFL=3,IQNT IF(FLAG.EQ.LIST(JFL)) IDENT=JFL 30 CONTINUE IF(IDENT.EQ.-1) THEN WRITE(*,*) 'Identification of a quantity failed.' WRITE(*,*) 'Read flag: ',FLAG WRITE(*,*) 'No such a flag in the list. Program terminated.' STOP END IF YY(J,IDENT)=XX DYY(J,IDENT)=DXX FQ(J,IDENT)=QNT FE(J,IDENT)=ERR GOTO 20 C 50 CONTINUE J=J-1 CLOSE(UNIT=10) RETURN C 80 CONTINUE WRITE(*,*) 'Error at the opening of the data input file.' WRITE(*,*) 'Attempt to open the file named: ',SELCAT WRITE(*,*) 'Program terminated.' STOP C 500 FORMAT(A4,2A2) 505 FORMAT(2A2) 510 FORMAT(A8) 520 FORMAT(A1,A7) 530 FORMAT(A1) 540 FORMAT(A2) 545 FORMAT(2A1) END