Document title: FORTRAN program WATSCOR for correcting the NDADS DE datatype WATS_2S_ASCII. Project: DE NDADS Datatype: WATS_2S_ASCII EID: SOFTWARE Super-EID: SOFTWARE There may be other software files also identified by this super-EID. NDADS filename: wats_watscor_de.for TRF entry: b47613.for in NSSDC's controlled digital document library, Dec. 1998. Document text follows: ---------------------- C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * c * * c * * c * Program WATSCOR.FOR * c * * c * Purpose: * c * This program is to make the following correction on * c * Wats data: * c * a. Let temperature = 9999 if it is from the slot * c * following RPA mode. * c * b. Increase horizontal baffle temperature by 1% * c * and vertical baffle temperature by 5% * c * c. Decrease oxygen temperature by 3% * c * d. Average out the sweep assymmetry for O winds * c * * c * * c * It will rewrite the correct data into the data file * c * called 'Dxxxxx.dat'. A formatted file containing the * c * the date time temperature horizontal and vertical wind * c * is written into file 'Txxxxx.dat'. The format is * c * 1xi6,i10,3f10.2 and no velocities are indicated by 0. * c * * c * * c * * c * Using procedure: * c * FORT WATSCOR * c * LINK WATSCOR c * RUN WATSCOR * c * >ENTER ALLOCATED DEV(with []): * c * DEVICE:[ID] FOR ANOTHER DEVICE * c * [ID] FOR ANOTHER ACCOUNT * c * RETURN FOR THE SAME ACCOUNT * c * >ENTER PREFIX FILE NAME(WITH *) * c * C*.DAT * c * c * dkb - Mar 98: word 9 and 10 were exchanged therefore c * lbits(idata(10,ii) ... and not lbits(idata(9,ii) ..; c * word 3 did contain wrong data - correct content was taken c * from word 10; in VELCOR at the two IF .. AND statements c * uninitialized variable IE was replaced by II; MAKEARRAY c * was corrected to allow multiple file processing c * DATA, IDATA and other related arrays increased to (*,9000). c * Uncorrected temperature and velocity were added as additional c * words. c * * c * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * DIMENSION ARY(9000) c was changed from DIMENSION ARY(1000) CHARACTER*50 LOGDEVA character*60 ARY CHARACTER*10 FNA TYPE*,'ENTER ALLOCATED DEV:(WITH ''[]'' RETURN FOR SAME ACCOUNT)' READ(5,88) LOGDEVA TYPE*,'ENTER FILE NAME(WITH *, EXAMPLE C*.DAT)' READ(5,89)FNA CALL MAKEARRAY(LOGDEVA,FNA,ARY,I) CALL CORRECT(ARY,I) 88 FORMAT(A50) c was changed from 88 FORMAT(A17) 89 FORMAT(A10) STOP END C************************************************************** SUBROUTINE MAKEARRAY (LOGDEVA,FA,ARY,I) DIMENSION ARY(9000) INTEGER*4 CONTEXT c was changed from c CHARACTER LOGDEVA*20,ARY*40,FINA*40,FOUTA*40,FNA*40,FA*10 CHARACTER LOGDEVA*50,ARY*60,FINA*60,FOUTA*60,FNA*60,FA*10 FINA=LOGDEVA//FA c was changed from CALL LIB$FIND_FILE (FINA,FOUTA,CONTEXT,,) CALL LIB$FIND_FILE (FINA,FOUTA,CONTEXT) I=1 ARY(I) = FOUTA FNA = FOUTA c was changed from CALL LIB$FIND_FILE (FINA,FOUTA,CONTEXTA,,) 1 CALL LIB$FIND_FILE (FINA,FOUTA,CONTEXT) IF (FOUTA.NE.FNA) THEN I=I+1 ARY(I)=FOUTA GOTO 1 ENDIF IF (I.NE.1) I = I -1 2 RETURN END C************************************************************** SUBROUTINE CORRECT(ARY,I) DIMENSION ARY(9000) DIMENSION IDATA(13,9000),mode(9000) c was changed from CHARACTER ARY*40,C*4,FN*40 CHARACTER ARY*60,C*5,FN*60 REAL DATA(13,9000) EQUIVALENCE(IDATA,DATA) c maxrec=0 iin=11 iout=12 C='.DAT;' DO 1,J=1,I K=INDEX(ARY(J),C) OPEN(iin,FILE=ARY(J),STATUS='OLD',FORM='UNFORMATTED') FN='D'//ARY(J)(K-5:K+3) OPEN(iout,FILE=FN,STATUS='NEW',FORM='UNFORMATTED') c option of original program to generate ASCII output c FN='T'//ARY(J)(K-5:K+3) c OPEN(3,FILE=FN,STATUS='NEW',FORM='FORMATTED') II = 1 iii=1 c read original orbit files 3 READ(iin,ERR=2789,END=2) (DATA(K,II),K=1,11) c store uncorrected temperature and velocity data(12,ii)=data(7,ii) data(13,ii)=data(11,ii) LL=L c using IBITS to decode slot position from word 10. The description for c word 9 and 10 are exchanged in the FORMAT.SFD file. L=IBITS(IDATA(10,II),8,8) IF (L.EQ.4) THEN IF (LL.NE.3) DATA(7,II)=9999. ENDIF IF(DATA(7,II).NE.9999.)THEN IF(IDATA(3,II).EQ.3.OR.IDATA(3,II).EQ.4) * DATA(7,II)= DATA(7,II) * 1.01 IF(IDATA(3,II).EQ.5.OR.IDATA(3,II).EQ.6) * DATA(7,II)= DATA(7,II) * 1.05 IF(IDATA(5,II).EQ.32) DATA(7,II) = DATA(7,II) * 0.97 ENDIF II = II + 1 GOTO 3 c 2789 if(iii.lt.2) then maxii=ii-1 write(7,*) 'error(s) in file ',fn,' record ',ii endif if(iii.gt.100) then write(7,*) 'skip ',fn,'more than 100 corupted records' ii=maxii goto 2 endif II = II + 1 iii=iii+1 goto 3 2 CLOSE(iin) II=II-1 c correct word 11 CALL VELCOR(DATA,IDATA,II) c write corrected files DO 4 K = 1,II WRITE(iout) (DATA(KK,K),KK=1,13) c Original ASCII output option c IF (IDATA(3,K).EQ.3.OR.IDATA(3,K).EQ.4) THEN c WRITE(3,10,ERR=4) IDATA(1,K),IDATA(2,K),DATA(7,K),0.,DATA(11,K) c ELSE c WRITE(3,10,ERR=4) IDATA(1,K),IDATA(2,K),DATA(7,K),DATA(11,K),0. c ENDIF 4 CONTINUE write(7,*) 'file:',ary(j),' records:',ii,' errors:',iii-1 if(ii.gt.maxrec) maxrec=ii CLOSE(iout) c CLOSE(3) 1 CONTINUE 10 FORMAT(1X,I6,I10,3F10.2) write(7,*) 'number of files processed:',i,' rec_max:',maxrec RETURN END C****************************************************************************** SUBROUTINE VELCOR(DATA,IDATA,II) INTEGER IDATA(13,9000) REAL DATA(13,9000),SV(9000) REAL AVER(3,9000),MV(9000) DATA IS/8/ J = IS/2 JT=IS*1000+1 DO 10 I = 1,II IF (IDATA(3,I).EQ.3.OR.IDATA(3,I).EQ.4) THEN INDEX1 = 1 MV(I)=1 ELSEIF (IDATA(3,I).EQ.5.OR.IDATA(3,I).EQ.6) THEN INDEX1 = 2 MV(I)=2 ELSE MV(I)=0 GOTO 10 ENDIF AVER(1,I)=99999. AVER(2,I)=99999. AVER(3,I)=99999. SV(I)=99999. IT=IDATA(2,I) S1 = 0 S2 = 0 S3 = 0 N1 = 0 N2 = 0 N3 = 0 INDEX2 = 0 C AVERAGING THE VELOCITY ILOW=MAX(1,I-J) IHIGH=MIN(II,I+J) DO 20 K = ILOW,IHIGH IF(IABS(IT-IDATA(2,K)).GT.JT)GO TO 20 IF (IDATA(3,K).EQ.3.OR.IDATA(3,K).EQ.4) THEN INDEX2 = 1 ELSEIF (IDATA(3,K).EQ.5.OR.IDATA(3,K).EQ.6) THEN INDEX2 = 2 ELSE GOTO 20 ENDIF IF (INDEX1.NE.INDEX2) GOTO 20 IF (IDATA(5,K).EQ.28) THEN S1 = S1 + DATA(11,K) N1 = N1 + 1 ELSEIF (IDATA(5,K).EQ.32) THEN IF (IDATA(4,K).EQ.0) THEN S2 = S2 + DATA(11,K) N2 = N2 + 1 ELSEIF (IDATA(4,K).EQ.1) THEN S3 = S3 + DATA(11,K) N3 = N3 + 1 ENDIF ENDIF 20 CONTINUE IF (N1.EQ.0) THEN AVER(1,I) =99999. ELSE AVER(1,I) = S1 / N1 ENDIF IF (N2.EQ.0) THEN AVER(2,I) =99999. ELSE AVER(2,I) = S2 / N2 ENDIF IF (N3.EQ.0) THEN AVER(3,I) =99999. ELSE AVER(3,I) = S3 / N3 ENDIF 10 CONTINUE C .5 * ( O2OUT - O2IN ) DO 2 I=1,II IF (IDATA(5,I).EQ.32) THEN S = (AVER(3,I)-AVER(2,I))/2 IF(ABS(S).LT.400.)GO TO 3 IF(AVER(1,I).GT.11111.)GO TO 2 S=AVER(3,I)-AVER(1,I) IF(ABS(S).GT.400.)THEN S=AVER(1,I)-AVER(2,I) ENDIF IF(ABS(S).GT.400.)GO TO 2 3 CONTINUE IF(MV(I).EQ.1) SV(I)=S IF (IDATA(4,I).EQ.0) THEN DATA(11,I) = AVER(2,I) + S ELSEIF (IDATA(4,I).EQ.1) THEN DATA(11,I) = AVER(3,I) - S ENDIF ENDIF 2 CONTINUE SL=99999 SH=-99999 IB=0 DO 4 I=1,II IF(MV(I).NE.1)GO TO 4 S=SV(I) IF(S.GT.500)GO TO 4 IF(IB.EQ.0)IB=I IF(S.GT.SH)THEN SH=S IH=I ENDIF IF(S.LT.SL)THEN SL=S IL=I ENDIF 4 CONTINUE IT=0 c changed: IE to II in the two IF statements; IE was undefined. IF(IH.GT.IB+J.AND.IH.LT.II-J)IT=IH IF(IL.GT.IB+J.AND.IL.LT.II-J)IT=IL IF(IT.EQ.0)RETURN KL=0 KH=0 DO 6 K=IT-J,IT-J-8,-1 IF(MV(I).NE.1)GO TO 6 IF(IDATA(5,I).NE.32)GO TO 6 KL=K GO TO 7 6 CONTINUE 7 CONTINUE DO 8 K=IT+J,IT+J+8 IF(MV(I).NE.1)GO TO 8 IF(IDATA(5,I).NE.32)GO TO 8 KH=K GO TO 9 8 CONTINUE 9 CONTINUE DO 5 I=IT-J,IT+J IF(MV(I).NE.1)GO TO 5 IF(I.LT.1.OR.I.GT.II)GO TO 5 IF(IDATA(5,I).NE.32)GO TO 5 IF(I.LE.IT) THEN IF(KL.LT.1)GO TO 5 S=SV(KL) ENDIF IF(I.GT.IT) THEN IF(KH.GT.II)GO TO 5 S=SV(KH) ENDIF IF(ABS(S).GT.500)GO TO 5 IF (IDATA(4,I).EQ.0) THEN DATA(11,I) = AVER(2,I) + S ELSEIF (IDATA(4,I).EQ.1) THEN DATA(11,I) = AVER(3,I) - S ENDIF 5 CONTINUE RETURN END