C *********************************************************** 00010035 C *********************************************************** 00020035 C ** ** 00030035 C ** THIS FORTRAN ROUTINE WAS MODIFIED BY J.R.ADAMS OF ** 00040035 C ** MCELHANNEY SURVEYING AND ENGINEERING LTD. TO RUN ** 00050035 C ** ON AN IBM COMPUTER USING FORTRAN G1. THE WORK WAS ** 00060035 C ** DONE FOR THE INDONESIAN GOVERNMENT DURING 1980 AND ** 00070035 C ** 1981. JOB # 083506 ** 00080035 C ** ** 00090035 C *********************************************************** 00100035 C *********************************************************** 00110035 C 00120035 C 00130035 C 00140010 C "MERGE " - AUTHOR - P.G. LAWNIKANIS 00150010 C - WRITTEN ON - SEPTEMBER /74. 00160010 C - LAST COMPILED - APRIL 1975. 00170010 C - REFERENCES - *NONE* 00180010 C 00190013 C 00200010 C EXTERNAL ROUTINES -FILIO ,DDHHMM ,MINUT , 00210010 C GETDAY ,EXIT ,IABS 00220012 C INT , , , 00230010 C 00240010 C I/O DEVICES 4 = INPT = SOURCE PREDOP-LIKE DATA C 3 = INWL = BINARY FITTED-NWL-EPHEMERIS 00260030 C 66 = IOUQ = SCRATCH MERGED DATA 00270030 C 55 = IOUT = MERGED OUTPUT DATA 00280030 C 6 = IPRT = LINE PRINTER 00290030 C 5 = IRED = CARD READER 00300030 C 2 = ISCQ = INTERMEDIATE SCRATCH MERGED DATA 00310030 C 1 = ISCR = INTERMEDIATE SCRATCH MERGED DATA 00320030 C 00330010 C 00340010 C ›MERGE› COMBINES PREDOP OUTPUT FILES ON " 4 " 0035 C INTO 1 MULTI-STATION INPUT FILE ON " 55 " , 00360030 C OR MERGES NWL FITTED COEFFICIENTS ON " 3 " 00370030 C WITH 1 GEODOP INPUT FILE ON " 4 " GIVING " 55 ". 0038 C 00390010 C -ONLY DATA COMMON TO THE INPUT TIME SPAN WILL BE PROCE00400010 C -THE COEFFICIENTS OF A DATA SET WITH FITTING TROUBLE 00410010 C WILL BE REPLACED WHEREVER POSSIBLE. 00420010 C -A PASS-BY-PASS LISTING OF "TAPE5" IS SELECTED BY 00430010 C SETTING THE PRINT FLAG (COL.20) TO "1". 00440010 C 00450010 C THE # OF INPUT FILES , TIME-SPAN , AND PRINT FLAG 00460010 C ARE INPUT ON A SINGLE DATA CARD. 00470010 C THE NWL FLAG (COL.25) IS SET TO "1" FOR NWL-MERGING. 00480010 C 00490010 C NOTE ... ›MERGE› MAY BE USED TO EDIT A DATA-SET INTO "BLOCK"S 00500010 C (N FILES) BY SUPPLYING N OPTION CARDS WITH THE DESIRED00510010 C TIME SPANS. 00520010 C 00530010 C 00540010 DOUBLE PRECISION ORBP , COEF , DOPP , TIME , FSAT 00550017 COMMON /HEAD/ ISAT , NAME , ISRC , INJC , LOKR , LENG , 00560025 + FSAT , NSTN , ORBP , IFIT , COEF , ISTN , ALOK , PRES , TDRY 00570010 + , TWET , IPAS , FRCV , NDOP , NTIM , DOPP , TIME , NORD 00580010 + , NYER , NSAT , NDAY , NIDN , HEDR 00590025 COMMON /DAT/ DAYT , I , IPRN , NSTI , IEOF , ILIM , NSNN 00600010 + , ISSN , TIMN , NPAS , NPSS 00610010 + , KSAT 00620010 COMMON /DEV/ INPT , INWL , IOUQ , IOUT , IPRT , IRED , ISCQ 00630010 + , ISCR 00640010 DIMENSION HEDR( 9) , NAME( 2,2) , ISRC( 2,2) 00650020 + , ISAT( 2) , INJC( 2) , LOKR( 2) 00660010 + , LENG( 2) , FSAT( 2) , NSTN( 2) 00670010 + , ORBP( 7,2) , IFIT( 2) , COEF( 30,2) 00680010 + , ISTN( 15,2,2) , ALOK( 15,2) , PRES( 15,2) 00690010 + , TDRY( 15,2) , TWET( 15,2) , IPAS( 15,2) 00700010 + , FRCV( 15,2) , NDOP( 15,2) , NTIM( 15,2) 00710010 + , DOPP(32,15,2) , TIME(32,15,2) , NIDN( 6 ) 00720030 + , KSAT( 6) , DAYT(3) 00730010 DIMENSION ILIM( 6) , TIMN( 15) , ISSN( 15,2) 00740010 + , ITIM( 4) , ISPN( 6) 00750010 + , ALPR( 15) , ISTP( 15,2) , NPAS( 15) 00760010 EQUIVALENCE (ITIM,LOKR(1)) , (ITPR,LOKR(2)) , (ITSC,LOKR(1)) 00770010 + , (ISPR,ISAT(2)) , (ISSC,ISAT(1)) , (IFPR,IFIT(2)) 00780010 + , (IFSC,IFIT(1)) , (INJP,INJC(2)) , (INJS,INJC(1)) 00790010 + ,(ALPR,ALOK(1,2)), (NSPR,NSTN(2)), (ILM1,ILIM(1)) 00800010 + , (ILM2,ILIM(2)) , (ISTP(1,1),ISTN(1,1,2)) 00810010 DATA NSNM / 0 / 00840010 MINUT (III,JJJ,KKK) = III * 1440 + JJJ * 60 + KKK 00850034 I = 0 00860034 C 00870010 CALL GETDAY ( DAYT ) 00880010 READ (IRED,5,END=66)NUMF, (ILIM(J),J=3,6) , IPRN , MOVE , KSAT 00890010 C 00900010 CALL FILIO (9 , ISWT , INPT) 00910010 IF (MOVE.EQ.1) GO TO 114 00920010 WRITE (IPRT,15) DAYT , DAYT 00930010 C 00940010 DO 100 I = 1,NUMF 00950010 CALL FILIO (1 , I-NUMF ,INPT) IF (I.EQ.1) GO TO 20 00970010 C 00980010 10 ISWT = 1 00990010 ISCT = 1 01000010 20 CALL FILIO (2 , 2 , INPT) 010 ITEMP = IEOF + ISWT 01020010 GO TO (30 , 50 , 90 , 22 , 22 , 110) , ITEMP 01030010 22 ISWT = 3 01040010 GO TO (40 , 70) , ISCT 01050010 C 01060010 30 ISWT = 2 01070010 40 CALL FILIO (2 , 1 , ISCQ) 01080010 ISCT = 2 01090010 ITEMP = IEOF + ISWT 01100010 GO TO (50 , 50 , 70 , 42 , 42 , 110) , ITEMP 01110010 42 ISWT = 3 01120010 GO TO 90 01130010 C 01140010 50 IDIF = ITSC - ITPR 01150010 IF (IDIF / 16) 70 , 60 , 90 01160010 C 01170010 60 IF (ISSC.EQ.ISPR) GO TO 80 01180010 IF (IDIF.GT.0) GO TO 90 01190010 70 CALL FILIO (3 , 1 , ISCR) 01200010 GO TO 40 01210010 C 01220010 80 IF (IFSC.LT.IFPR.OR.IFPR.EQ.IFSC.AND.INJS.GT.INJP) ISWT=101230010 IF (IDIF.NE.0) ISWT = (IABS(IDIF) / IDIF + 3) / 2 01240010 CALL FILIO (4 , ISWT , ISCR) 01250010 GO TO 10 01260010 C 01270010 90 CALL FILIO (3 , 2 , ISCR) 01280010 GO TO 20 01290010 C 01300010 110 WRITE (IPRT,25) I , ISCR , NPSS 01310010 ISWT = NSTI - NSPR 01320010 DO 200 J = 1,NSPR 01330010 ISWT = ISWT + 1 01340010 CALL DDHHMM (INT(TIMN(J)) , ISPN(1)) 01350010 CALL DDHHMM (INT(ALPR(J)) , ISPN(4)) 01360010 WRITE (IPRT,35) ISWT ,(ISTP(J,K),K=1,2) , NPAS(J)01370010 + , (ISPN(K),K=1,6) 01380010 IF (NSNM.EQ.NSNN) GO TO 200 01390010 NSNM = NSNM + 1 01400010 ISSN( NSNM , 1 ) = ISTP ( J , 1 ) 01410010 ISSN ( NSNM , 2 ) = ISTP ( J , 2 ) 01420018 200 CONTINUE 01430010 C 01440010 CALL FILIO (5 , 1 , ISCR) 01450010 C 01460010 100 CONTINUE 01470010 WRITE (IPRT,45) NSNN , ( I ,(ISSN(I,JJ),JJ=1,2), I=1,NSNN) 01480010 I = 1 01490010 GO TO 114 01500010 C 01510010 112 READ(IRED,5,END=113) NUMF , (ILIM(J),J=3,6) , IPRN , ISWT 01520012 GO TO 114 01530012 113 CONTINUE 01540012 CALL FILIO (5 , 3 , IOUT) 01550010 STOP 01560010 C 01570010 114 ILIM(1) = MINUT (ILIM(3) , ILIM(4) , 0) 01580010 ILIM(2) = MINUT (ILIM(5) , ILIM(6) , 0) 01590010 IF (MOVE.EQ.1) GO TO 120 01600010 CALL FILIO (1 , 1 , IOUQ) 01610010 CALL FILIO (6 , IPRN , IOUQ) 01620010 CALL FILIO (5 , 2 , IOUT) 01630010 GO TO 112 01640010 C 01650010 120 WRITE (IPRT,55) DAYT , DAYT 01660010 DO 300 J = 1,NUMF 0 CALL FILIO (1 , 0 , INPT) 01680010 C 01690010 130 ISWT = 0 01700010 140 ISWT = ISWT + 1 01710010 150 CALL FILIO (7 , ISWT , INWL) 01720010 GO TO (160 , 180 , 150 , 300 , 300 , 300) , IEOF 01730010 C 01740010 160 ISWT = 2 01750010 170 CALL FILIO (2 , 1 , INPT) 01760010 IF (IEOF.NE.0) GO TO 140 01770010 C 01780010 IF (ISSC.NE.NSAT) GO TO 170 01790010 IF (ITSC.LT.ILM1) GO TO 170 01800010 IF (ITSC.GT.ILM2) GO TO 140 01810010 180 IF ((ITPR - ITSC) / 7) 150 , 190 , 170 01820010 C 01830010 190 CALL FILIO (8 , 1 , IOUT) 01840010 GO TO 130 01850010 C 01860010 300 CALL FILIO (5 , 2 , IOUT) 01870010 CALL FILIO (5 , 3 , INWL) 01880010 GO TO 112 01890010 C 01900010 5 FORMAT (I5,2(I3,I2),2(4X,I1),6(3X,I2)) 01910010 15 FORMAT ('1',/, 3X,3A4,35X,24H** MERGE GEODOP INPUT **,33X,3A4 01920010 + ,///,48H STEP OUTPUT TOTAL# INPUT STATION #PASS01930010 + ,21H T I M E S P A N,16X,/) 01940010 25 FORMAT (' ',I5,8H TAPE,I2,I6) 01950023 35 FORMAT ('+',I26,6X,2A4,2I6,2(1H/,I2),2H -,I4,2(1H/,I2),/) 01960010 45 FORMAT (///,I4,23H STATIONS WERE MERGED -,/ 01970010 + ,(/,I5,13H ........... ,2A4)) 01980010 55 FORMAT ('1',/,5X,3A4,33X,'** MERGE PRECISE EPHEMERIS **',33X,3A4) C 02000010 66 CONTINUE 02010011 STOP 02020011 END 02030010 SUBROUTINE FILIO (IFUN , ISWT , IDEV) 02040010 C *********************************************************** 02050035 C *********************************************************** 02060035 C ** ** 02070035 C ** THIS FORTRAN ROUTINE WAS MODIFIED BY J.R.ADAMS OF ** 02080035 C ** MCELHANNEY SURVEYING AND ENGINEERING LTD. TO RUN ** 02090035 C ** ON AN IBM COMPUTER USING FORTRAN G1. THE WORK WAS ** 02100035 C ** DONE FOR THE INDONESIAN GOVERNMENT DURING 1980 AND ** 02110035 C ** 1981. JOB # 083506 ** 02120035 C ** ** 02130035 C *********************************************************** 02140035 C *********************************************************** 02150035 C 02160035 C 02170035 C 02180010 C 02190010 C "FILIO " - AUTHOR - P.G. LAWNIKANIS 02200010 C - WRITTEN ON - SEPTEMBER /74. 02210010 C - LAST COMPILED - APRIL 1975. 02220010 C - REFERENCES - *NONE* 02230010 C 02240010 C VARIABLES USED -IFUN ,KSAT ,ISWT ,IOUQ 02250010 C LOOP ,IOUT ,IDEV ,INWL 02260010 C NFIL ,NSAT ,NYER ,NIDN 02270010 C HEDR ,IORD ,DAYT ,NSNN 02280010 C NORD ,NDOP ,TIMN ,ISNN 02290010 C ALOK ,NSTN ,NDOP ,NAME 02300010 C ISRC ,ISAT ,INJC ,LOKR 02310010 C LENG ,FSAT ,ORBP ,IFIT 02320010 C COEF ,KDOP ,NPAS ,NTIM 02330010 C ISTN ,PRES ,TDRY ,TWET 02340010 C IPAS ,FRCV ,DOPP ,TIME 02350010 C NPSS ,ISCR ,ISCQ ,ILIM 02360010 C ISSN 02370010 C 02380010 C VARIABLES ALTERED -ISNN ,LOOP ,NFIL ,NSNN 02390010 C KSAT ,ISCR ,ISCQ ,ISWT 02400010 C NOTE ,NPSS ,NPAS ,TIMN 02410010 C NYER ,NSAT ,NDAY ,NIDN 02420010 C IORD ,HEDR ,NORD ,NAME 02430010 C ISRC ,ISAT ,INJC ,LOKR 02440010 C LENG ,FSAT ,ORBP ,IFIT 02450010 C COEF ,NDOP ,IEOF ,ISTN 02460010 C ALOK ,PRES ,TDRY ,TWET 02470010 C IPAS ,FRCV ,DOPP ,TIME 02480010 C NTIM ,NSTN ,ISNN ,KDOP 02490010 C IDEV ,ISTU , , 02500010 C 02510010 C VARIABLES RETURNED -ISWT ,IDEV , , 02520010 C 02530010 C EXTERNAL ROUTINES -DDHHMM ,MOD , , 02540010 C EOF ,EXIT ,IABS ,INT 02550010 C 02560010 C I/O DEVICES -INWL ,IPRT ,ISCR ,ISCQ 02570010 C IOUT , , , 02580010 C 02590010 C 02600010 C ›FILIO› DOES THE I/O FUNCTIONS FOR MERGING. 02610010 C 02620010 C "IFUN" SELECTS THE NINE MODES- 1) READ/WRITE HEADER REC02630010 C 2) READ NEXT PASS (IDEV)02640010 C 3) WRITE CURRENT PASS 02650010 C 4) WRITE MERGED PASS 02660010 C 5) CLOSE/REWIND SCRATCH 02670010 C 6) WRITE EDITED DATA-SET02680010 C 7) READ NEXT NWL PASS 02690010 C 8) WRITE MERGED NWL PASS02700010 C 9) INITIALIZE EVERYTHING02710010 C 02720010 C "ISWT" DETERMINES THE DATA-SET SOURCE- 1) SCRATCH FILE 02730010 C 2) NEXT (TAPE4).02740010 C 02750010 C "IDEV" IS THE LOGICAL I/O UNIT #. 02760010 C 02770010 C 02780010 DOUBLE PRECISION ORBP , COEF , DOPP , DOP1 , TIM1 , TIME , 02790010 + ORB1 , COF1 , COF2 , FSAT , FSA1 02800017 COMMON /HEAD/ ISAT , NAME , ISRC , INJC , LOKR , LENG , 02810025 + FSAT , NSTN , ORBP , IFIT , COEF , ISTN , ALOK , PRES , TDRY 02820010 + , TWET , IPAS , FRCV , NDOP , NTIM , DOPP , TIME , NORD 02830010 + , NYER , NSAT , NDAY , NIDN , HEDR 02840025 COMMON /DAT/ DAYT , LOOP , IPRN , ISNN , IEOF , ILIM , NSNN 02850010 + , ISSN , TIMN , NPAS , NPSS 02860010 + , KSAT 02870010 COMMON /DEV/ INPT , INWL , IOUQ , IOUT , IPRT , IRED , ISCQ 02880010 + , ISCR 02890010 DIMENSION HEDR( 9) , NAME( 2,2) , ISRC( 2,2) 02900020 + , ISAT( 2) , INJC( 2) , LOKR( 2) 02910010 + , LENG( 2) , FSAT( 2) , NSTN( 2) 02920010 + , ORBP( 7,2) , IFIT( 2) , COEF( 30,2) 02930010 + , ISTN(15,2,2 ) , ALOK( 15,2) , PRES( 15,2) 02940010 + , TDRY( 15,2) , TWET( 15,2) , IPAS( 15,2) 02950010 + , FRCV( 15,2) , NDOP( 15,2) , NTIM( 15,2) 02960010 + , DOPP(32,15,2) , TIME(32,15,2) , NPAS( 15) 02970010 + , NIDN( 6 ) 02980030 + , KSAT( 6) 02990010 DIMENSION ILIM( 6) , TIMN( 15) , ISSN( 15,2 ) 03000010 + , DAYT( 3) , ISP1( 3) , ISP2( 3) 03010010 + , KDOP( 15) , KEEP( 2) , IHEAD( 2) 03020010 + , ALK2( 15) , IST2( 15,2) , NDP2( 15) 03030010 + , NSAV( 20) , ISTU( 15,2) , ORB1( 7) 03040010 + , COF1( 30) , COF2( 30) , NDP1( 15) 03050010 + , NTM1( 15) , IST1( 15,2) , NAM1( 2) 03060010 + , ALK1( 15) , PRS1( 15) , TDR1( 15) 03070010 + , TWT1( 15) , IPS1( 15) , FRQ1( 15) 03080010 + , DOP1( 32,15) , TIM1( 32,15) , ISR1( 2) 03090010 EQUIVALENCE (IST2(1,1),ISTN(1,1,2)) , (ALK2,ALOK(1,2)) 03100010 + , (IORD,HEDR( 3)) , (ITIM,LOKR( 2)) 03110010 + , (NDP2,NDOP(1,2)) , (ISR1(1),ISRC(1,1)) 03120010 + , (ISA1,ISAT( 1)) , (ISA2,ISAT( 2)) 03130010 + , (ITM1,LOKR( 1)) , (LEN1,LENG( 1)) 03140010 + , (NAM1(1),NAME(1,1)) , (INJ1,INJC( 1)) 03150010 + , (FSA1,FSAT( 1)) , (NST1,NSTN( 1)) 03160010 + , (ORB1,ORBP(1,1)) , (IFI1,IFIT( 1)) 03170010 + , (COF1,COEF(1,1)) , (COF2,COEF(1,2)) 03180010 + , (NDP1,NDOP(1,1)) , (NTM1,NTIM(1,1)) 03190010 + , (IST1(1,1),ISTN(1,1,1)) , (ALK1,ALOK(1,1)) 03200010 + , (PRS1,PRES(1,1)) , (TDR1,TDRY(1,1)) 03210010 + , (TWT1,TWET(1,1)) , (IPS1,IPAS(1,1)) 03220010 + , (FRQ1,FRCV(1,1)) , (DOP1,DOPP(1,1,1)) 03230010 + , (LEN2,LENG( 2)) , (TIM1,TIME(1,1,1)) 03240010 + , (KSA6,KSAT( 6)) 03250010 DATA NSAV / 12 , 13 , 14 , 15 , 16 , 17 , 18 , 0 , 0 , 0 , 19 03260010 + , 8*0 , 20 / 03270010 DATA IHEAD / 'NWL-' , 'PRCS'/ 03280010 CC 03290010 GO TO ( 10 , 30 , 40 , 50 , 70 , 80 , 90 , 110 , 1) , IFUN03300010 CC 03310010 1 ISNN = 0 03320010 ISTO = 0 03330010 LOOP = 0 03340010 NFIL = 0 03350010 NSNN = 0 03360010 ISCR = 1 03370010 IONE = 2 03380010 ISCQ = 2 03390010 ITWO = 2 03400010 ISWT = 3 03410010 ITTO = -1 03420010 RETURN 03430010 CC 03440010 10 ITMN=0 03450010 NPSS = 0 03460010 ILIN = 3 03470010 DO 12 J = 1,15 03480010 NPAS( J) = 0 03490010 TIMN( J) = -1. 03500010 12 CONTINUE 03510010 IF (ISWT.EQ.0) ISCR = IOUQ 03520010 IF (ISWT.NE.LOOP) GO TO 20 03530010 ISCR = IOUT 03540010 REWIND IDEV 03550010 J = 0 03560010 DO 3 I = 1,5 03570010 IF (KSAT(I).EQ.0) GO TO 3 03580010 J = J + 1 03590010 KSAT(J) = KSAT(I) 03600010 3 CONTINUE 03610010 KSA6 = J 03620010 IF (J.EQ.0) KSAT(1) = 0 03630010 IF (LOOP.NE.0) GO TO 20 03640010 C 03650010 READ (INWL,END=22) NYER , NSAT , NDAY , NIDN , IORD 03660010 NFIL = NFIL + 1 03670010 NSAT = NSAV(NSAT - 57) 03680010 C 03690010 20 I=0 03700010 I= I + 1 03710010 IF (I.GT.6) CALL EXIT 03720010 READ (IDEV,END=20) HEDR 03730010 IF (LOOP.EQ.0) WRITE (IPRT,35) NFIL , NYER , NSAT , NIDN 03740010 + , (HEDR(J),J=1,7) 03750020 NORD = IORD * 3 03760010 HEDR(4) = DAYT(1) 03770010 HEDR(5) = DAYT(2) 03780010 HEDR(6) = DAYT(3) 03790020 HEDR(7) = NSNN 03800020 IF(ISWT.NE.0.OR.LOOP.NE.0) GO TO 21 03810010 HEDR(8) = IHEAD(1) 03820020 HEDR(9) = IHEAD(2) 03830020 21 CONTINUE 03840010 WRITE (ISCR) HEDR 03850010 IF (LOOP.GT.1) READ (ISCQ) HEDR 03860010 ASSIGN 36 TO ISWI 03870010 ASSIGN 38 TO ISWJ 03880010 RETURN 03890010 C 03900010 30 READ (IDEV,END=31)(NAME(I,ISWT),I=1,2),(ISRC(I,ISWT),I=1,2), 03910010 + ISAT(ISWT),INJC(ISWT),LOKR(ISWT),LENG(ISWT),FSAT(ISWT),NSTI 03920010 + , (ORBP(I,ISWT),I=1, 7) , IFIT(ISWT) 03930010 + , (COEF(I,ISWT),I=1,NORD) , (NDOP(I,ISWT),I=1,NSTI) 03940010 IEOF = 0 03950010 GO TO 32 03960010 31 IEOF = 3 03970010 32 CONTINUE 03980010 039 039 039 IF (IEOF.NE.0) RETURN 03990010 DO 100 I = 1,NSTI 04000010 NDPP = NDOP(I,ISWT) 04010010 IF (NDPP.EQ.0) GO TO 100 04020010 READ (IDEV)(ISTN(I,J,ISWT),J=1,2) , ALOK(I,ISWT) , PRES(I,ISWT) 04030010 + , TDRY(I,ISWT) , TWET(I,ISWT) , IPAS(I,ISWT) 04040010 + , FRCV(I,ISWT) , NTMM 04050010 + , (DOPP(J,I,ISWT),J=1,NDPP) 04060010 + , (TIME(J,I,ISWT),J=1,NTMM) 04070010 NTIM(I,ISWT) = NTMM 04080010 100 CONTINUE 04090010 NSTN(ISWT) = NSTI 04100010 IF (ISWT.EQ.1) RETURN 04110010 C 04120010 GO TO ISWI , (36 , 37) 04130010 36 DO 200 I = 1,NSTI 04140010 IF (NDP2(I).EQ.0.OR.TIMN(I).GE.0.) GO TO 200 04150010 ISNN = ISNN + 1 04160010 ITMN = ITMN + 1 04170010 TIMN( I) = ALK2(I) 04180010 200 CONTINUE 04190010 IF (ITMN.EQ.NSTI) ASSIGN 37 TO ISWI 04200010 37 IF (ISTO.EQ.ISA2.AND.((ITTO - ITIM) / 16).EQ.0) GO TO 30 04210010 GO TO ISWJ , (38 , 39) 04220010 C 04230010 38 ITWO = 2 04240010 ITWO = 2 04250010 NSNN = NSNN + NSTI 04260010 ASSIGN 39 TO ISWJ 04270010 39 RETURN 04280010 CC 04290010 40 KEEP(ISWT) = 1 04300010 KEEP(IABS(ISWT-3)) = 0 04310010 LIM1 = ISWT 04320010 LIM2 = ISWT 04330010 GO TO 60 04340010 CC 04350010 50 KEEP(1) = 1 04360010 KEEP(2) = 1 04370010 LIM1 = 1 04380010 LIM2 = 2 04390010 CC 04400010 60 K = 0 04410010 DO 250 I = IONE,ITWO 04420010 ISEL = KEEP(I) 04430010 NSTI = NSTN(I) 04440010 DO 250 J = 1,NSTI 04450010 K = K + 1 04460010 KDOP(K) = NDOP(J,I) * ISEL 04470010 250 CONTINUE 04480010 WRITE (IDEV) (NAME(I,ISWT),I=1,2) , (ISRC(I,ISWT),I=1,2), 04490010 + ISAT(ISWT),INJC(ISWT) , LOKR(ISWT),LENG(ISWT),FSAT(ISWT),NSNN 04500010 + , (ORBP(I,ISWT),I=1, 7) , IFIT(ISWT) 04510010 + , (COEF(I,ISWT),I=1,NORD) , (KDOP(I ),I=1,NSNN) 04520010 C 04530010 DO 300 I = LIM1,LIM2 04540010 NSTI = NSTN(I) 04550010 DO 300 J = 1,NSTI 04560010 NDPP = NDOP(J,I) 04570010 IF (NDPP.EQ.0) GO TO 300 04580010 IF (I .EQ.2) NPAS(J) = NPAS(J) + 1 04590010 NTMM = NTIM(J,I) 04600010 WRITE (IDEV)(ISTN(J,K,I),K=1,2) , ALOK(J,I) , PRES(J,I) 04610010 + , TDRY(J,I) , TWET(J,I) , IPAS(J,I) 04620010 + , FRCV(J,I) , NTMM 04630010 + , (DOPP(K,J,I),K=1,NDPP) 04640010 + , (TIME(K,J,I) , K = 1,NTMM) 04650010 300 CONTINUE 04660010 NPSS = NPSS + 1 04670010 IF (LIM1.EQ.2) RETURN 04680010 ISTO = ISA1 04690010 ITTO = ITM1 04700010 RETURN 04710010 CC 04720010 70 IF (ISWT.EQ.3) GO TO 74 04730010 ENDFILE IDEV 04740010 IF (ISWT.EQ.2) RETURN 04750010 IDEU = ISCQ 04760010 ISCQ = IDEV 04770010 IDEV = IDEU 04780010 IONE = 1 04790010 ITWO = 1 04800010 REWIND ISCQ 04810010 74 REWIND IDEV 04820010 RETURN 04830010 CC 04840010 80 NFIL = NFIL + 1 04850010 IF (ISWT.EQ.1) WRITE (IPRT, 5) NFIL 04860010 82 READ(IDEV,END=84) NAM1 , ISR1 , ISA1 , INJ1 , ITM1 , LEN1 , FSA1 04870010 + , NST1 , ORB1 , IFI1 , (COF1(I),I=1,NORD) 04880010 + , (NDP1(I),I=1,NST1) 04890010 INOT = 1 04900010 IF (ITM1.LT.ILIM(1)) INOT = 0 04910010 IF (ITM1.LT.ILIM(2)) GO TO 86 04920010 C 04930010 84 WRITE (IPRT,65) NFIL , (ILIM(I),I=3,6) , NPSS 04940010 + ,(( ISSN(I,J) , J = 1 , 2 ) , NPAS(I) , I = 1 , NSNN ) 04950010 RETURN 04960010 C 04970010 86 IF (INOT.NE.1) GO TO 88 04980010 DO 350 I = 1,KSA6 04990010 IF (ISA1.NE.KSAT(I)) GO TO 350 05000010 INOT = 0 05010010 GO TO 88 05020010 350 CONTINUE 05030010 WRITE (IOUT) NAM1 , ISR1 , ISA1 , INJ1 , ITM1 , LEN1 , FSA1 05040010 + , NST1 , ORB1 , IFI1 , (COF1(I),I=1,NORD) 05050010 + , (NDP1(I),I=1,NST1) 05060010 NPSS = NPSS + 1 05070010 IF (ISWT.NE.1) GO TO 88 05080010 CALL DDHHMM (INJ1 , ISP1) 05090010 CALL DDHHMM (ITM1 , ISP2) 05100010 WRITE (IPRT,15) NPSS , ISA1 , ISP1 , ISP2 , LEN1 , FSA1 , IFI1 05110010 88 DO 400 I = 1,NST1 05120010 NDPP = NDP1(I) 05130010 IF (NDPP.EQ.0) GO TO 400 05140010 READ (IDEV)(IST1(1,J),J=1,2) , ALK1(1) , PRS1(1) , TDR1(1) 05150010 + , TWT1(1) , IPS1(1) , FRQ1(1) , NTMM 05160010 + , (DOP1(J,1),J=1,NDPP) 05170010 + , (TIM1(J,1),J=1,NTMM) 05180010 IF (INOT.NE.1) GO TO 400 05190010 NPAS(I) = NPAS(I) + 1 05200010 WRITE (IOUT)(IST1(1,J),J=1,2) , ALK1(1) , PRS1(1) , TDR1(1) 05210010 + , TWT1(1) , IPS1(1) , FRQ1(1) , NTMM 05220010 + , (DOP1(J,1),J=1,NDPP) , (TIM1(J,1),J=1,NTMM) 05230010 IF (ISWT.NE.1) GO TO 400 05240010 CALL DDHHMM (INT(ALOK(1,1)) , ISP1) WRITE (IPRT,25)(IST1(1,J),J=1,2) , ISP1 , PRS1(1) , TDR1(1) 05260010 + , TWT1(1) , IPS1(1) , FRQ1(1) , NDPP , NTMM05270010 ILIN = MOD (ILIN , 60) + 1 05280010 IF (ILIN.EQ.2) WRITE (IPRT, 5) NFIL 05290010 400 CONTINUE 05300010 GO TO 82 05310010 CC 05320010 90 READ (IDEV,END=91) ITIM , LEN2 , (COF2(I),I=1,NORD) 05330010 IEOF = ISWT 05340010 GO TO 92 05350010 91 IEOF = ISWT + 3 05360010 92 CONTINUE 05370010 RETURN 05380010 CC 05390010 110 WRITE (IDEV)NAM1 , IHEAD , NSAT , INJ1 , ITIM , LEN2 , FSA1 05400033 + , NST1 , ORB1 , IFI1 , (COF2(I),I=1,NORD) 05410010 + , (NDP1(I),I=1,NST1) 05420010 K = 0 05430010 DO 500 I = 1,NST1 05440010 NDPP = NDP1(I) 05450010 IF (NDPP.EQ.0) GO TO 500 05460010 NTMM = NTM1(I) 05470010 K = K + 1 05480010 ISTU(K,1) = ISTN(I,1,1) 05490010 ISTU(K,2) = ISTN(I,2,1) 05500010 WRITE (IDEV)(IST1(I,J),J=1,2) , ALK1(I) , PRS1(I) , TDR1(I) 05510010 + , TWT1(I) , IPS1(I) , FRQ1(I) , NTMM 05520010 + , (DOP1(J,I),J=1,NDPP) , (TIM1(J,I),J=1,NTMM) 05530010 500 CONTINUE 05540010 C 05550010 CALL DDHHMM (ITIM , ISP1) 05560010 NPSS = NPSS + 1 05570010 ILIN = MOD(ILIN , 59) + 1 05580010 IF (ILIN.EQ.2) WRITE (99,45) 05590010 WRITE (IPRT,55) NPSS , K , ISP1 ,((ISTU(I,II),I=1,K),II=1,2) 05600010 GO TO 23 05610010 22 CONTINUE 05620010 CALL EXIT 05630010 23 CONTINUE 05640010 RETURN 05650010 5 FORMAT ( 50H1PASS SAT LAST-INJC REF-LOKON SPAN FREQSAT FIT 05660010 + ,50HSTATION ACT-LOKON PRESS T-DRY T-WET DIR FREQOFF 05670010 + , 9H#DOP #TIM,5X,5HFILE#,I2,/) 05680010 15 FORMAT ('+',2I4,2(I5,2(1H/,I2)),I4,F9.1,I3) 05690010 25 FORMAT ('+',49X,2A4,I4,2(1H/,I2),F7.0,2F6.1,I3,F9.2,I4,I5,/) 05700010 35 FORMAT (6H1FILE#,I1,7H YEAR=,I2,6H SAT#,I2,3X,3H ›,6A4,3H› , 05710010 + 3X , 7HFIGURE=,2A4,11H #COEFF=,I2,7H DATE=,3A4,8H #STNS=,05720020 + I2 ,//,24H PASS #STN DAY HOR MIN,33X 05730010 + ,25HU S E D S T A T I O N S) 05740010 45 FORMAT (24H1PASS #STN DAY HOR MIN,33X 05750010 + ,25HU S E D S T A T I O N S) 05760010 55 FORMAT (2I5,2X,3I4,2X,15(1H/,2A4)) 05770010 65 FORMAT ( 7H1 FILE#,I2,14H FOR TIME-SPAN,I4,1H/,I2,3H TO,I4,1H/,I205780010 + , 4H HAS,I5,9H PASSES - 05790010 + ,//,19H STATION #PASS,(/,4X,2A4,I6)) 05800010 C 05810010 END 05820010 SUBROUTINE DDHHMM ( MINI , IDHM ) 05830010 C *********************************************************** 05840035 C *********************************************************** 05850035 C ** ** 05860035 C ** THIS FORTRAN ROUTINE WAS MODIFIED BY J.R.ADAMS OF ** 05870035 C ** MCELHANNEY SURVEYING AND ENGINEERING LTD. TO RUN ** 05880035 C ** ON AN IBM COMPUTER USING FORTRAN G1. THE WORK WAS ** 05890035 C ** DONE FOR THE INDONESIAN GOVERNMENT DURING 1980 AND ** 05900035 C ** 1981. JOB # 083506 ** 05910035 C ** ** 05920035 C *********************************************************** 05930035 C *********************************************************** 05940035 C 05950010 C "DDHHMM" AUTHOR P.G.LAWNIKANIS 05960010 C 05970010 C VARIABLES USED MINI , IDHM 05980010 C VARIABLES ALTERED IDHM 05990010 C VARIABLES RETURNED IDHM 06000010 C EXTERNAL ROUTINES NONE 06010010 C I/O DEVICES NONE 06020010 C 06030010 DIMENSION IDHM(3) 06040010 C 06050010 IDHM(1) = MINI / 1440 06060010 IDHM(2) = ( MINI - IDHM(1) * 1440 ) / 60 06070010 IDHM(3) = MINI - IDHM(1) * 1440 - IDHM(2) * 60 06080010 RETURN 06090010 END 06100010 BLOCK DATA 06110010 C 06120030 C THIS PROGRAM WAS MODIFIED BY J.R. ADAMS AT MCELHANNEY 06130030 C SURVEYING ENGINEERING LIMITED IN CALGARY , ALBERTA , 06140030 C CANADA TO BE USED ON AN IBM MAIN FRAME INSTALLATION 06150030 C USING THE FORTRAN G1 COMPILER (20/01/81) 06160030 C 06170030 COMMON / DEV / INPT , INWL , IOUQ , IOUT , IPRT , IRED 06180010 + , ISCQ , ISCR 06190010 DATA INPT / 4 / , INWL / 3 / , IOUQ / 66 / , IOUT / 55 / , + IPRT / 6 / , IRED / 5 / , ISCQ / 2 / , ISCR / 1 / 06210027 END 06220010 SUBROUTINE GETDAY(DAYT) C C MODIFIED BY S.H. QUEK TO RUN ON VS FORTRAN COMPILER C C ****** REMOVE COMMENT MARKS TO RUN ON FORTRAN H EXTENTED COMPILER C ****** AND PLACE COMMENT MARKS ON THE VS SECTION C DIMENSION DAYT(3),A(5) C LOGICAL*1 DATE(18) C C **CALL SUBROUTINE GDATE IN THE LIBRARY. C C CALL GDATE(DATE) C C C **CALL SUBROUTINE CORE IN THE LIBRARY. C C CALL CORE(A,12) C WRITE(9,1000) (DATE(I),I=6,8),(DATE(I),I=10,18) 1000 FORMAT(12A1) C C **CALL SUBROUTINE CORE IN THE LIBRARY. C C CALL CORE(A,12) C READ(10,1010) DAYT C1010 FORMAT(3A4) C C*******THIS IS THE VS FORTRAN MODIFICATION C REAL*4 DAYT(3),DAY(3) LOGICAL*1 DATE(18),TEMP(12) EQUIVALENCE (TEMP(1),DAY(1)) C C** CALL SUBROUTINE TO GET DAY C CALL GDATE(DATE) C C** TRANSFER ELEMENTS C TEMP(1)=DATE(6) TEMP(2)=DATE(7) TEMP(3)=DATE(8) DO 10 I=10,18 L=I-6 10 TEMP(L)=DATE(I) DO 20 I=1,3 20 DAYT(I)=DAY(I) C C **** END OF MODIFICATION ******** C RETURN END