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*2 QNT,ERR,FQ,FE CHARACTER*4 AMPS,FLAG,LIST CHARACTER*8 CIDXX,CID CHARACTER*10 FILIN CHARACTER*12 ANOXX,ANO DIMENSION LIST(34),YY(10000,34),DYY(10000,34) DIMENSION FQ(10000,34),FE(10000,34),CID(10000),ANO(10000) FILIN='HISSAR.d18' CALL READING(FILIN,CID,ANO,YY,DYY,FQ,FE,J) write(*,*) 'Number of meteors: ',J stop end C ===================================================================== SUBROUTINE READING(FILIN,CID,ANO,YY,DYY,FQ,FE,J) C --------------------------------------------------------------------- C Universal reading of the "standard format" of the photographic-meteor C database, Version 2010 C INPUT: the data file with the standard flags (see the documentation C for their definition and variable LIST(j) below); the length of the C file-name must not exceed 12 characters C OUTPUT: YY(j) - all meteor characteristics recorded in the database; C the serial numbers of the characteristics are given in documentation C (see also variable LIST(j) below) C DYY(j) - the measurement uncertainty (error) of j-th datum C FQ(j) - information about the existence of j-th datum C (1 - datum exists in the database; 0 - datum does not exist) C FE(j) - information about the existence of the measurement C uncertainty of j-th datum (1 - uncertainty exists; 0 - uncertainty C does not exist) C J - the total number of meteors in the input file C C Version: June 20, 2018 C IMPLICIT REAL*8 (A-H,K-Z) IMPLICIT INTEGER (I,J) CHARACTER*1 RC(10000),RH(10000) CHARACTER*2 QNT,ERR,FQ,FE,QU(10000),SHN(10000) CHARACTER*4 AMPS,FLAG,LIST CHARACTER*8 CIDXX,CID CHARACTER*10 FILIN CHARACTER*12 ANOXX,ANO DIMENSION LIST(34),YY(10000,34),DYY(10000,34) DIMENSION FQ(10000,34),FE(10000,34),CID(10000),ANO(10000) 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 Number of IAU MDC parameters (state in 2018): IQNT=34 C J-th meteor IAU MDC identification code; character*8 CID(J): LIST(1)='#IC:' C Number of J-th meteor (assigned by the original author); character*5 ANO(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 Magnitude (stellar) of radio meteor; real*8 YY(J,32): LIST(32)='mr :' C Height of the central point of the meteor trail [km]; real*8 YY(J,33): LIST(33)='Hrf:' C Decadic logarithm of linear electron density (given in [electron/cm]) of C the central point of meteor trail; real*8 YY(J,34): LIST(34)='LpA:' 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... DO 77 JX=1,10000 DO 66 JY=1,IQNT FQ(JX,JY)=' 0' FE(JX,JY)=' 0' 66 CONTINUE 77 CONTINUE C OPEN(UNIT=10,FILE=FILIN,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) CID(J) FQ(J,1)=QNT FE(J,1)=ERR Ct WRITE(*,*) CID(J) GOTO 20 END IF IF(FLAG.EQ.'ANo:') THEN IF(QNT.EQ.' 1') READ(10,520) ANO(J) FQ(J,2)=QNT FE(J,2)=ERR 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 Ct WRITE(*,*) XX 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 FQ(J,IDENT)=QNT FE(J,IDENT)=ERR YY(J,IDENT)=XX C DYY(J,IDENT)=9.99D99 IF(FE(J,IDENT).EQ.' 1') DYY(J,IDENT)=DXX C DYY(J,IDENT)=DXX 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: ',FILIN WRITE(*,*) 'Program terminated.' STOP C 500 FORMAT(A4,2A2) 510 FORMAT(A8) 520 FORMAT(A12) END