From: LEPSAM::KANEKAL 9-NOV-1994 16:15:39.81 To: NSSDCA::SARDI CC: Subj: PROGRAM READ_MDF C- C- READS MDF C- C------------------------------------------------------ IMPLICIT NONE CHARACTER*2 SET,ENDTRNY,oldset INTEGER*2 KP,TRNYEND,KPHI,KPLO,F_GET_SET INTEGER*4 STIME,STIME_BEGIN,DELTA_TIME,ptime,pbegin,pint INTEGER*4 F_PUT_SET,F_GETDBLWRD,F_GETSTRING INTEGER*2 F_GETWRD,F_GET_KEY integer*4 set_rs,set_rp,set_ps,set_ep,set_rh real f_getfloat,magl,mlat,lat(3) logical first CHARACTER*40 FIN character*1 answer integer*4 iout,numrs,numold,numset,numps integer*4 maxset,orbit DATA ENDTRNY /'0]'/,oldset/'zz'/,first/.true./ data pbegin/0/ EQUIVALENCE (TRNYEND,ENDTRNY) C------------------------------------------------------ C C --- GET FILE C write(6,*)' give the name of input file ' READ(5,111)FIN 111 FORMAT(A40) write(6,*)' input file ', fin write(6,*)' if this is correct type Y' read(5,112)answer 112 format(A1) if(answer .ne. 'Y')go to 999 write(6,*)' give the unit number of output file ' read(5,113)iout 113 format(i2) write(6,*)' output unit ', iout write(6,*)' if this is correct type Y' read(5,112)answer if(answer .ne. 'Y')go to 999 write(6,*)'give number of sets to be read' read(5,114)maxset 114 format(i3) if(maxset .eq. 99)maxset = 9999999 C C --- initialize C call f_set_bufsize(32768,32768) CALL F_SET_INFILE(FIN) ! open input file C C --- loop over sets C 1 KP = F_GET_SET() !get the first set KPLO = MOD(KP,256) KPHI = (KP - KPLO) / 256 SET = CHAR(KPLO)//CHAR(KPHI) C numset = numset + 1 if(numset .ge. maxset)go to 999 if(set .eq. 'RS') set_rs = set_rs + 1 if(set .eq. 'RP') set_rp = set_rp + 1 if(set .eq. 'EP') set_ep = set_ep + 1 if(set .eq. 'PS') set_ps = set_ps + 1 if(set .eq. 'RH') set_rh = set_rh + 1 GO TO 1 if (SET .NE. OLDSET) THEN write(iout,191)SET,numold,numset 191 format(1h+,' SET KEY ',a2,' numold ',i12,' numset ',i12) if(set .eq. 'RS')then C numrs = numrs + 1 C delta_time = stime C CALL F_GET_GAME(1) C STIME = F_GETDBLWRD(0) C delta_time = stime - delta_time C write(iout,*)' rs # ',numrs,' sampex time stamp ',stime C write(iout,*)' time diff from prev rs set ',delta_time else if(set .eq. 'PS')then c call f_get_game(1) ptime = f_getdblwrd(0) orbit = f_getdblwrd(4) c call f_get_game(3) call f_getfloat_ary(0,lat,3) c call f_get_game(6) magl = f_getfloat(0) mlat = f_getfloat(12) pint = ptime - pbegin if(pint .ge. 60)then c call other_ps(iout) c write(iout,*)' ====================================== ' c write(iout,*)'orbit #',orbit,' stime ',ptime, c & ' L shell ',magl,' mag lat ',lat(3) pbegin = ptime end if c if(magl .le. 3.0 .or. magl .gt. 5.0)numps = 0 c if(magl .ge. 3.0 .and. magl .le. 5.0)then c numps = numps + 1 c if(numps .eq. 1)pbegin = ptime c pint = ptime - pbegin c write(iout,*)' **** 3-5 interval *** ', c & pint,' numps ',numps c end if c end if oldset = set numold = 0 else if(set .eq. oldset)then numold = numold + 1 oldset = set end if C IF(SET .EQ. ENDTRNY) GO TO 999 GO TO 1 999 CONTINUE c write(iout,877) 877 format(/,/,80('=')) write(iout,*)' Statistics for File ',fin write(iout,*)' No. of PS sets ',set_ps write(iout,*)' No. of RS sets ',set_rs write(iout,*)' No. of RP sets ',set_rp write(iout,*)' No. of EP sets ',set_ep write(iout,*)' No. of RH sets ',set_rh write(iout,877) c STOP END c--------------------------------------- SUBROUTINE OTHER_PS(iout) C--------------------------------------------------- C- C- C- Inputs : none C- Outputs: rother array filled with data C- from PS set. C- C- C- C- C- C- controls : none C- created : 29-SEP-92 C- C- C- C- C--------------------------------------------------- IMPLICIT NONE INTEGER*4 OFF,GAME,NPNT3,NPNT6,NPNT7,IPN,IKN REAL F_GETFLOAT INTEGER*4 F_GETDBLWRD REAL ROTHER(50) LOGICAL DEBUG DATA DEBUG /.TRUE./ INTEGER*2 IOUT INTEGER*4 ORBIT DATA NPNT3/3/,NPNT7/3/,NPNT6/6/ C--------------------------------------------------- C GAME = 1 CALL F_GET_GAME(GAME) OFF = 4 ORBIT = F_GETDBLWRD(OFF) WRITE(IOUT,*)'ORBIT NUMBER ',ORBIT C GAME = 3 ! game = 3 POS_GEO CALL F_GET_GAME(GAME) OFF = 0 IPN = 1 CALL F_GETFLOAT_ARY(OFF,ROTHER(IPN),nPNT3) c write(iout,*)'lattitude ',rother(3) C IPN = IPN + nPNT3+2 C C --- game = 6 MAG_PARAM magnetic parameters at S/C C GAME = GAME + 3 CALL F_GET_GAME(GAME) OFF = 0 C write(iout,*)' ipn ', ipn,' game ',game DO IKN = 1,NPNT6 ROTHER(IPN) = F_GETFLOAT(OFF) OFF = OFF + 4 IPN = IPN + 1 END DO write(iout,*)' magl bmag mlt imglt pitch losscone ' write(iout,*)(rother(ikn), ikn=ipn-npnt6,ipn-1) write(iout,*)' ipn ', ipn,' game ',game C C --- game = 7 B_MODEL model field parameters C GAME = GAME + 1 CALL F_GET_GAME(GAME) OFF = 12 C CALL F_GETFLOAT_ARY(OFF,ROTHER(IPN),NPNT7) write(iout,*)' brad bthet bphi ' write(iout,*)(rother(ikn), ikn=ipn,ipn+NPNT7-1) IPN = IPN + NPNT7 write(iout,*)' ipn ', ipn,' game ',game C OFF = 60 ROTHER(IPN) = F_GETFLOAT(OFF) WRITE(IOUT,*)' maglat ',ROTHER(IPN),' IPN ',ipn IPN = IPN + 1 OFF = OFF + 4 CALL F_GETFLOAT_ARY(OFF,ROTHER(IPN),NPNT7) write(iout,*)' altm lonm latm' write(iout,*)(rother(ikn), ikn=ipn,ipn+NPNT7-1) IPN = IPN + NPNT7 write(iout,*)' ipn ', ipn,' game ',game C C --- game = 8 cutoff C GAME = GAME + 1 CALL F_GET_GAME(GAME) OFF = 0 ROTHER(IPN) = F_GETFLOAT(OFF) write(iout,*)' cutoff ',rother(ipn),' ipn ',ipn,' game ',game C IF(DEBUG)THEN WRITE(IOUT,*)' OTHER RATES :' WRITE(IOUT,*)(ROTHER(IKN), IKN = 1,IPN) END IF C 999 RETURN END C