SUBROUTINE ENG(AREA) C C BY G. BURGESS C MODIFIED BY G. BURGESS CODE 694 5/23/90 C DIMENSION AREA(1),RECORD(272),REC(240) INTEGER ID/'ENG '/,ID2/7/,SCET/'SCET'/,ERT/'ERT '/,TYPE INTEGER TELFMT(8)/'GS-3','CR-1','CR-2','CR-3','CR-4','CR-5', * 'CR-6','CR-7'/ INTEGER SCID(2)/'FLT1','FLT2'/ LOGICAL*1 SYS(32) INTEGER*2 IARRAY(120,8),IREC(480),FDSC(3),NTB(6),NWORD(2) INTEGER*2 ITB(6),OUTDEC(21),OUTENG(60),OUTDC1(27) INTEGER*2 INDEC(21)/620,621,622,623,624,625,626,627,660, * 661,662,663,664,665,666,667,668,669,670,671,672/ INTEGER*2 NRATE(2),NYR COMMON/CCA/ WORK(500) EQUIVALENCE(WORK(1),SYS(1)) EQUIVALENCE(WORK(300),IDEC),(WORK(301),OUTDEC(1)), * (WORK(312),IENG),(WORK(313),OUTENG(1)),(WORK(343),ITIME(1)), * (WORK(403),BPS) * ,(WORK(404),KDEC),(WORK(405),OUTDC1(1)) EQUIVALENCE(RECORD(1),ID),(RECORD(2),ITEL),(RECORD(3),ISCID), * (RECORD(4),NTB(1)),(RECORD(7),TIME),(RECORD(9),EDAY), * (RECORD(11),TYPE),(RECORD(13),FDSC(1)), * (RECORD(17),NRATE(1)),(RECORD(31),I), * ( RECORD(33),REC(1),IREC(1)),(RECORD(32),NWORD(1)) REAL*8 TIME,TI,ARRAY(120),EDAY INTEGER EDR1,ITIME(60),BPS DATA MAXM/120/ C INTEGER*2 ISAVE(21)/21*-999/ INTEGER*2 BYTENU(9)/ 596,1196,1796,2396,2996,3596, * 3391,3451,2971/ COMMON /EDR/ EDR1 C BPS=INDB(EDR1+39) MOD216=INDH(EDR1+32) MOD60=INDB(EDR1+34) LCOUNT=LC(EDR1+35) ISTART=(MOD60/15)*15 IF(ISTART .NE. MOD60) WRITE(6,190) 190 FORMAT(' ENGINEERING RECORD REQUIRES TIME CORRECTION') FDSC(1)=MOD216 FDSC(2)=ISTART FDSC(3)=1 CALL TSET(EDR1+8,IYR,TIME,DUM1,DUM2) TYPE = ERT IF(SYS(17))GO TO 3 IF(INDH(EDR1+24) .LE. 0 ) GO TO 3 CALL TSET(EDR1+24,IYR,TIME,DUM1,DUM2) TYPE=SCET 3 CONTINUE TIME=TIME-((MOD60-ISTART)*48.0+(LCOUNT-1)*0.06)/86400.0D0 CALL SETIME(IYR,TIME,NTB) NYR=IYR CALL EPIC(NYR,TIME,EDAY) C CONVERT BYTE TO NUMBER( 10 OR 40) IN BPS CALL CVBPS WRITE(6,150) NTB,MOD216,FDSC(2),FDSC(3),BPS C IRATE = 0 IF(BPS .EQ. 10) IRATE = 6 ITEL=TELFMT(IRATE+1) ISCID=SCID(1) RECORD(12)=2880.0 IF(BPS.EQ.40)RECORD(12)=720.0 NRATE(1)=ID2 NRATE(2)=IRATE NDEC=IDEC L=0 DO 57 N=1,NDEC IDEC=N C WRITE(6,101)INDEC(N),OUTDEC(N) C 101 FORMAT(' ','ENG CODE=',I5,' DECOM=',I5) IF(OUTDEC(N).EQ.0)GO TO 57 CALL DECENG(AREA) NN=N IF(BPS.NE.40)GO TO 70 IF(N.NE.9)GO TO 70 MX=ISTART-(ISTART/10)*10 IF(OUTDEC(9).NE.202)GO TO 71 IF(MX.EQ.0)NN=16 IF(MX.EQ.5)NN=20 ISTEP=2 GO TO 70 71 CONTINUE IF(OUTDEC(9).NE.334)GO TO 72 IF(MX.EQ.0)NN=18 IF(MX.EQ.5)NN=14 ISTEP=2 GO TO 70 72 CONTINUE IF(LCOUNT.EQ.1)NN=14 IF(LCOUNT.EQ.201)NN=15 IF(LCOUNT.EQ.401)NN=16 IF(LCOUNT.EQ.601)NN=17 IF(MX.EQ.5)NN=NN+4 ISTEP=1 70 CONTINUE DO 50 I=1,IENG TI=TIME+ITIME(I)/86400.D3 CALL SETIME(IYR,TI,ITB) L=L+1 IF(L.LT.MAXM)GO TO 120 L=MAXM WRITE(6,121)L 121 FORMAT(' ','*** ENGINEERING STORAGE OVERFLOW - NEED TO STORE', * I4,' VALUES ***') 120 CONTINUE IARRAY(L,1)=ITB(1) IARRAY(L,2)=ITB(2) IARRAY(L,3)=ITB(3) IARRAY(L,4)=ITB(4) IARRAY(L,5)=ITB(5) IARRAY(L,6)=ITB(6) IARRAY(L,7)=OUTENG(I) IF(BPS.NE.40)GO TO 80 IF(N.NE.9.OR.I.EQ.1)GO TO 80 NN=NN+ISTEP IF(NN.GT.21)NN=14 80 CONTINUE IARRAY(L,8)=NN ARRAY(L)=TI C C IF ENG VALUE IS ZERO, THEN OMIT C C IF(IARRAY(L,7).EQ.0)GO TO 52 C C IF SAME VALUE IN ENG AT SAME DECK THEN SKIP ! C C IF(ISAVE(NN).NE.IARRAY(L,7))GO TO 51 C 52 L=L-1 C GO TO 50 C 51 ISAVE(NN)=IARRAY(L,7) C C WRITE(6,55)L,(IARRAY(L,M),M=1,8),ARRAY(L) C 55 FORMAT(' ',9I5,D20.9) 50 CONTINUE 57 CONTINUE IDEC=NDEC IF(SYS(1))CALL SAVENG(AREA,KDEC,OUTDC1,RECORD,BPS) C WRITE(6,160)(AREA(I),I=66,965) C 160 FORMAT(2X,15Z8) IF(L.EQ.0)RETURN DO 60 N=1,L DO 60 K=N,L IF(IARRAY(N,1).GT.IARRAY(K,1))GO TO 65 IF(IARRAY(N,1).NE.IARRAY(K,1))GO TO 60 IF(ARRAY(N).LE.ARRAY(K))GO TO 60 65 CONTINUE DO 66 M=1,8 NSAVE=IARRAY(N,M) IARRAY(N,M)=IARRAY(K,M) IARRAY(K,M)=NSAVE 66 CONTINUE TI=ARRAY(N) ARRAY(N)=ARRAY(K) ARRAY(K)=TI 60 CONTINUE IF(SYS(5)) CALL ENGSUM(L,IARRAY,INDEC) C C WRITE TAPE ( CALL SUMTAP ) C IF(.NOT.SYS(20)) RETURN IBY = 0 I=0 DO 20 K=1,L N=IARRAY(K,8) I=I+1 IB=I+I IA=IB+IB-3 IREC(IA)=INDEC(N) IF(INDEC(N).NE.620) GO TO 22 IBY = IBY + 1 IREC(IA) = BYTENU(IBY) 22 CONTINUE IF(INDEC(N).EQ.621) IREC(IA) = BYTENU(7) IF(INDEC(N).EQ.622) IREC(IA) = BYTENU(8) IF(INDEC(N).EQ.623) IREC(IA) = BYTENU(9) C IREC(IA+1)=IARRAY(K,7) REC(IB)=(ARRAY(K)-TIME)*86400.0D0 C WRITE(6,23) IREC(IA),IREC(IA+1) C 23 FORMAT(1X,'SUMTAP: IREC = ',2I10) 20 CONTINUE IF(I.EQ.0)RETURN LEN=(32+I+I)*4 NWORD(2) = I+I CALL SUMTAP(RECORD,LEN,RECORD(4),RECORD(13),RECORD(17)) RETURN 150 FORMAT(' PROCESSED ENGINEERING RECORD AT TIME ',I2,I4,3(':',I2) 1 ,'.',I3,5X,'FDSC= ',I5,'.',I2,'.',I3,5X,'BPS=',I3) END SUBROUTINE ENGSUM(I,ARRAY,INDEC) 00000100 C 00000200 C =U22LB.ENGSUM BY G. BURGESS 00000300 C 00000400 COMMON/CCA/ WORK(58) 00000500 INTEGER SCID,ASCID(3)/'FLT2','FLT1','PTM '/ 00000600 EQUIVALENCE(WORK(33),SCID),(WORK(55),IYR),(WORK(56),ICDAY), 00000700 * (WORK(57),MTH),(WORK(58),IDAY) 00000800 INTEGER*2 ARRAY(120,8),INDEC(1) 00000900 DATA NW/7/,IPAGE/0/ 00001000 DO 50 L=1,I 00001100 IF(IPAGE.NE.0)GO TO 250 00001200 WRITE(NW,90)MTH,IDAY,IYR,ICDAY 00001300 90 FORMAT('1',80X,'RUN ON ',A4,I4,',',I4,' CDAY= ',I4) 00001400 NSCID=SCID+1 00001500 WRITE(NW,100)ASCID(NSCID) 00001600 100 FORMAT(' ',40X,'SPACECRAFT ENGINGEERING'/' ',40X,'REPORT FOR ',A4)00001700 WRITE(NW,150) 00001800 150 FORMAT(' ',20X,8('PLS '),'MAG ',2('OB IB '),8('MAG ')/ 00001900 * 21X,'MUX EL SEN MOD BSD VR SV DCV MUX ', 00002000 * 2('LFM '),2('HFM '),'ID PV IBEL NV OBEL ADCA PCT ', 00002100 * ' ADCB') 00002200 WRITE(NW,200)(INDEC(N),N=1,21) 00002300 200 FORMAT(' ','ENG CODE',12X,21(I3,2X)/' TIME'/) 00002400 250 CONTINUE 00002500 IN=ARRAY(L,8) 00002600 IPAGE=IPAGE+1 00002700 IF(IPAGE.GE.70)IPAGE=0 00002800 GO TO (620,621,622,623,624,625,626,627,660,661, 00002900 * 662,663,664,665,666,667,668,669,670,671,672),IN 00003000 620 WRITE(NW,1)(ARRAY(L,K),K=1,7) 00003100 GO TO 50 00003200 621 WRITE(NW,2)(ARRAY(L,K),K=1,7) 00003300 GO TO 50 00003400 622 WRITE(NW,3)(ARRAY(L,K),K=1,7) 00003500 GO TO 50 00003600 623 WRITE(NW,4)(ARRAY(L,K),K=1,7) 00003700 GO TO 50 00003800 624 WRITE(NW,5)(ARRAY(L,K),K=1,7) 00003900 GO TO 50 00004000 625 WRITE(NW,6)(ARRAY(L,K),K=1,7) 00004100 GO TO 50 00004200 626 WRITE(NW,7)(ARRAY(L,K),K=1,7) 00004300 GO TO 50 00004400 627 WRITE(NW,8)(ARRAY(L,K),K=1,7) 00004500 GO TO 50 00004600 660 WRITE(NW,9)(ARRAY(L,K),K=1,7) 00004700 GO TO 50 00004800 661 WRITE(NW,10)(ARRAY(L,K),K=1,7) 00004900 GO TO 50 00005000 662 WRITE(NW,11)(ARRAY(L,K),K=1,7) 00005100 GO TO 50 00005200 663 WRITE(NW,12)(ARRAY(L,K),K=1,7) 00005300 GO TO 50 00005400 664 WRITE(NW,13)(ARRAY(L,K),K=1,7) 00005500 GO TO 50 00005600 665 WRITE(NW,14)(ARRAY(L,K),K=1,7) 00005700 GO TO 50 00005800 666 WRITE(NW,15)(ARRAY(L,K),K=1,7) 00005900 GO TO 50 00006000 667 WRITE(NW,16)(ARRAY(L,K),K=1,7) 00006100 GO TO 50 00006200 668 WRITE(NW,17)(ARRAY(L,K),K=1,7) 00006300 GO TO 50 00006400 669 WRITE(NW,18)(ARRAY(L,K),K=1,7) 00006500 GO TO 50 00006600 670 WRITE(NW,19)(ARRAY(L,K),K=1,7) 00006700 GO TO 50 00006800 671 WRITE(NW,20)(ARRAY(L,K),K=1,7) 00006900 GO TO 50 00007000 672 WRITE(NW,21)(ARRAY(L,K),K=1,7) 00007100 50 CONTINUE 00007200 RETURN 00007300 1 FORMAT(' ',I2,I4,3(':',I2),'.',I3,1X,I3) 00007400 2 FORMAT(' ',I2,I4,3(':',I2),'.',I3,5X,I3) 00007500 3 FORMAT(' ',I2,I4,3(':',I2),'.',I3,10X,I3) 00007600 4 FORMAT(' ',I2,I4,3(':',I2),'.',I3,15X,I3) 00007700 5 FORMAT(' ',I2,I4,3(':',I2),'.',I3,20X,I3) 00007800 6 FORMAT(' ',I2,I4,3(':',I2),'.',I3,25X,I3) 00007900 7 FORMAT(' ',I2,I4,3(':',I2),'.',I3,30X,I3) 00008000 8 FORMAT(' ',I2,I4,3(':',I2),'.',I3,35X,I3) 00008100 9 FORMAT(' ',I2,I4,3(':',I2),'.',I3,40X,I3) 00008200 10 FORMAT(' ',I2,I4,3(':',I2),'.',I3,45X,I3) 00008300 11 FORMAT(' ',I2,I4,3(':',I2),'.',I3,50X,I3) 00008400 12 FORMAT(' ',I2,I4,3(':',I2),'.',I3,55X,I3) 00008500 13 FORMAT(' ',I2,I4,3(':',I2),'.',I3,60X,I3) 00008600 14 FORMAT(' ',I2,I4,3(':',I2),'.',I3,65X,I3) 00008700 15 FORMAT(' ',I2,I4,3(':',I2),'.',I3,70X,I3) 00008800 16 FORMAT(' ',I2,I4,3(':',I2),'.',I3,75X,I3) 00008900 17 FORMAT(' ',I2,I4,3(':',I2),'.',I3,80X,I3) 00009000 18 FORMAT(' ',I2,I4,3(':',I2),'.',I3,85X,I3) 00009100 19 FORMAT(' ',I2,I4,3(':',I2),'.',I3,90X,I3) 00009200 20 FORMAT(' ',I2,I4,3(':',I2),'.',I3,95X,I3) 00009300 21 FORMAT(' ',I2,I4,3(':',I2),'.',I3,100X,I3) 00009400 END 00009500 SUBROUTINE FILCR6 (XSC,/NS/,XLAST,FIRST) 00000100 C ********** =ZBTWV.FILCR6 ********** 00000105 LOGICAL*1 FIRST 00000110 INTEGER*2 NS 00000120 INTEGER PRES 00000130 REAL*4 LSA,LSB,LSC 00000140 REAL*8 A(3,3) 00000150 DIMENSION XSC(1),X(160),U(160) 00000160 DATA FILL /999./ 00000170 C EXTRACT DATA POINTS FOR LEAST SQUARES FIT. 00000180 NPTS = 0 00000190 IF (FIRST) GO TO 5 00000200 NPTS = 1 00000210 U(1) = XLAST 00000220 X(1) = 0. 00000230 5 CONTINUE 00000240 DO 10 I=1,NS 00000250 IF (XSC(I) .EQ. FILL) GO TO 10 00000260 NPTS = NPTS + 1 00000270 U(NPTS) = XSC(I) 00000280 X(NPTS) = I 00000290 10 CONTINUE 00000300 IF (NPTS .LE. 2) GO TO 40 00000310 C SET THE LAST POINT USED IN L.S. FIT TO LAST INPUT DATA POINT. 00000320 IF (X(NPTS) - NS) 11,18,11 00000330 11 CONTINUE 00000340 NPTS = NPTS + 1 00000350 X(NPTS) = NS 00000360 DO 13 I=1,NS 00000370 K = NS - I + 1 00000380 IF (XSC(K) .EQ. FILL) GO TO 13 00000390 U(NPTS) = XSC(K) 00000400 GO TO 18 00000410 13 CONTINUE 00000420 18 CONTINUE 00000430 C CONSTRUCT LEAST SQUARES COORDINATE MATRIX. 00000440 A0 = NPTS 00000450 A1 = 0. 00000460 A2 = 0. 00000470 A3 = 0. 00000480 A4 = 0. 00000490 B0 = 0. 00000500 B1 = 0. 00000510 B2 = 0. 00000520 DO 20 I=1,NPTS 00000530 A1 = A1 + X(I) 00000540 A2 = A2 + X(I)**2 00000550 A3 = A3 + X(I)**3 00000560 A4 = A4 + X(I)**4 00000570 B0 = B0 + U(I) 00000580 B1 = B1 + (U(I) * X(I)) 00000590 B2 = B2 + (U(I) * X(I)**2) 00000600 20 CONTINUE 00000610 A(1,1) = A4 00000620 A(1,2) = A3 00000630 A(1,3) = A2 00000640 A(2,1) = A3 00000650 A(2,2) = A2 00000660 A(2,3) = A1 00000670 A(3,1) = A2 00000680 A(3,2) = A1 00000690 A(3,3) = A0 00000700 C INVERT COORDINATE MATRIX AND CALCULATE COEFICIENTS OF 00000710 C LEAST SQUARES PARABOLA. 00000720 CALL MAGINV (A,3,DET) 00000730 LSA = (A(1,1) * B2) + (A(1,2) * B1) + (A(1,3) * B0) 00000740 LSB = (A(2,1) * B2) + (A(2,2) * B1) + (A(2,3) * B0) 00000750 LSC = (A(3,1) * B2) + (A(3,2) * B1) + (A(3,3) * B0) 00000760 C CALCULATE SCF. 00000770 DO 30 I=1,NS 00000780 RI = I 00000790 XSC(I) = (LSA * RI**2) + (LSB * RI) + LSC 00000800 30 CONTINUE 00000810 XLAST = XSC(NS) 00000820 RETURN 00000830 C USE STEP FUNCTION FOR FIT IF LESS THAN 3 INPUT POINTS. 00000840 40 CONTINUE 00000850 WRITE (6,160) NPTS,NS 00000860 DO 50 I=1,NS 00000870 IF (XSC(I) .EQ. FILL) XSC(I) = XLAST 00000880 XLAST = XSC(I) 00000890 50 CONTINUE 00000900 RETURN 00000910 160 FORMAT (' NPTS =',I4,' NS =',I4,' INSUFFICIENT DATA FOR LEAST', 00000920 1 ' SQUARES FIT TO S/C FIELD - FAILURE MODE - USE STEP ', 00000930 2 'FUNCTION') 00000940 END 00000950 SUBROUTINE FILLIN(XSC,/NS/,XLAST,PRES) 00000100 INTEGER*2 NS 00000110 INTEGER PRES 00000111 DIMENSION XSC(1),X(160),U(160),S(160),DEL(160),A(160),V(160) 00000120 DATA FILL/999./ 00000125 C 00000130 C =U2EDR.FILLIN 00000140 C IF ANY GAPS IN SPACECRAFT FIELD EXIST, FILL IN BY INTERPOLATION 00000150 C IF MISSING = 1 USE LINNEAR INTERP 00000160 C FOR LARGER MISSING BLOCKS, USE CUBIC SPLINE 00000170 C 00000180 IF(PRES .GT. 1) GO TO 40 00000190 DO 10 I=1,NS 00000200 IF(XSC(I) .NE. FILL) GO TO 10 00000210 IF(I .GT. 1) GO TO 4 00000220 XSC(1) = (XSC(2) + XLAST)/2. 00000230 GO TO 65 00000240 4 IF(I .LT. NS) GO TO 6 00000250 XSC(NS) = XSC(NS-1) 00000260 GO TO 65 00000270 6 XSC(I) = (XSC(I-1) + XSC(I+1))/2. 00000280 GO TO 65 00000290 10 CONTINUE 00000300 WRITE(6,150) PRES 00000310 RETURN 00000320 C 00000330 40 CONTINUE 00000340 K = 1 00000350 U(1) = XLAST 00000360 X(1) = 0. 00000370 DO 50 I=1,NS 00000380 IF(XSC(I) .EQ. FILL) GO TO 50 00000390 K = K + 1 00000400 U(K) = XSC(I) 00000410 X(K) = I 00000420 50 CONTINUE 00000430 C 00000440 Q1 = 0. 00000450 QN = 0. 00000460 NPTS = K 00000470 IF(NPTS .LE. 3) GO TO 75 00000475 CALL SPLN2(X,U,S,Q1,QN,NPTS,DEL,A,V) 00000480 C 00000490 DO 60 I=1,NS 00000500 IF(XSC(I) .EQ. FILL) XSC(I) = SPLIN(FLOAT(I),X,U,S,DEL,Q1,QN,NPTS)00000510 60 CONTINUE 00000520 65 XLAST = XSC(NS) 00000530 RETURN 00000540 C 00000541 75 CONTINUE 00000542 WRITE(6,160) NPTS,NS 00000543 DO 85 I=1,NS 00000544 IF(XSC(I) .EQ. FILL) XSC(I) = XLAST 00000545 XLAST = XSC(I) 00000546 85 CONTINUE 00000547 RETURN 00000548 150 FORMAT(' ??? A COMPLETE S/C FIELD BLOCK EXISTS WITH A COUNTER' 00000550 1 ,' INDICATING ',I5,' MISSING VALUES???') 00000552 160 FORMAT(' NPTS=',I4,' NS=',I4,' INSUFFICIENT DATA FOR SPLINE FIT' 00000554 1 ,' TO S/C FIELD - FAILURE MODE - USE STEP FUNCTION') 00000558 END 00000560 SUBROUTINE FILTER(XP,YP,ZP,NP2,XS,YS,ZS,NS2,XSC,YSC,ZSC) C********************************************************************** C * C SUBROUTINE FILTER CREATES A BAND FILTER AND FILTERS DATA OUTSIDE * C THE BAND BY SETTING PRIMARY AND SECONDARY DATA TO FILL. THE * C VALUE FOR EPSILON (SCFLIM) IS INPUT BY MEANS OF THE MAGKON * C NAMELIST. SEE ROUTINE INIT. * C * C ********************************************************************* INTEGER REPEAT INTEGER*2 NP2,NS2 REAL*4 PTS/0./,DSCRD/0./,AVG/0./ DIMENSION SCF(160),XSC(160),YSC(160),ZSC(160),IX(160),IY(160) DIMENSION IZ(160),AX(160),AY(160),AZ(160),DX(160),DY(160),DZ(160) DIMENSION XB(160),YB(160),ZB(160),IA(160),XP(200),YP(200),ZP(200) DIMENSION XS(160),YS(160),ZS(160),IB(160),IC(160) DATA FILL/999./,ISW/0/,JSW/0/ COMMON/MAGCOM/ SCFLIM,OWLTLM,PSLIM,RMSLIM C******* BYPASS FILTER IF SCFLIM = 0 *********************************** IF(SCFLIM.EQ.0.0)RETURN C*********************************************************************** NP=NP2 NS=NS2 C** FIND FIRST GOOD SEQUENCE ****************************************** IF(ISW.EQ.1)GO TO 4 CALL GDSEQ(XSC,YSC,ZSC,NS,ISW) IF (ISW.EQ.1)GO TO 4 C******* IF SEQUENCE NOT GOOD , FILL DATA AND RETURN ****************** DO 2 M=1,NP XP(M)=FILL YP(M)=FILL 2 ZP(M)=FILL DO 3 M=1,NS XS(M)=FILL YS(M)=FILL ZS(M)=FILL XSC(M)=FILL YSC(M)=FILL 3 ZSC(M)=FILL WRITE(6,71) 71 FORMAT(' BAD FIRST SEQUENCE') RETURN C** SET UP ARRAYS FOR SORTING *************************************** 4 K=0 DO 10 L=1,NS C XSC(L)=XSC(L)+0.144 C YSC(L)=YSC(L)+0.144 C ZSC(L)=ZSC(L)+0.144 IF(XSC(L).EQ.FILL)GO TO 10 K=K+1 IX(K)=K IY(K)=K IZ(K)=K AX(K)=XSC(L) AY(K)=YSC(L) AZ(K)=ZSC(L) 10 CONTINUE IF(K.EQ.0)RETURN IF(JSW.EQ.0)GO TO 5 UPX=XTBAND UPY=YTBAND UPZ=ZTBAND DNX=XBBAND DNY=YBBAND DNZ=ZBBAND GO TO 35 C** SORT ARRAYS AND FIND MEDIAN ************************************** 5 JSW=1 CALL VSRTR(AX,K,IX) XMED=(AX((K+1)/2)+AX((K+2)/2))/2. CALL VSRTR(AY,K,IY) YMED=(AY((K+1)/2)+AY((K+2)/2))/2. CALL VSRTR(AZ,K,IZ) ZMED=(AZ((K+1)/2)+AZ((K+2)/2))/2. C WRITE(4,71)XMED,YMED,ZMED C 71 FORMAT(1X,' MEDIANS =',3F8.4) C** FIND DIFFERENCE FROM MEDIAN ************************************* C** AND SUM SQUARES ************************************* DSUMX=0.0 DSUMY=0.0 DSUMZ=0.0 DO 30 I=1,K DX(I)=AX(I)-XMED DY(I)=AY(I)-YMED DZ(I)=AZ(I)-ZMED DSUMX=DSUMX+DX(I)**2 DSUMY=DSUMY+DY(I)**2 DSUMZ=DSUMZ+DZ(I)**2 IX(I)=I IY(I)=I IZ(I)=I 30 CONTINUE C** CALC. THE STANDARD DEVIATION(?) USING DIFF. FROM MEDIAN *********** SDX=SQRT(DSUMX/(K-1)) SDY=SQRT(DSUMY/(K-1)) SDZ=SQRT(DSUMZ/(K-1)) C WRITE(4,72)SDX,SDY,SDZ C 72 FORMAT(1X,'RMS = ',3F8.4) C** SET UPPER AND LOWER BOUNDS ************************************** UPX=XMED+SDX UPY=YMED+SDY UPZ=ZMED+SDZ DNX=XMED-SDX DNY=YMED-SDY DNZ=ZMED-SDZ C** DO FIRST FILTER BY S.D. ****************************************** 35 J=0 DO 40 I=1,K IF(AX(I).GT.UPX)GO TO 40 IF(AY(I).GT.UPY)GO TO 40 IF(AZ(I).GT.UPZ)GO TO 40 IF(AX(I).LT.DNX)GO TO 40 IF(AY(I).LT.DNY)GO TO 40 IF(AZ(I).LT.DNZ)GO TO 40 J=J+1 XB(J)=AX(I) YB(J)=AY(I) ZB(J)=AZ(I) 40 CONTINUE IF(J.EQ.0)GO TO 72 C** COMPUTE SPACECRAFT FIELD FROM FILTERED POINTS ********************** 42 DO 50 I=1,J C SCF(I)=SQRT(XB(I)**2+YB(I)**2+ZB(I)**2) IA(I)=I IB(I)=I IC(I)=I 50 CONTINUE CALL VSRTR(XB,J,IA) XBM =(XB((J+1)/2)+XB((J+2)/2))/2. CALL VSRTR(YB,J,IB) YBM=(YB((J+1)/2)+YB((J+2)/2))/2. CALL VSRTR(ZB,J,IC) ZBM=(ZB((J+1)/2)+ZB((J+2)/2))/2. 51 BANDLM=SCFLIM*0.25 XTBAND=BANDLM+XBM XBBAND=XBM-BANDLM YTBAND=BANDLM+YBM YBBAND=YBM-BANDLM ZTBAND=BANDLM+ZBM ZBBAND=ZBM-BANDLM C WRITE(4,74)SMED,BANDLM C 74 FORMAT(1X,'SCF MEDIAN=',F8.4,'BAND LIMIT=',F8.4) C** APPLY FILTER HERE ************************************************ 72 REPEAT=NP/NS J=1 L=1 SCTEMP=XSC(L) DO 60 I=1,NP IF (SCTEMP.EQ.FILL) GO TO 55 PTS=PTS+1. IF(XSC(L).GT.XTBAND.OR.XSC(L).LT.XBBAND) GO TO 52 IF(YSC(L).GT.YTBAND.OR.YSC(L).LT.YBBAND) GO TO 52 IF(ZSC(L).GT.ZTBAND.OR.ZSC(L).LT.ZBBAND) GO TO 52 GO TO 55 52 XP(I)=FILL YP(I)=FILL ZP(I)=FILL XS(L)=FILL YS(L)=FILL ZS(L)=FILL XSC(L)=FILL YSC(L)=FILL ZSC(L)=FILL DSCRD=DSCRD+1 55 CONTINUE J=J+1 IF(J.LE.REPEAT)GO TO 60 J=1 L=L+1 SCTEMP=XSC(L) 60 CONTINUE C DO 66 II=1,NS C XSC(II)=XSC(II)-0.144 C YSC(II)=YSC(II)-0.144 C ZSC(II)=ZSC(II)-0.144 C 66 CONTINUE RETURN ENTRY ENDFIL IF (PTS.EQ.0.)GO TO 65 AVG=(DSCRD/PTS)*100. 65 CONTINUE WRITE(4,70)SCFLIM,RMSLIM 70 FORMAT(1X,' EPSILON =',F6.3,5X,'RMS LIMIT =',F6.3) WRITE(4,90)DSCRD,AVG 90 FORMAT(1X,F8.0,' POINTS DISCARDED (',F4.1,' PERCENT OF DATA)') RETURN END SUBROUTINE FIXCR4(PX,PY,PZ,SX,SY,SZ,PEX,PEY,PEZ,SEX,SEY,SEZ) 00000100 INTEGER PX(1),PY(1),PZ(1),SX(1),SY(1),SZ(1),PEX(1) 00000110 1 ,PEY(1),PEZ(1),SEX(1),SEY(1),SEZ(1) 00000120 C 00000130 C =W82AL.FIXCR4 00000140 C MAG CR-4 FIX SATURATION OF 6 BIT DIFFERENCES 00000150 C 00000160 CALL SATFIX(PX,PEX,2) 00000170 CALL SATFIX(PY,PEY,2) 00000180 CALL SATFIX(PZ,PEZ,2) 00000190 C CALL SATFIX(SX,SEX,1) 00000200 C CALL SATFIX(SY,SEY,1) 00000210 C CALL SATFIX(SZ,SEZ,1) 00000220 RETURN 00000230 END 00000240 SUBROUTINE FIXC5V(PX,PY,PZ,SX,SY,SZ,PEX,PEY,PEZ,SEX,SEY,SEZ) INTEGER PX(1),PY(1),PZ(1),SX(1),SY(1),SZ(1),PEX(1) 1 ,PEY(1),PEZ(1),SEX(1),SEY(1),SEZ(1) C C MODIFIED BY G.BURGESS 1/5/90 C FIXC5V.FOR C MAG CR-5 (VIM-5) FIX SATURATION OF 6 BIT DIFFERENCES C CALL SATFIX(PX,PEX,4) CALL SATFIX(PY,PEY,4) CALL SATFIX(PZ,PEZ,4) CALL SATFIX(SX,SEX,2) CALL SATFIX(SY,SEY,2) CALL SATFIX(SZ,SEZ,2) RETURN END SUBROUTINE FIXSAT(PX,PY,PZ,SX,SY,SZ,PEX,PEY,PEZ,SEX,SEY,SEZ) 00000100 INTEGER PX(1),PY(1),PZ(1),SX(1),SY(1),SZ(1),PEX(1) 00000110 1 ,PEY(1),PEZ(1),SEX(1),SEY(1),SEZ(1) 00000120 C 00000130 C =W82AL.FIXSAT 00000140 C MAG GS-3 FIX SATURATION OF 6 BIT DIFFERENCES 00000150 C 00000160 CALL SATFIX(PX,PEX,16) 00000170 CALL SATFIX(PY,PEY,16) 00000180 CALL SATFIX(PZ,PEZ,16) 00000190 CALL SATFIX(SX,SEX,8) 00000200 CALL SATFIX(SY,SEY,8) 00000210 CALL SATFIX(SZ,SEZ,8) 00000220 RETURN 00000230 END 00000240 SUBROUTINE FLIP(X,Y,Z,MBLOCK,GMT,STATUS) 00000100 C ********** =U2MAG.FLIP ********** 00000105 INTEGER*2 GMT(6),STATUS(2) 00000110 INTEGER*4 X(1),Y(1),Z(1),MBLOCK(3) 00000120 C ELECTRONIC FLIP 00000140 C 00000150 C CODE TO BE DEFINED BY MARIO ACUNA 00000160 C HIGH ORDER BIT OF STATUS(2) GIVES IFC POLARITY 00000170 C 00000180 CALL MEDDLE('E',MBLOCK) 00000190 WRITE(6,150) MBLOCK,GMT,STATUS 00000200 RETURN 00000210 150 FORMAT(3(1X,A4),1X,2I4,3(':',I2),'.',I3,' ELECTRONIC FLIP ',2Z4)00000220 END 00000240 SUBROUTINE FLUSH(B,IB,N,LUNIT,HEADER,ID,FLUB,SS,/JX/) 00001000 INTEGER*2 IB(5,120) 00002000 INTEGER*4 FDSL,FDSR 00003000 REAL*8 SS(24) 00004000 COMMON/CCA/ WORK(500) 00004010 LOGICAL*1 SWITCH(96) 00004030 EQUIVALENCE (WORK(1),SWITCH(1)) 00004040 C --- 00004050 DIMENSION B(9,120),ID(7,24),FLUB(18),FMT(23) 00005000 DATA FMT /'( I','3,F5','.1,2','F6.2',',I4,','I4,3', 00006000 1 'F6.2',' ,3','F6.3',',A1,','I1,''','|'' ',' ,I', 00007000 2 '3,F5','.1,2','F6.2',',I4,','I4,3','F6.2',' ,3', 00008000 3 'F6.3',',A1,','I1) '/ 00009000 DATA DEC0/'F6.0'/,DEC1/'F6.1'/,DEC2/'F6.2'/,DEC3/'F6.3'/ 00010000 LOGICAL*1 FLG0,FLG1,LAB70 00011000 C 00012000 C SUBROUTINE TO EMPTY PRINT BUFFERS TO PRINTER IN SPECIAL 00013000 C BLOCKED FORMAT (TWO COLUMNS, TWELVE BLOCKS EACH) 00014000 C 00015000 C --- 00015010 C --- MODIFIED: TO PROVIDE 3 SIG. DIGITS TO THE RIGHT OF THE DECIMAL 00015340 C --- FOR F1,F2 AND XYZ. ZBESM AND ZB2VS. MARCH 17,1982 00015350 C --- 00015670 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00016000 C 00017000 C VALUE VARIABLE FORMAT 00018000 C 00019000 C MIN IB(1,I) 00020000 C IB(1,K) 00021000 C SEC B(1,I) 00022000 C F1 B(2,I) FMT(4) 00023000 C B(2,K) FMT(16) 00024000 C F2 B(3,I) FMT(4) 00025000 C B(3,K) FMT(16) 00026000 C TH IB(2,I) 00027000 C IB(2,K) 00028000 C PH IB(3,I) 00029000 C IB(3,K) 00030000 C X,Y,Z (B(L,I),L=4,6) FMT(7) 00031000 C (B(L,K),L=4,6) FMT(19) 00032000 C RMSX,Y,Z (B(L,I),L=7,9) FMT(9) 00033000 C (B(L,K),L=7,9) FMT(21) 00034000 C N IB(5,I) 00035000 C IB(5,K) 00036000 C 00037000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00038000 CALL HEADER(LUNIT,ID(3,1),ID(1,1),FLUB,SS,JX) 00039000 C 00040000 LAB70 = .FALSE. 00041000 IF(N .LT. 120) GO TO 10 00042000 MN = 1 00043000 MX = 60 00044000 ASSIGN 90 TO IRTN 00045000 GO TO 50 00046000 C 00047000 10 IF(N .GT. 60) GO TO 20 00048000 MN = 1 00049000 MX = N 00050000 ASSIGN 90 TO IRTN 00051000 LAB70 = .TRUE. 00052000 GO TO 50 00053000 C 00054000 20 MN = 1 00055000 MX = N - 60 00056000 ASSIGN 25 TO IRTN 00057000 GO TO 50 00058000 C 00059000 25 MN = MX + 1 00060000 MX = 60 00061000 ASSIGN 90 TO IRTN 00062000 LAB70 = .TRUE. 00063000 GO TO 50 00064000 C 00065000 50 CONTINUE 00066000 FLG0 = .FALSE. 00067000 FLG1 = .FALSE. 00068000 DO 200 I=MN,MX 00069000 K = I + 60 00070000 IF ((B(2,I) .GE. 100.) .AND. (B(2,I) .NE. 999.)) FLG1 = .TRUE. 00071000 IF ((.NOT. LAB70).AND. (B(2,K) .GE. 100.).AND.(B(2,K) .NE. 999.)) 00072000 1 FLG1 = .TRUE. 00072500 IF (B(2,I) .GE. 1000.) FLG0 = .TRUE. 00073000 IF ((.NOT. LAB70) .AND. (B(2,K) .GE. 1000.))FLG0 = .TRUE. 00074000 200 CONTINUE 00075000 IF (.NOT. FLG0) GO TO 210 00076000 FMT(4) = DEC0 00077000 FMT(7) = DEC0 00078000 FMT(9) = DEC1 00079000 FMT(16) = DEC0 00080000 FMT(19) = DEC0 00081000 FMT(21) = DEC1 00082000 GO TO 230 00083000 210 IF (.NOT. FLG1) GO TO 220 00084000 FMT(4) = DEC1 00085000 FMT(7) = DEC1 00086000 FMT(9) = DEC2 00087000 FMT(16) = DEC1 00088000 FMT(19) = DEC1 00089000 FMT(21) = DEC2 00090000 GO TO 230 00091000 220 FMT(4) = DEC2 00092000 FMT(7) = DEC2 00093000 FMT(9) = DEC3 00094000 FMT(16) = DEC2 00095000 FMT(19) = DEC2 00096000 FMT(21) = DEC3 00097000 C --- 00097005 C --- EXTERNAL SWITCH IS USED TO PROVIDE ADDITIONAL SIGNIFICANCE FOR 00097010 C --- F1,F2,XYZ 00097015 C --- 00097020 230 IF(.NOT. SWITCH(40)) GO TO 235 00097030 FMT(4) = DEC3 00097040 FMT(7) = DEC3 00097050 FMT(16) = DEC3 00097055 FMT(19) = DEC3 00097058 C --- 00097060 235 CONTINUE 00098000 IF (LAB70) GO TO 70 00099000 DO 60 I=MN,MX 00100000 J = MOD(I-1,5) 00101000 IF (J .NE. 0) GO TO 55 00102000 KL = I/5 + 1 00103000 KR = KL + 12 00104000 FDSL = MOD(ID(4,KL),1000) 00105000 FDSR = MOD(ID(4,KR),1000) 00106000 WRITE (LUNIT,160) ID(1,KL),ID(2,KL),ID(6,KL),ID(7,KL),FDSL 00107000 1 ,ID(1,KR),ID(2,KR),ID(6,KR),ID(7,KR),FDSR 00108000 55 K = I + 60 00109000 WRITE(LUNIT,FMT) IB(1,I),B(1,I),B(2,I),B(3,I),IB(2,I),IB(3,I) 00110000 1 ,(B(L,I),L=4,9),IB(4,I),IB(5,I) 00111000 2 ,IB(1,K),B(1,K),B(2,K),B(3,K),IB(2,K),IB(3,K) 00112000 3 ,(B(L,K),L=4,9),IB(4,K),IB(5,K) 00113000 60 CONTINUE 00114000 GO TO IRTN,(25,90) 00115000 C 00116000 70 CONTINUE 00117000 DO 80 I=MN,MX 00118000 J = MOD(I-1,5) 00119000 IF(J .NE. 0) GO TO 75 00120000 KL = I/5 + 1 00121000 FDSL = MOD(ID(4,KL),1000) 00122000 WRITE(LUNIT,160) ID(1,KL),ID(2,KL),ID(6,KL),ID(7,KL),FDSL 00123000 75 WRITE(LUNIT,FMT) IB(1,I),B(1,I),B(2,I),B(3,I),IB(2,I),IB(3,I) 00124000 1 ,(B(L,I),L=4,9),IB(4,I),IB(5,I) 00125000 80 CONTINUE 00126000 GO TO IRTN,(25,90) 00127000 C 00128000 90 CONTINUE 00129000 N = 0 00130000 RETURN 00131000 160 FORMAT(I5,I3,1X,A4,A2,47X,I3,' |',I5,I3,1X,A4,A2,47X,I3) 00132000 END 00133000 SUBROUTINE FLUXGO(XP,YP,ZP,/NP/,XS,YS,ZS,/NS/,GMT,TB,/STAT/ 1 ,MBLOCK,OUTPUT,PEX,PEY,PEZ,SEX,SEY,SEZ,MODE) C =U2MAG.FLUXGO C C MJS MAG EXPERIMENT N.F. NESS PRINCIPAL INVESTIGATOR C C UPDATE 10/7/81 BY GARY M. BURGESS C MODIFIED 1/17/90 BY G. BURGESS FOR CR-5A (VIM-5) C LOGICAL*1 SWITCH(96),MAGIC(32) LOGICAL BUFF INTEGER*2 GMT(6),NP,NS,MODE,OLDMOD INTEGER XP(1),YP(1),ZP(1),XS(1),YS(1),ZS(1),MBLOCK(3),OUTPUT(1) 1 ,PEX(1),PEY(1),PEZ(1),SEX(1),SEY(1),SEZ(1),SCFELD(8) 2 ,XSC(160),YSC(160),ZSC(160) 3 ,MAGAVE(8),PRINTI(8),HFM/'HFM '/,ENDXXX(8), CR5V(5) INTEGER CR5/'CR5A'/,CR6/'CR6A'/ C INTEGER CR7/'CR7A'/ REAL*8 TB COMMON /CCA/ WORK(500) EQUIVALENCE (WORK(1),SWITCH(1)), (SWITCH(33),MAGIC(1)) 1 ,(WORK(75),SCFELD(1)),(WORK(197),MAGAVE(1)) 2 ,(WORK(189),PRINTI(1)),(WORK(214),OLDMOD) 3 ,(WORK(205),BUFF), (WORK(206),ENDXXX(1)) 4 ,(WORK(491),CR5V(1)) C C FLUXGATE MAGNETOMETER DATA REDUCTION AND ANALYSIS C C CLEAR LAST OUTPUT BUFFER IF MODE HAS CHANGED IF((MODE .NE. OLDMOD) .AND. BUFF) CALL PASS(ENDXXX(OLDMOD+1)) C IF( MBLOCK(2) .EQ. CR6 ) 1 CALL DMFIX(XP,YP,ZP,NP,XS,YS,ZS,NS,PEX,PEY,PEZ, 2 SEX,SEY,SEZ,GMT,MBLOCK(2)) IF( MBLOCK(2) .EQ. CR5 ) 1 CALL DMFIX5(XP,YP,ZP,NP,XS,YS,ZS,NS,PEX,PEY,PEZ, 2 SEX,SEY,SEZ,GMT,MBLOCK(2)) C IF( MBLOCK(2) .EQ. CR7 ) C 1 CALL DMFIX7(XP,YP,ZP,NP,XS,YS,ZS,NS,PEX,PEY,PEZ, C 2 SEX,SEY,SEZ,GMT,MBLOCK(2)) C IF(MAGIC(31).AND.MODE.LT.8) 1 CALL PASS(PRINTI(MODE+1),XP,YP,ZP,NP,XS,YS,ZS,NS 2 ,GMT,TB,STAT,MBLOCK,OUTPUT,PEX,PEY,PEZ 3 ,SEX,SEY,SEZ) IF(MAGIC(31).AND.MODE.EQ.13) 1 CALL PASS(CR5V(3),XP,YP,ZP,NP,XS,YS,ZS,NS 2 ,GMT,TB,STAT,MBLOCK,OUTPUT,PEX,PEY,PEZ 3 ,SEX,SEY,SEZ) IF(MAGIC(25)) CALL SYSTST(MAGIC,GMT,XP,YP,ZP,NP,XS,YS,ZS,NS, * MBLOCK) C C COMPUTE AMBIENT PAYLOAD MAG FIELD DATA C OSTAT = STAT CALL PAYLOD(XP,YP,ZP,NP,XS,YS,ZS,NS,GMT,STAT,MBLOCK,MODE) IF((MBLOCK(1) .EQ. HFM) .AND. (.NOT. MAGIC(4)) .AND. MAGIC(5)) 1 CALL SENTAP (MBLOCK,XP,YP,ZP,NP,XS,YS,ZS,NS,TB,MODE) IF(MBLOCK(1) .EQ. HFM) RETURN C C COMPUTE SPACECRAFT FIELD C CALL PSLMT (XP, YP, ZP, NP, XS, YS, ZS, NS, 00000491 1 GMT, MBLOCK(3)) 00000492 TSTAT = STAT IF (MODE.EQ.6.OR.MODE.EQ.7) TSTAT = OSTAT IF (MODE.LT.8) 1 CALL PASS(SCFELD(MODE+1),XP,YP,ZP,NP,XS,YS,ZS,NS,XSC,YSC,ZSC,GMT, 2 TSTAT,MBLOCK,PEX,PEY,PEZ,SEX,SEY,SEZ) IF (MODE.EQ.13) 1 CALL PASS(CR5V(1),XP,YP,ZP,NP,XS,YS,ZS,NS,XSC,YSC,ZSC,GMT, 2 TSTAT,MBLOCK,PEX,PEY,PEZ,SEX,SEY,SEZ) C ELIMINATE DATA WHERE SCF EXCEEDS SPECIFIED LIMITS. CALL FILTER (XP,YP,ZP,NP,XS,YS,ZS,NS,XSC,YSC,ZSC) IF (MAGIC(21)) GO TO 20 IF (MAGIC(22)) GO TO 30 C *********** C * AMBIENT * C *********** IF (MAGIC(4)) CALL SENTAP (MBLOCK,XP,YP,ZP,NP,XS,YS,ZS,NS,TB,MODE)00000560 CALL AMB(XP,NP,XS,NS,XSC,MBLOCK(2),MBLOCK(15)) CALL AMB(YP,NP,YS,NS,YSC,MBLOCK(2),MBLOCK(15)) CALL AMB(ZP,NP,ZS,NS,ZSC,MBLOCK(2),MBLOCK(15)) IF (MAGIC(5)) CALL SENTAP (MBLOCK,XP,YP,ZP,NP,XSC,YSC,ZSC,NS, 1 TB,MODE) IF (MODE.LT.8) 1 CALL PASS(MAGAVE(MODE+1),XP,YP,ZP,NP,MBLOCK(13),MBLOCK, 2 XSC,YSC,ZSC,NS) IF (MODE.EQ.13) 1 CALL PASS(CR5V(4),XP,YP,ZP,NP,MBLOCK(13),MBLOCK, 2 XSC,YSC,ZSC,NS) GO TO 40 20 CONTINUE C ******************** C * PRIMARY MAG ONLY * C ******************** IF (MAGIC(4)) CALL SENTAP (MBLOCK,XP,YP,ZP,NP,XS,YS,ZS,0, 00000620 1 TB,MODE) 00000630 IF (MODE.LT.8) 1 CALL PASS(MAGAVE(MODE+1),XP,YP,ZP,NP,MBLOCK(13),MBLOCK, 2 XSC,YSC,ZSC,NS) IF (MODE.EQ.13) 1 CALL PASS(CR5V(4),XP,YP,ZP,NP,MBLOCK(13),MBLOCK, 2 XSC,YSC,ZSC,NS) GO TO 40 00000660 30 CONTINUE C ********************** C * SECONDARY MAG ONLY * C ********************** IF (MAGIC(4)) CALL SENTAP (MBLOCK,XP,YP,ZP,0,XS,YS,ZS,NS, 00000620 1 TB,MODE) 00000630 IF (MODE.LT.8) 1 CALL PASS(MAGAVE(MODE+1),XS,YS,ZS,NS,MBLOCK(13),MBLOCK, 2 XSC,YSC,ZSC,NS) IF (MODE.EQ.13) 1 CALL PASS(CR5V(4),XS,YS,ZS,NS,MBLOCK(13),MBLOCK, 2 XSC,YSC,ZSC,NS) C 40 CONTINUE OLDMOD = MODE C RETURN END SUBROUTINE GAPCR1(CODE) 00000100 LOGICAL*1 CODE 00000110 INTEGER FDSC1(2),FDSC2(2),PSC1,PSC2 00000160 COMMON /CCA/ WORK(500) 00000170 EQUIVALENCE (WORK(47),FDSC2(1)),(WORK(50),FDSC1(1)) 00000180 C =W82AL.GAPCR1 00000190 PSC1 = FDSC1(1)*60 + FDSC1(2) 00000200 PSC2 = FDSC2(1)*60 + FDSC2(2) 00000210 K = PSC1 - (PSC2 + 1) 00000220 IF(K .GT. 0) CODE =.FALSE. 00000230 RETURN 00000380 END 00000500 SUBROUTINE GAPCR2(A,B,C,D,CODE) 00000100 C 00000200 C =U2PLS.GAPCR2 BY G. BURGESS 00000300 C 00000400 LOGICAL*1 CODE 00000500 INTEGER*2 A(1),B(1),C(1),D(1) 00000600 INTEGER FDSC1(2),FDSC2(2),PSC1,PSC2 00000700 COMMON/CCA/ WORK(500) 00000800 EQUIVALENCE (WORK(47),FDSC2(1)),(WORK(50),FDSC1(1)) 00000900 PSC1 = FDSC1(1)*60 + FDSC1(2) 00001000 PSC2 = FDSC2(1)*60 + FDSC2(2) 00001100 K = PSC1 - (PSC2+1) 00001200 IF(K.LE.0)RETURN 00001300 DO 10 I=32,96 00001400 A(I)=-2 00001500 B(I)=-2 00001600 C(I)=-2 00001700 10 CONTINUE 00001800 CODE=.FALSE. 00001900 RETURN 00002000 END 00002100 SUBROUTINE GAPCR6(A,B,C,D,CODE) 00000100 C =W82AL.GAPCR6 00000110 LOGICAL*1 CODE 00000120 INTEGER*2 A(1),B(1),C(1),D(1) 00000130 INTEGER FDSC1(2),FDSC2(2),PSC1,PSC2 00000140 COMMON /CCA/ WORK(500) 00000150 EQUIVALENCE (WORK(47),FDSC2(1)),(WORK(50),FDSC1(1)) 00000160 PSC1 = FDSC1(1)*60 + FDSC1(2) 00000170 PSC2 = FDSC2(1)*60 + FDSC2(2) 00000180 K = PSC1 - (PSC2 + 30) 00000190 IF(K .LE. 0) RETURN 00000200 DO 10 I=1,128 00000210 A(I) = -2 00000220 B(I) = -2 00000230 C(I) = -2 00000240 10 CONTINUE 00000250 CODE = .FALSE. 00000260 RETURN 00000270 END 00000280 SUBROUTINE GAPGS3(A,B,C,D,CODE) 00000100 LOGICAL*1 CODE 00000110 INTEGER*2 A(1),B(1),C(1),D(1),JL(3,4)/3*25,73,73,1,3*81,3*1/, 00000120 1 JU(3,4)/3*56,80,5*128,24,56,128/ , 00000130 2 KL(3,3)/0,57, 1,4*0,1,1/, 00000140 3 KU(3,3)/0,80,128,4*0,24,128/ 00000150 INTEGER FDSC1(2),FDSC2(2),PSC1,PSC2 00000160 COMMON /CCA/ WORK(500) 00000170 EQUIVALENCE (WORK(47),FDSC2(1)),(WORK(50),FDSC1(1)) 00000180 C =W82AL.GAPGS3 00000190 PSC1 = FDSC1(1)*60 + FDSC1(2) 00000200 PSC2 = FDSC2(1)*60 + FDSC2(2) 00000210 K = PSC1 - (PSC2 + 1) 00000220 IF(K .LE. 0) RETURN 00000230 IF(K .GE. 3) K = 3 00000240 J4 = MOD(PSC2,4) + 1 00000250 L1 = JL(K,J4) 00000260 L2 = JU(K,J4) 00000270 DO 10 I=L1,L2 00000300 A(I) = -2 00000310 B(I) = -2 00000320 C(I) = -2 00000330 D(I) = -2 00000340 10 CONTINUE 00000350 J2 = MOD(PSC2,2) 00000360 IF(J2 .EQ. 0) CODE = .FALSE. 00000370 RETURN 00000380 C 00000390 ENTRY MORGS3(A,B,C,D) 00000400 L1 = KL(K,J4) 00000410 IF (L1.EQ.0) RETURN 00000415 L2 = KU(K,J4) 00000420 DO 20 I=L1,L2 00000430 A(I) = -2 00000440 B(I) = -2 00000450 C(I) = -2 00000460 D(I) = -2 00000470 20 CONTINUE 00000480 RETURN 00000490 END 00000500 SUBROUTINE GDSEQ(XSC,YSC,ZSC,NS,ISW) DIMENSION XSC(160),YSC(160),ZSC(160) DATA FILL/999./ COMMON/MAGCOM/SCFLIM,OWLTLM,PSLIM,RMSLIM SUMX=0.0 SUMY=0.0 SUMZ=0.0 N=0 DO 10 L=1,NS IF(XSC(L).EQ.FILL.OR.YSC(L).EQ.FILL.OR.ZSC(L).EQ.FILL)GO TO 10 SUMX=SUMX+XSC(L) SUMY=SUMY+YSC(L) SUMZ=SUMZ+ZSC(L) N=N+1 10 CONTINUE NO=NS-N BP=FLOAT(NO)/FLOAT(NS) C*********** IF AMOUNT OF FILL DATA GREATER THAN 50 % RETURN ********** IF(BP.GT.0.5)GO TO 30 AVEX=SUMX/N AVEY=SUMY/N AVEZ=SUMZ/N DX=0.0 DY=0.0 DZ=0.0 DO 20 I=1,NS IF(XSC(I).EQ.FILL)GO TO 20 DSX=XSC(I)-AVEX DSY=YSC(I)-AVEY DSZ=ZSC(I)-AVEZ DX=DX+(DSX*DSX) DY=DY+(DSY*DSY) DZ=DZ+(DSZ*DSZ) 20 CONTINUE SDX=SQRT(DX/(N-1)) SDY=SQRT(DY/(N-1)) SDZ=SQRT(DZ/(N-1)) IF(SDX.GT.RMSLIM.OR.SDY.GT.RMSLIM.OR.SDZ.GT.RMSLIM)GO TO 30 ISW=1 30 RETURN END C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * HAV00010 C * SUBROUTINE HAVE * HAV00020 C * * HAV00030 C * THIS SUBROUTINE INPUTS TIME,POSITIONAL AND MAGNETIC * HAV00040 C * FIELD DATA , AND ITS OUTPUT CONSISTS OF HOURLY AVER- * HAV00050 C * AGE CARDS AS A PART OF THE VOYAGER PHASE I ANALYSIS * HAV00060 C * PROGRAM. * HAV00070 C * FOR DEFINITIONS OF VARIABLES USED AND AVERAGES PRO- * HAV00080 C * DUCED, SEE GSFC DOCUMENT 'COMMONLY USED DIGITAL TAPE, * HAV00090 C * DISK AND CARD FORMATS', NOV.77. * HAV00100 C * * HAV00110 C * MODIFIED BY D.C.MEAD OCTOBER 1977 * HAV00120 C * FORTRAN 77 CONVERSION JULY 1991 * HAV00120 C * FMAG FUNCTION STATEMENT MOVED TO BELOW NON-EXEC CODE * HAV00070 C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * HAV00130 C HAV00140 SUBROUTINE HAVE (BSE,IT,SCPOS,FSC,COORD,F2,SCID) HAV00150 C HAV00160 REAL*8 SQSE, RSQ, RAD HAV00170 INTEGER*2 IT, ITM HAV00180 LOGICAL*1 SCID HAV00190 DIMENSION SDSE(3) ,FLDSE(3) ,IRSE(4) ,F2(25) ,IT(6) HAV00200 1 ,ASE(6) ,BSE(3) ,SCPOS(3) ,ITM(3) ,TRSE(4) HAV00210 2 ,FSE(3) ,SQSE(3) ,SCID(4) HAV00220 COMMON/CCA/WORK(500) HAV00230 COMMON /CLKCRD/ IY1, ID1, LH1, IM1, IS1, HAV00240 1 IY2, ID2, IH2, IM2, IS2 HAV00250 EQUIVALENCE (ASE(1),GAVE) ,(ASE(2),FSQ) ,(ASE(3),SDSE(1)) HAV00260 1 ,(ASE(6),FC) ,(FLDSE(1),FAVE) ,(WORK(32),IPCH) HAV00270 2 ,(WORK(31),NBAD),(WORK(55),JYR),(WORK(56),JDAY) HAV00280 DATA RAD/57.2957795D0/ ,FSCOLD/0./ ,NB/0/ HAV00290 DATA ITM(2)/-1/ ,ITM(3)/-1/ ,N/-1/ HAV00300 LOGICAL END/.FALSE./ ,FIRST/.TRUE./,WFIRST/.TRUE./ HAV00310 DIMENSION FMT(21) HAV00320 DATA FMT /'( ',' ','A1,A','2,I3',' ,I1',',3I5',',I2,','I3,I',HAV00330 1 '2, ','F5.2',',2F5','.1,I','2, ','F6.3',', ', HAV00340 2 'F5.3',', 3','F6.3',', ','F5.2',') '/ HAV00350 DATA BLANK/' '/ , SPACE/'1H ,'/ , F5P0/'F5.0'/ , HAV00360 1 F5P1/'F5.1'/ , F5P2/'F5.2'/ , F5P3/'F5.3'/ , HAV00370 2 F6P1/'F6.1'/ , F6P2/'F6.2'/ , F6P3/'F6.3'/ HAV00380 C =ZBDCM.HAVE HAV00390 FMAG(A,B,C) = SQRT(A*A + B*B + C*C) HAV00400 IF (WFIRST) WRITE (71,300) HAV00410 WFIRST = .FALSE. HAV00420 IF(FIRST) GO TO 30 HAV00430 FIRST = .FALSE. HAV00440 IF(ABS(FSC-FSCOLD) .LT. 2.) GO TO 20 HAV00450 IBAD = IBAD + 1 HAV00460 NB = NB + 1 HAV00470 IF(NB .GT. 5) GO TO 19 HAV00480 RETURN HAV00490 19 IF(NB .NE. 0) WRITE(6,200) NB,IBAD,IT HAV00500 20 FSCOLD = FSC HAV00510 NB = 0 HAV00520 30 FIRST = .FALSE. HAV00530 IF(IT(2) .NE. ITM(2)) GO TO 60 HAV00540 IF(IT(3) .NE. ITM(3)) GO TO 60 HAV00550 C HAV00560 C SUM THE DATA HAV00570 C HAV00580 40 CONTINUE HAV00590 IF (BSE(1) .EQ. 999.) RETURN HAV00600 N=N+1 HAV00610 TRSE(2)=TRSE(2) + SCPOS(1) HAV00620 TRSE(3)=TRSE(3) + SCPOS(2) HAV00630 TRSE(4)=TRSE(4) + SCPOS(3) HAV00640 C HAV00650 N2 = 0 HAV00660 F1 = 0. HAV00670 DO 50 I=1,25 HAV00680 IF(F2(I) .EQ. 999.) GO TO 50 HAV00690 N2 = N2 + 1 HAV00700 F1 = F1 + F2(I) HAV00710 50 CONTINUE HAV00720 IF(N2 .EQ. 0) RETURN HAV00730 F1 = F1/N2 HAV00740 C HAV00750 FAVE=FAVE + F1 HAV00760 RSQ=RSQ + F1*F1 HAV00770 FSE(1)=FSE(1) + BSE(1) HAV00780 FSE(2)=FSE(2) + BSE(2) HAV00790 FSE(3)=FSE(3) + BSE(3) HAV00800 SQSE(1)=SQSE(1) + BSE(1)*BSE(1) HAV00810 SQSE(2)=SQSE(2) + BSE(2)*BSE(2) HAV00820 SQSE(3)=SQSE(3) + BSE(3)*BSE(3) HAV00830 C HAV00840 RETURN HAV00850 C HAV00860 C AVERAGE THE DATA HAV00870 C HAV00880 ENTRY ENDAV HAV00890 IF(N .EQ. 0) RETURN HAV00900 END=.TRUE. HAV00910 GO TO 65 HAV00920 60 CONTINUE HAV00930 IF(N) 80,40,65 HAV00940 65 FN=N HAV00950 IF(N .LT. 2) GO TO 79 HAV00960 FN1=N-1 HAV00970 GAVE = 0. HAV00980 TRSE(2)=TRSE(2)/FN HAV00990 TRSE(3)=TRSE(3)/FN HAV01000 TRSE(4)=TRSE(4)/FN HAV01010 TRSE(1)=FMAG(TRSE(2),TRSE(3),TRSE(4)) HAV01020 FCTR = 1000. HAV01030 IF (TRSE(1) .GE. 10.0) FCTR = 100. HAV01040 IF (TRSE(1).GE.100.0) FCTR = 10. HAV01050 IRSE(1) = TRSE(1)*FCTR HAV01060 IRSE(2) = TRSE(2)*FCTR HAV01070 IRSE(3) = TRSE(3)*FCTR HAV01080 IRSE(4) = TRSE(4)*FCTR HAV01090 C HAV01100 FSQ = DSQRT((RSQ - ((DBLE(FAVE)*DBLE(FAVE))/FN) )/FN1) HAV01110 FAVE=FAVE/FN HAV01120 DO 70 I=1,3 HAV01130 SDSE(I) = DSQRT((SQSE(I) - ((DBLE(FSE(I))*DBLE(FSE(I)))/FN) )/FN1)HAV01140 GAVE = GAVE + SDSE(I)**2 HAV01150 FSE(I)=FSE(I)/FN HAV01160 70 CONTINUE HAV01170 GAVE = SQRT(GAVE) HAV01180 C HAV01190 FC=FMAG(FSE(1),FSE(2),FSE(3)) HAV01200 C FLDSE(1)=FAVE EQUIVALENCED HAV01210 FLDSE(2)=ARSIN(FSE(3)/FC)*RAD HAV01220 FLDSE(3)=180.-ATAN2(FSE(2),-FSE(1))*RAD HAV01230 C HAV01240 C ASE(1)=GAVE EQUIVALENCED HAV01250 C ASE(2)=FSQ EQUIVALENCED HAV01260 C ASE(6)=FC EQUIVALENCED HAV01270 ASE(1) = AMIN1(ASE(1),9999.9) HAV01280 ASE(2) = AMIN1(ASE(2),9999.) HAV01290 ASE(3) = AMIN1(ASE(3),9999.9) HAV01300 ASE(4) = AMIN1(ASE(4),9999.9) HAV01310 ASE(5) = AMIN1(ASE(5),9999.9) HAV01320 ASE(6) = AMIN1(ASE(6),9999.) HAV01330 FMT(2) = BLANK HAV01340 FMT(10)= F5P2 HAV01350 FMT(20) = F5P2 HAV01360 IF (FLDSE(1) .LT. 100.) GO TO 71 HAV01370 FMT(10)= F5P1 HAV01380 FMT(20) = F5P1 HAV01390 IF (FLDSE(1) .LT. 1000.) GO TO 71 HAV01400 FMT(10)= F5P0 HAV01410 FMT(20) = F5P0 HAV01420 71 FMT(14) = F6P3 HAV01430 FMT(18) = F6P3 HAV01440 IF (ASE(1) .LT. 100.) GO TO 72 HAV01450 FMT(14) = F6P2 HAV01460 FMT(18) = F6P2 HAV01470 IF (ASE(1) .LT. 1000.) GO TO 72 HAV01480 FMT(14) = F6P1 HAV01490 FMT(18) = F6P1 HAV01500 72 FMT(16) = F5P3 HAV01510 IF (ASE(2) .LT. 10.) GO TO 73 HAV01520 FMT(16) = F5P2 HAV01530 IF (ASE(2) .LT. 100.) GO TO 73 HAV01540 FMT(16) = F5P1 HAV01550 IF (ASE(2) .LT. 1000.) GO TO 73 HAV01560 FMT(16) = F5P0 HAV01570 73 CONTINUE HAV01580 IF (ITM(1) .LT. IY1) GO TO 79 HAV01590 IF (ITM(1) .GT. IY1) GO TO 75 HAV01600 IF (ITM(2) .LT. ID1) GO TO 79 HAV01610 IF (ITM(2) .GT. ID1) GO TO 75 HAV01620 IF (ITM(3) .LT. IH1) GO TO 79 HAV01630 75 CONTINUE HAV01640 IF (ITM(1) .GT. IY2) GO TO 79 HAV01650 IF (ITM(1) .LT. IY2) GO TO 77 HAV01660 IF (ITM(2) .GT. ID2) GO TO 79 HAV01670 IF (ITM(2) .LT. ID2) GO TO 77 HAV01680 IF (ITM(3) .GT. IH2) GO TO 79 HAV01690 77 CONTINUE HAV01700 JYEAR = MOD(JYR,10) HAV01710 WRITE(70,FMT)SCID(4),COORD,JDAY,JYEAR,IRSE(2),IRSE(3),IRSE(4), HAV01720 X ITM(1),ITM(2),ITM(3),FLDSE,N,ASE HAV01730 FMT(2) = SPACE HAV01740 WRITE (71,FMT) SCID(4),COORD,JDAY,JYEAR,IRSE(2),IRSE(3),IRSE(4), HAV01750 X ITM(1),ITM(2),ITM(3),FLDSE,N,ASEHAV01760 IPCH=IPCH+1 HAV01770 79 IF(END) RETURN HAV01780 C HAV01790 80 CONTINUE HAV01800 ITM(1) = IT(1) HAV01810 ITM(2) = IT(2) HAV01820 ITM(3) = IT(3) HAV01830 WRITE(6,210) IBAD,ITM HAV01840 NBAD = NBAD + IBAD HAV01850 IBAD = 0 HAV01860 N=0 HAV01870 GAVE=0.0 HAV01880 FAVE=0.0 HAV01890 RSQ=0.0D0 HAV01900 DO 90 I=1,3 HAV01910 TRSE(I)=0.0 HAV01920 FSE(I)=0.0 HAV01930 SQSE(I)=0.0D0 HAV01940 90 CONTINUE HAV01950 TRSE(4)=0.0 HAV01960 GO TO 40 HAV01970 200 FORMAT(' SCFIELD EDIT HAS THROWN OUT TOO MANY VALUES - ACCEPT THE HAV01980 1LAST VALUE AND RESET',/,1X,4I4,3(':',I2),'.',I3) HAV01990 210 FORMAT(1X,I4,' BAD VALUES ELIMINATED FROM HOUR',3I5) HAV02000 300 FORMAT ('1THE FOLLOWING HOURLY AVERAGE CARDS WERE PUNCHED:') HAV02010 END HAV02020 SUBROUTINE HEADR 00001000 C ********** =W82JB.HEADR ********** 00001500 LOGICAL*1 FLT(4),MAG(32) 00002000 INTEGER*2 IY 00003000 INTEGER PAGE6/0/,PAGE48/0/,FDSC(3) 00004000 REAL*8 SS6(24),SS48(24),MODE 00005000 DIMENSION FLUB(18),ID(7,24) 00006000 COMMON / CCA/ WORK(200) 00007000 COMMON /OUTPUT/ HDR(32) 00008000 EQUIVALENCE (WORK(60),CORD),(WORK(63),MODE),(WORK(9),MAG(1)) 00009000 1 ,(HDR(11),TLBL),(WORK(55),IYR) 00010000 2 ,(WORK(57),IMON),(WORK(58),IDM) 00011000 3 ,(IY,HDR(4)),(FLT(1),HDR(3)) 00012000 C 00013000 ENTRY HEAD6(LUNIT,FDSC,ID,FLUB,SS6,/J6/) 00014000 IYEAR = IY 00015000 CALL DATCON(IYEAR,ID(1,1),JMON,JDM) 00016000 PAGE6 = PAGE6 + 1 00017000 IF (.NOT. MAG(27)) GO TO 10 00018000 WRITE(LUNIT,155) FLT(4),CORD,MODE,JMON,JDM,IYEAR,TLBL,FDSC,PAGE6 00019000 1 ,IMON,IDM,IYR 00020000 GO TO 20 00021000 10 WRITE(LUNIT,150) FLT(4),CORD,MODE,JMON,JDM,IYEAR,TLBL,FDSC,PAGE6 00022000 1 ,IMON,IDM,IYR 00023000 20 WRITE(LUNIT,190) CORD,(FLUB(I),I=1,6),FLUB(18) 00024000 1 ,(FLUB(I),I=10,17),(FLUB(I),I=7,9) 00025000 WRITE(LUNIT,160) (ID(4,I),SS6(I),I=1,J6) 00026000 J6= 0 00027000 GO TO 50 00028000 C 00029000 ENTRY HEAD48(LUNIT,FDSC,ID,FLUB,SS48,/J48/) 00030000 IYEAR = IY 00031000 CALL DATCON(IYEAR,ID(1,1),JMON,JDM) 00032000 PAGE48 = PAGE48 + 1 00033000 IF (.NOT. MAG(27)) GO TO 30 00034000 WRITE(LUNIT,175) FLT(4),CORD,MODE,JMON,JDM,IYEAR,TLBL,FDSC,PAGE48 00035000 1 ,IMON,IDM,IYR 00036000 GO TO 40 00037000 30 WRITE(LUNIT,170) FLT(4),CORD,MODE,JMON,JDM,IYEAR,TLBL,FDSC,PAGE48 00038000 1 ,IMON,IDM,IYR 00039000 40 WRITE(LUNIT,190) CORD,(FLUB(I),I=1,6),FLUB(18) 00040000 1 ,(FLUB(I),I=10,17),(FLUB(I),I=7,9) 00041000 WRITE(LUNIT,160) (ID(4,I),SS48(I),I=1,J48) 00042000 J48 = 0 00043000 50 CONTINUE 00044000 WRITE(LUNIT,180) 00045000 RETURN 00046000 150 FORMAT('1VOYAGER ',A1,' MAGNETOMETER EXP 1.92 SEC' 00047000 1 ,' AVERAGES IN ',A3,' COORDINATES ',A8,' MODE, FROM ' 00048000 1 ,A4,I3,I5,1X,A3,', FDSC=',I5,'.',I2,'.',I3,3X,'PAGE=',I3 00049000 3 ,/,82X,'RUN ',A4,I3,I5) 00050000 155 FORMAT('1VOYAGER ',A1,' SPACECRAFT FIELD 1.92 SEC' 00051000 1 ,' AVERAGES IN ',A3,' COORDINATES ',A8,' MODE, FROM ' 00052000 1 ,A4,I3,I5,1X,A3,', FDSC=',I5,'.',I2,'.',I3,3X,'PAGE=',I3 00053000 3 ,/,82X,'RUN ',A4,I3,I5) 00054000 160 FORMAT(' STATUS',8(3X,I3,1X,A8),2(/,7X,8(3X,I3,1X,A8))) 00055000 170 FORMAT('1VOYAGER ',A1,' MAGNETOMETER EXP 48 SEC' 00056000 1 ,' AVERAGES IN ',A3,' COORDINATES ',A8,' MODE, FROM ' 00057000 1 ,A4,I3,I5,1X,A3,', FDSC=',I5,'.',I2,'.',I3,3X,'PAGE=',I3 00058000 3 ,/,82X,'RUN ',A4,I3,I5) 00059000 175 FORMAT('1VOYAGER ',A1,' SPACECRAFT FIELD 48 SEC' 00060000 1 ,' AVERAGES IN ',A3,' COORDINATES ',A8,' MODE, FROM ' 00061000 1 ,A4,I3,I5,1X,A3,', FDSC=',I5,'.',I2,'.',I3,3X,'PAGE=',I3 00062000 3 ,/,82X,'RUN ',A4,I3,I5) 00063000 180 FORMAT(' DDY HR',61X,'DDY HR' 00064000 1 ,/, ' MN SEC F1 F2 TH PH X Y Z ' 00065000 1 ,' RMSX RMSY RMSZ N',1X, 00066000 2 ' MN SEC F1 F2 TH PH X Y Z ' 00067000 3 ,' RMSX RMSY RMSZ N') 00068000 190 FORMAT( ' PL TO ',A3,3F9.5,' S/C FIELD (PL) X Y Z' 00069000 1 ,' |B| S/C X Y Z '00070000 2 ,'|R|',/,' ROTATION ',3F9.5,5X,F4.1, ' SEC (',3(F6.2,',')00071000 3 ,F6.2,') POSITION (',3(F8.2,','),F8.2,')',/ 00072000 4 ,' MATRIX ',3F9.5,6X,'AVERAGE',/) 00073000 END 00074000 SUBROUTINE INIT(SYSW,DDNS,DDNZ,*,*) 00010000 C 00020001 C 85SEP12 J.A.JONES SAR ADDED URANUS COORDINATE SYSTEM, U1. 00030004 C 85SEP16 J.A.JONES SAR TEST FOR MORE THAN ONE COORDINATE SYSTEM. 00040004 C 89AUG07 J.A.JONES STX ADDED NEPTUNE COORDINATE SYSTEM, N1. 00041011 C 00050001 LOGICAL*1 SYSW(32,3),SWITCH(32),ROT*4,MD*4 00060000 INTEGER*2 TYPE(10),COORD 00070000 INTEGER*4 IYMD(3),NOW(8) 00080015 REAL*8 DDNS(3),DDNZ(3),NAME1(2),NAME2(2),ENCTR/'ENCOUNTR'/ 00090000 REAL*8 JOBNAM,BLANK/' '/,DDN(3,3) 00100000 DIMENSION NM(3) 00120000 COMMON /CCA/ WORK(500) 00130000 C MAGCOM COMMON BLOCK VALUES ARE SET IN THIS ROUTINE. 00140000 C THIS COMMON BLOCK ALSO APPEARS IN ROUTINES FILTER, TCHECK, PSLMT, 00150000 C JOBSUM 00160000 COMMON /MAGCOM/ SCFLIM,OWLTLM, PSLIM, RMSLIM 00170010 EQUIVALENCE (WORK(65),ROT),(WORK(61),ICOORD),(WORK(60),COORD) 00180000 1 ,(WORK(62),MD),(WORK(83),DDN(1,1)) 00190000 DATA TYPE/'PL','HG','L1','S3','U1','N1','??','??','??','??'/ 00200011 DATA NM/'SYS ','MAG ','PLS '/ 00210000 NAMELIST /MAGKON/ SCFLIM,OWLTLM, PSLIM, RMSLIM 00220010 C 00230000 C GET PROGRAM OPTIONS 00240000 C 00250000 C 'NAME1' AND 'NAME2' ARE USED ON 'MAG' SWITCHING VECTOR CARD 00260000 C TO OVERRIDE THE DEFAULT NAMES OF PDS MEMBERS CONTAINING 00270000 C THE ZERO AND SENSITIVITY LEVELS 00280000 C NAME1(1) = ZERO LEVELS FOR FLT1 00290000 C NAME1(2) = SENSITIVITIES FOR FLT1 00300000 C NAME2(1) = ZERO LEVELS FOR FLT2 00310000 C NAME2(2) = SENSITIVITIES FOR FLT2 00320000 C 00330000 C SWITCHING VECTOR CARD LOOKS LIKE THIS: 00340000 C COL 3 33 4 5 6 00350000 C 1 2 67 5 3 1 00360000 C T T T T T TMAG FLT1ZEROFLT1SENSFLT2ZEROFLT2SE00370000 C 00380000 C 00390000 C SYSW FLAGS ARE AS FOLLOWS: 00400001 C SYSW(X,1) : SYS 00410001 C SYSW(X,2) : MAG 00420001 C SYSW(X,3) : PLS 00430001 C 00440001 C 00450001 CALL JOBID (JOBNAM) 00460000 C REPLACED FOR CONVERSION TO MVS/XA 00461015 C CALL RPDAT0 (1,IYMD) 00470015 CALL DATIM(NOW) 00471015 IYMD(1) = NOW(8) 00472015 IYMD(2) = NOW(7) 00473015 IYMD(3) = NOW(6) 00474015 C 00475015 WRITE (6,10) JOBNAM,IYMD(2),IYMD(3),IYMD(1) 00480000 10 FORMAT (1X,A8,3X,I2,'/',I2,'/',I4) 00490015 DO 27 L=1,3 00500000 READ(5,150,END=30) SWITCH,ID,NAME1,NAME2 00510000 DO 15 I=1,3 00520000 IF(ID .EQ. NM(I)) GO TO 20 00530000 15 CONTINUE 00540000 WRITE(6,160) ID 00550000 C 00560000 20 DO 25 K=1,32 00570000 SYSW(K,I) = SWITCH(K) 00580000 25 CONTINUE 00590000 IF(I .NE. 2) GO TO 26 00600000 DDNZ(1) = NAME1(1) 00610000 DDNZ(2) = NAME2(1) 00620000 DDNS(1) = NAME1(2) 00630000 DDNS(2) = NAME2(2) 00640000 26 IF(I .EQ. 1) GO TO 27 00650000 SYSW(4-I,1) = .TRUE. 00660000 27 CONTINUE 00670000 30 CONTINUE 00680000 IF(L .EQ. 1) GO TO 950 00690000 SYSW(6,1) = (.NOT. SYSW(1,1)) .AND. (.NOT. SYSW(2,1)) 00700000 CALL WRITE1 00710000 IF(SYSW(19,2) .AND. SYSW(20,2)) GO TO 800 00720000 C 00730004 C (* SET OUTPUT COORDINATE SYSTEM. *) 00740004 ROT = .FALSE. 00750000 ICOORD = 1 00760000 KCOORD = 0 00770002 DO 40 I=1,9 00780000 IF(SYSW(I+7,1)) ICOORD = I + 1 00790004 IF(SYSW(I+7,1)) KCOORD = KCOORD + 1 00800004 ROT = ROT .OR. SYSW(I+7,1) 00810004 40 CONTINUE 00820000 COORD = TYPE(ICOORD) 00830004 C (* WAS MORE THAN ONE SYSTEM REQUESTED? *) 00840004 IF(KCOORD .GT. 1) GO TO 1050 00850003 C (* COORDINATE SYSTEMS GREATER THAN 6 ARE NOT IMPLEMENTED. *) 00860011 IF(ICOORD .GT. 6) GO TO 1060 00870011 IF(SYSW(23,2) .AND. ROT) GO TO 925 00880004 C 00890004 C (* SET MODE (ENCOUNTER OR CRUISE). *) 00900004 C---> IF(ICOORD .LE. 3) GO TO 50 <--- REPLACED 85SEP17, JAJ 00910005 IF(ICOORD .LE. 2) GO TO 50 00920005 MD = .TRUE. 00930004 CALL FMOVE(WORK(63),8,ENCTR) 00940004 50 CONTINUE 00950000 C 00960004 IF (SYSW(18,1).AND.(.NOT.SYSW(20,1))) GO TO 970 00970000 IF (SYSW(7,2).AND.(.NOT.ROT)) GO TO 985 00980000 IF ( SYSW(5,2) .AND. 00990000 1 (SYSW(21,2) .OR. SYSW(22,2))) GO TO 990 01000000 IF ( SYSW(6,2) .AND. 01001013 1 (SYSW(21,2) .OR. SYSW(22,2))) GO TO 995 01002013 IF (SYSW(7,2) .AND. .NOT. 01010014 1 (SYSW(4,2) .OR. SYSW(5,2) .OR. SYSW(6,2))) GO TO 1000 01011014 IF (SYSW(5,2) .AND. SYSW(4,2)) GO TO 1025 01020000 IF (SYSW(6,2) .AND. .NOT. (SYSW(4,2) .OR. SYSW(5,2))) GO TO 1030 01030000 IF (SYSW(26,2) .AND. .NOT. (SYSW(21,2) .OR. SYSW(22,2))) 01040000 1 GO TO 1040 01050000 IF ((SYSW(21,2) .OR. SYSW(22,2)) .AND. SYSW(27,2)) GO TO 1070 01051008 C 01060000 C READ IN PLS CONSTANTS AND CALIBRATIONS 01070000 C 01080000 CALL WRITE3 01090000 CALL PLSNML 01091012 C 01100000 C SET UP THE INPUT BUFFERS 01110000 C 01120000 C READ CONSTANTS FOR MAGNETOMETER PROCESSING (SET DEFAULTS) 01130000 READ (17,MAGKON,END=55) 01170000 55 CONTINUE 01180000 C INITIALIZE VARIABLES FOR DETAIL TAPE 01190000 IF (SYSW(4,2) .OR. SYSW(5,2)) CALL DETINT 01200000 C 01210000 CALL PRIME(&900) 01220000 C 01230000 C CALL ZDATE TO CHOOSE ZEROS AND SENSITIVITES BY DATE 01240000 C 01250000 C CHECK ZERO VALUE IN FLT1 01260000 IF(DDNZ(1).EQ.BLANK) CALL ZDATE(1,1) 01270000 C CHECK SENS VALUE IN FLT1 01280000 IF(DDNS(1).EQ.BLANK) CALL ZDATE(1,2) 01290000 C CHECK ZERO VALUE IN FLT2 01300000 IF(DDNZ(2).EQ.BLANK) CALL ZDATE(2,1) 01310000 C CHECK SENS VALUE IN FLT2 01320000 IF(DDNS(2).EQ.BLANK) CALL ZDATE(2,2) 01330000 C 01340000 C* USE FLT2 CONSTANTS FOR PTM 01350000 DDNZ(3) = DDNZ(2) 01360000 DDNS(3) = DDNS(2) 01370000 C**** SET CALIBRATIONS 01380000 CALL ZDATE(1,3) 01390006 CALL ZDATE(2,3) 01391006 DDN(3,3) = DDN(2,3) 01392006 C* 01420000 CALL COUNTS(SYSW,&900,&700) 01430000 C 01440000 RETURN 01450000 C 01460000 700 RETURN 2 01470000 800 WRITE(6,180) 01480000 900 RETURN 1 01490000 925 WRITE(6,190) 01500000 RETURN 1 01510000 950 CONTINUE 01520000 WRITE(6,170) 01530000 RETURN 1 01540000 970 WRITE(6,195) 01550000 RETURN 1 01560000 985 WRITE (6,210) 01570000 RETURN 1 01580000 990 WRITE (6,220) 01590000 RETURN 1 01600000 995 WRITE (6,225) 01601013 RETURN 1 01602013 1000 WRITE (2,230) 01610000 RETURN 1 01620000 1025 WRITE (6,270) 01630000 RETURN 1 01640000 1030 WRITE (6,280) 01650000 RETURN 1 01660000 1040 WRITE (6,290) 01670000 RETURN 1 01680000 1050 WRITE (6,300) 01690002 RETURN 1 01700002 1060 WRITE (6,310) ICOORD 01710004 RETURN 1 01720004 1070 WRITE (6, 320) 01721008 RETURN 1 01722008 150 FORMAT(32L1,A4,4A8) 01730000 160 FORMAT(' INVALID SWITCHING VECTOR ID ON DATA CARD=',A3) 01740000 170 FORMAT(' THE DUMMY THAT SUBMITTED THIS JOB LEFT OUT THE SWITCHING'01750000 1 ,' VECTORS, FIX AND RESUBMIT') 01760000 180 FORMAT(' INVALID SWITCHING VECTOR COMBINATION MAG 19 & 20') 01770000 190 FORMAT(' INVALID SWITCHING VECTOR COMBINATION, ', 01780000 1 ' MAG(23) AND SYS(8-16)') 01790000 195 FORMAT(' INVALID SWITCHING VECTOR COMBINATION , ', 01800000 1 ' SYS(18) AND NOT SYS(20)') 01810000 210 FORMAT(' INVALID SWITCHING VECTOR COMBINATION, ', 01820000 1 ' MAG( 7) AND NOT SYS(8-16)') 01830000 220 FORMAT (' INVALID SWITCHING VECTOR COMBINATION, MAG(5)' 01840000 1 ,' CANNOT BE USED WITH MAG(21) OR MAG(22)') 01850000 225 FORMAT (' INVALID SWITCHING VECTOR COMBINATION, MAG(6)' 01851013 1 ,' CANNOT BE USED WITH MAG(21) OR MAG(22)') 01852013 230 FORMAT (' INVALID SWITCHING VECTOR COMBINATION, ', 01860014 1 ' MAG(4,5 OR 6) MUST BE SET TO USE MAG(7)') 01870014 270 FORMAT (' INVALID SWITCHING VECTOR COMBINATION', 01880000 1 ' MAG(4) AND MAG(5)') 01890000 280 FORMAT (' INVALID SWITCHING VECTOR COMBINATION - MAG(4) OR' 01900000 1 ,' MAG(5) MUST BE SET TO USE MAG(6)') 01910000 290 FORMAT (' INVALID SWITCHING VECTOR COMBINATION - MAG(21) OR' 01920000 1 ,' MAG(22) MUST BE SET TO USE MAG(26)') 01930000 300 FORMAT (' MORE THAN ONE COORDINATE SYSTEM WAS REQUESTED. ' 01940002 1 ,' WHICH DO YOU WANT?') 01950002 310 FORMAT (' REQUESTED COORDINATE SYSTEM IS NOT IMPLEMENTED. ' 01960004 1 ,' ICOORD =', I3) 01970004 320 FORMAT (' S/C FIELD (MAG27) CANNOT BE SELECTED WITH EITHER', 01971008 1 ' PRIMARY MAG (MAG21) OR SECONDARY MAG (MAG22)') 01972009 END 01980000 SUBROUTINE INPUT(IRATE,*,*) 00000100 C =U2DRH.INPUT 00000110 EXTERNAL DECOM,ENG,SHIFT,MERGE 00000120 LOGICAL EOF/.FALSE./ 00000130 INTEGER SCID,ITB*2(6),EIO*2(10) 00000140 REAL*8 EDRTAP/'EDRLIST '/,TIME,TIME2,VOLSER,SENSE,OLDVOL 00000150 1 ,BLANK/' '/,MED1,VOLEDR(10),TEMP 00000153 REAL*4 SENS(2)/2*' '/ 00000155 COMMON /EDR/ EDR1,EDR2(2820) 00000160 COMMON /CCA/ WORK(500) 00000170 EQUIVALENCE (WORK(33),SCID),(WORK(41),TIME),(WORK(43),LAB) 00000180 1 ,(WORK(44),IYR),(WORK(53),IRT),(WORK(59),NREC) 00000190 2 ,(WORK(151),EIO(1)),(WORK(156),NEIO),(WORK(121),NEDR) 00000192 3 ,(SENS(1),SENSE),(WORK(35),TIME2),(WORK(215),MED1) 00000194 4 ,(WORK(101),VOLEDR(1)),(WORK(157),OLDVOL) 00000196 DATA IBCN/0/,LC/-1/ 00000200 C 00000210 C EDR INPUT ROUTINE 00000220 C 00000230 C EDR1 = ADDRESS OF NEXT RECORD 00000240 C EDR2 = CURRENT DATA RECORD 00000250 C 00000260 C MOVE NEXT RECORD TO CURRENT AREA 00000270 C AND GET NEW NEXT RECORD 00000280 C 00000290 IF(EOF) RETURN 2 00000310 CALL LINK(EDR1,SHIFT,&980) 00000320 IRATE = IRT 00000330 10 CONTINUE 00000340 CALL FREAD(EDR1,EDRTAP,LRECL,LC,&950,&900) 00000350 MED1 = BLANK 00000355 CALL IDTEST(EDR1,SCID,&50,&60,&10,&975) 00000360 CALL TCHECK(&10,&960) 00000370 IF(TIME .LT. (TIME2+2.8D-4)) CALL LINK(EDR1,MERGE,&10) 00000385 NREC = NREC + 1 00000395 RETURN 00000400 C 00000410 50 CALL LINK(EDR1,DECOM) 00000420 55 CALL WATSUP(EDRTAP,VOLSER,UNIT) 00000421 IF(OLDVOL .EQ. VOLSER) GO TO 10 00000422 CALL JOBSUM 00000423 OLDVOL = VOLSER 00000424 WRITE(6,180) VOLSER,UNIT 00000425 NEDR = NEDR + 1 00000426 VOLEDR(NEDR) = VOLSER 00000427 GO TO 10 00000430 C 00000440 60 CALL LINK(EDR1,ENG) 00000480 GO TO 10 00000510 900 CALL WATSUP(EDRTAP,TEMP,UN,SENSE) 00000515 CALL SETIME(IYR,TIME,ITB) 00000520 WRITE(6,150) TEMP,UN,SENSE,ITB 00000523 NEIO =NEIO + 1 00000525 IF(TEMP .EQ. OLDVOL) GO TO 920 00000530 EIO(NEDR+1) = EIO(NEDR+1) + 1 00000535 GO TO 55 00000540 920 EIO(NEDR) = EIO(NEDR) + 1 00000545 GO TO 10 00000550 950 CALL SETIME(IYR,TIME,ITB) 00000560 CALL WATSUP(EDRTAP,VOLSER) 00000575 WRITE(6,160) VOLSER,ITB,LAB 00000580 960 EOF = .TRUE. 00000590 NREC = NREC + 1 00000595 RETURN 00000600 975 IBCN = IBCN + 1 00000610 IF (IBCN.LE.70) GO TO 10 00000612 RETURN 1 00000614 980 RETURN 2 00000615 150 FORMAT(' I/O ERROR ON EDR ',A6,'(',A3,') SENSE BYTES=',Z12, 00000620 1 ' AFTER TIME',2I4,3(':',I2),'.',I3,', PROCESSING CONTINUES') 00000630 160 FORMAT(' END FILE ON EDR TAPE ',A6,' AFTER',2I4,3(':',I2),'.' 00000640 1 ,I3,1X,A4) 00000650 180 FORMAT(T100,' MJS EDR VOL=SER=',A6,' UNIT=',A3) 00000660 END 00000670 SUBROUTINE INVRT(X1,X2,N) 00000100 INTEGER*2 N 00000110 REAL*4 X1(1),X2(1) 00000120 C =U2MAG.INVRT 00000130 C WHEN A MECHANICAL FLIP HAS TAKEN 00000132 C PLACE, REVERSE THE SIGN OF TWO SENSORS 00000134 C 00000136 DO 10 I=1,N 00000140 IF (X1(I).NE.999.) X1(I) = - X1(I) 00000150 IF (X2(I).NE.999.) X2(I) = - X2(I) 00000160 10 CONTINUE 00000170 RETURN 00000180 END 00000190 SUBROUTINE JAM 00000100 INTEGER ANCHOR,SN(8),NBYTE(8),NBT,NST,NQE,QN(8),QBYTE(8) 00000110 COMMON /HEADER/ ANCHOR(6,8) 00000120 C =U2DRH.JAM 00000130 C TALLY TOTAL AMOUNT OF SPACE ALLOCATED FOR DATA BLOCKS 00000140 C 00000150 CALL STACK(SN,NBYTE) 00000160 CALL RDQUE(QN,QBYTE) 00000170 NBT = 0 00000180 NST = 0 00000190 NQE = 0 00000200 NQB = 0 00000210 DO 10 I=1,8 00000220 NQE = NQE + QN(I) 00000230 NQB = NQB + QBYTE(I) 00000240 NST = NST + SN(I) 00000250 NBT = NBT + NBYTE(I) 00000260 10 CONTINUE 00000270 WRITE(6,160) (ANCHOR(4,I),I=1,8) 00000280 WRITE(6,170) QN,NQE 00000290 WRITE(6,180) QBYTE,NQB 00000300 WRITE(6,190) SN,NST 00000310 WRITE(6,200) NBYTE,NBT 00000320 C 00000330 NBLK = NQE + NST 00000340 NCORE = NBT+ NQB 00000350 NC = NCORE/1024. + 0.5 00000360 WRITE(6,210) NBLK,NCORE,NC 00000370 RETURN 00000380 C 00000390 160 FORMAT(/,' THE CURRENT QUEUE/STACK CONFIGURATION IS:',/ 00000400 1 ,5X,8(5X,A3),' TOTAL') 00000410 170 FORMAT(5X,9I8,' QUEUE BLOCK COUNT') 00000420 180 FORMAT(5X,9I8,' QUEUE BLOCK ALLOCATION IN BYTES') 00000430 190 FORMAT(5X,9I8,' STACK BLOCKS AVAILABLE') 00000440 200 FORMAT(5X,9I8,' BYTES TOTAL IN STACK') 00000450 210 FORMAT(/,' TOTAL DATA BLOCK ALLOCATION IS ',I4,' BLOCKS', 00000460 1 ' CONSUMING ',I6,' BYTES(',I3,'K)',/) 00000470 END 00000480 SUBROUTINE JOBSUM LOGICAL FIRST/.TRUE./ INTEGER*2 ITB(6),ITE(6) INTEGER SCN,FDSC1(3),FDSC2(3),FDSV(3),FDSC0(3),CPU1,CPU2 REAL*8 TSV,TIME1,TIME2,VOLEDR(10),TSV0 DIMENSION SCID(4),TINC(15) COMMON /MAGCOM/ SCFLIM, OWLTLM, PSLIM COMMON /CCA/ WORK(500) EQUIVALENCE (WORK(54),FMT),(WORK(34),SCN),(WORK(59),NREC) 1 ,(WORK(35),TIME2),(WORK(38),IYR2),(WORK(37),TYPE) 2 ,(WORK(41),TIME1),(WORK(44),IYR1),(WORK(156),NEIO) 3 ,(WORK(101),VOLEDR(1)),(WORK(121),NEDR) 4 ,(WORK(47),FDSC2(1)),(WORK(50),FDSC1(1)) 5 ,(WORK(53),IRATE),(WORK(220),LMERGE) 6 ,(WORK(221),LTMREG),(WORK(222),LDOWLT) DATA SCID/'FLT2','FLT1','PTM ','XXXX'/,LINE,NTOT,NIO/0,0,0/ 1 ,REALT0,PROCT0/0.,0./,IRATP/-1/ 2 ,TINC/48.,48.,48.,96.,192.,576.,1440.,0.,0.,0., 3 0.,0.,0.,192.,192./ C =U2DRH.JOBSUM C IF(NREC .EQ. 0) GO TO 30 CALL SETIME(IYR2,TIME2,ITE) CALL SETIME(IYRSV,TSV,ITB) CALL REMTIM(CPU2,IO2) PROCT = (CPU1-CPU2)/60. IF (IRATP.EQ.-1) IRATP = IRATE REALT = NREC*(TINC(IRATP+1)/60.) TIMDR = TINC(IRATP+1)/86400.0 IRATP = IRATE IF (PROCT .EQ. 0.0) THEN WRITE(4,*) 'PROCT = 0 : RATIO UNDEFINED' RATIO = -999.0 GOTO 11 ENDIF RATIO = REALT/PROCT 11 IF(MOD(LINE,60) .EQ. 0) WRITE(4,160) LINE = LINE + 1 WRITE(4,150) ITB,ITE,TYPE,FDSV,FDSC2,NREC,REALT,PROCT,RATIO 1 ,SCID(SCN+1),FMT,VOLEDR(NEDR),NEIO FIRST = .FALSE. NIO = NIO + NEIO REALT0 = REALT0 + REALT PROCT0 = PROCT0 + PROCT NTOT = NTOT + NREC NREC = 0 30 CONTINUE CALL REMTIM(CPU1,IO1) TSV = TIME1 IYRSV = IYR1 FDSV(1) = FDSC1(1) FDSV(2) = FDSC1(2) FDSV(3) = FDSC1(3) IF(.NOT. FIRST) RETURN TSV0 = TIME1 IYR0 = IYR1 FDSC0(1) = FDSC1(1) FDSC0(2) = FDSC1(2) FDSC0(3) = FDSC1(3) RETURN C ENTRY FINISH IF(NTOT .EQ. 0) GO TO 50 CALL SETIME(IYR0,TSV0,ITB) C RATIO = REALT0/PROCT0 WRITE(4,170) WRITE(4,180) ITB,ITE,TYPE,FDSC0,FDSC2,NTOT,REALT0,PROCT0,RATIO,NIO C**** COMPUTE & PRINT DATA HOURS PER DAY. IF (IYR0.NE.IYR2.OR.TIME2+TIMDR.EQ.TSV0) GO TO 35 IF ((TIME2-TSV0+TIMDR).EQ.0.0) GOTO 35 DATART = REALT0/(60.E0*(TIME2 - TSV0 + TIMDR)) WRITE (4,200) DATART C**** PRINT NUMBER OF MERGED & DELETED RECORDS. 35 IF (LMERGE.GT.0) WRITE (4,210) LMERGE IF (LTMREG.GT.0) WRITE (4,220) LTMREG IF (LDOWLT.GT.0) WRITE (4,230) LDOWLT, OWLTLM RETURN C 50 CONTINUE WRITE(4,190) WRITE(6,190) RETURN C 150 FORMAT(2(1X,I2,I4,3(':',I2),'.',I3),1X,A4,2(I6,'.',I2,'.',I3) 1 ,I5,F7.1,F5.1,F7.1,2X,A4,2X,A4,2X,A6,I4) 160 FORMAT('1 START TIME END TIME START ' 1 ,' END REC DATA PROC DATA/ SPACE TELM VOLUME', A ' PERM',/ 2 ,2(' YR DAY HR MN SEC '),6X,' FDSC FDSC ' 3 ,'CNT MINS MINS PROC CRAFT FMT SERIAL I/O') 170 FORMAT(//,T110,'JOB SUMMARY') 180 FORMAT(2(1X,I2,I4,3(':',I2),'.',I3),1X,A4,2(I6,'.',I2,'.',I3) 1 ,I5,F7.1,F5.1,F7.1,20X,I4) 190 FORMAT(//,' ** JOB TERMINATED WITH NO DATA IN INTERVAL *',/) 200 FORMAT ('0DATA HOURS PER DAY = ',2PE10.1/'0') 210 FORMAT (' # OF MERGED MAG/PLS RECORDS = ',I5) 220 FORMAT (' # OF TIME REGRESSION MAG/PLS RECORDS = ',I5) 230 FORMAT (' # OF OWLT DELETED MAG/PLS RECORDS = ',I5/ 1 ' LIMIT =',F4.2) END