SUBROUTINE AERDT + (IHX,IDX,ILX,NX,ISTA,IYY,IMM,IMISS,RMISS, + ICHECK,P,IZ,T,IU,ID,S) INTEGER*4 IHX,IDX,ILX,NX,IYY,IMM,IMISS, + ISTA(NX),ICHECK(IHX,IDX,NX), + IZ(IHX,IDX,ILX,NX),IU(IHX,IDX,ILX,NX), + ID(IHX,IDX,ILX,NX), + IDD,IHH,ISTA1,IMD1,IHH1,I, + IZ1(26),IT1(26),IU1(26),ID1(26),IS1(26) INTEGER*2 ISTA2,IYY2,IMD2,IHH2,IDMA2,IDMB2, + IZ2(26),IT2(26),IU2(26),ID2(26),IS2(26), + IDMC2(26),IDMD2(26),INV2 REAL P(IHX,IDX,ILX,NX),T(IHX,IDX,ILX,NX), + S(IHX,IDX,ILX,NX) CHARACTER AERF*80 DO 11 N=1,NX DO 12 IDD=1,IDX DO 13 IHH=1,IHX ICHECK(IHH,IDD,N) = 0 DO 14 IL=1,ILX P(IHH,IDD,IL,N) = RMISS IZ(IHH,IDD,IL,N) = IMISS T(IHH,IDD,IL,N) = RMISS IU(IHH,IDD,IL,N) = IMISS ID(IHH,IDD,IL,N) = IMISS S(IHH,IDD,IL,N) = RMISS 14 CONTINUE 13 CONTINUE 12 CONTINUE 11 CONTINUE OPEN(10,FILE=AERF(IYY,IMM),STATUS='OLD', + FORM='UNFORMATTED', + ACCESS='DIRECT',RECL=512,ERR=29) I = 1 21 CONTINUE READ(10,REC=I,ERR=29) + ISTA2,IYY2,IMD2,IHH2,IDMA2,IDMB2, + (IZ2(IL),IT2(IL),IU2(IL),ID2(IL),IS2(IL), + IDMC2(IL),IDMD2(IL),IL=1,26) ISTA1 = 47000 + INV2(ISTA2) N = 0 DO 41 NN=1,NX IF (ISTA1.EQ.ISTA(NN)) THEN N = NN GO TO 49 ENDIF 41 CONTINUE 49 CONTINUE IMD1 = INV2(IMD2) IDD = MOD(IMD1,100) IHH1 = INV2(IHH2) IHH = 0 IF (IHH1.EQ. 3) IHH = 1 IF (IHH1.EQ. 9) IHH = 2 IF (IHH1.EQ.15) IHH = 3 IF (IHH1.EQ.21) IHH = 4 IF ((N.NE.0).AND.(IL.NE.0).AND.(IHH.NE.0)) THEN DO 31 IL=1,ILX ICHECK(IHH,IDD,N) = 1 IZ1(IL) = INV2(IZ2(IL)) IT1(IL) = INV2(IT2(IL)) IU1(IL) = INV2(IU2(IL)) ID1(IL) = INV2(ID2(IL)) IS1(IL) = INV2(IS2(IL)) IF (IL.EQ.1) THEN IF ((IZ1(IL).NE.-32767).AND.(IZ1(IL).NE.-32766)) THEN P(IHH,IDD,IL,N) = 0.1E0 * REAL(IZ1(IL)) ELSE P(IHH,IDD,IL,N) = RMISS ENDIF IZ(IHH,IDD,IL,N) = 0 ELSE P(IHH,IDD,IL,N) = REAL(IPSTAN(IL-1)) IF ((IZ1(IL).NE.-32767).AND.(IZ1(IL).NE.-32766)) THEN IZ(IHH,IDD,IL,N) = IZ1(IL) IF ((P(IHH,IDD,IL,N).LE.P(IHH,IDD,1,N)).AND.(IZ1(IL).LT.0)) + IZ(IHH,IDD,IL,N) = 30000 - IZ(IHH,IDD,IL,N) ELSE IZ(IHH,IDD,IL,N) = IMISS ENDIF ENDIF IF ((IT1(IL).NE.-32767).AND.(IT1(IL).NE.-32766)) THEN T(IHH,IDD,IL,N) = 0.1E0 * REAL(IT1(IL)) ELSE T(IHH,IDD,IL,N) = RMISS ENDIF IF ((IU1(IL).NE.-32767).AND.(IU1(IL).NE.-32766)) THEN IU(IHH,IDD,IL,N) = IU1(IL) ELSE IU(IHH,IDD,IL,N) = IMISS ENDIF IF ((ID1(IL).NE.-32767).AND.(ID1(IL).NE.-32766)) THEN ID(IHH,IDD,IL,N) = ID1(IL) ELSE ID(IHH,IDD,IL,N) = IMISS ENDIF IF ((IS1(IL).NE.-32767).AND.(IS1(IL).NE.-32766)) THEN S(IHH,IDD,IL,N) = 0.1E0 * REAL(IS1(IL)) ELSE S(IHH,IDD,IL,N) = RMISS ENDIF 31 CONTINUE ENDIF I = I + 1 GO TO 21 29 CONTINUE CLOSE(10) RETURN END CHARACTER*80 FUNCTION AERF (IY,IM) CHARACTER CHAR*1,CY*4,CY2*2,CM*2 AERF = ' ' CY = CHAR(48+MOD(IY/1000,10))//CHAR(48+MOD(IY/100 ,10)) + //CHAR(48+MOD(IY/10 ,10))//CHAR(48+MOD(IY ,10)) CY2 = CHAR(48+MOD(IY/10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM/10 ,10))//CHAR(48+MOD(IM ,10)) IF ((IY.GE.1988).AND.(IY.LE.1990)) + AERF = 'CD1988/UPPERAIR/SONDE/DATA/KOSO'//CY2//CM//'.SPL' IF ((IY.GE.1991).AND.(IY.LE.1994)) + AERF = 'CD1991/UPPERAIR/SONDE/DATA/KOSO'//CY2//CM//'.SPL' IF ((IY.GE.1995).AND.(IY.LE.1997)) + AERF = 'CD'//CY//'/UPPERAIR/SONDE/DATA/KOSO' + //CY2//CM//'.SPL' IF ((IY.GE.1998).AND.(IY.LE.1999)) + AERF = 'CD'//CY//'/upperair/sonde/data/koso' + //CY2//CM//'.spl' IF (IY.GE.2000) + AERF = 'CD'//CY//'/upperair/sonde/data/ks' + //CY//CM//'.spl' IF (AERF.NE.' ') + AERF = 'Aero/'//AERF RETURN END INTEGER FUNCTION IPSTAN (IL) IF (IL.EQ. 1) IPSTAN = 1000 IF (IL.EQ. 2) IPSTAN = 925 IF (IL.EQ. 3) IPSTAN = 900 IF (IL.EQ. 4) IPSTAN = 850 IF (IL.EQ. 5) IPSTAN = 800 IF (IL.EQ. 6) IPSTAN = 700 IF (IL.EQ. 7) IPSTAN = 600 IF (IL.EQ. 8) IPSTAN = 500 IF (IL.EQ. 9) IPSTAN = 400 IF (IL.EQ.10) IPSTAN = 350 IF (IL.EQ.11) IPSTAN = 300 IF (IL.EQ.12) IPSTAN = 250 IF (IL.EQ.13) IPSTAN = 200 IF (IL.EQ.14) IPSTAN = 175 IF (IL.EQ.15) IPSTAN = 150 IF (IL.EQ.16) IPSTAN = 125 IF (IL.EQ.17) IPSTAN = 100 IF (IL.EQ.18) IPSTAN = 70 IF (IL.EQ.19) IPSTAN = 50 IF (IL.EQ.20) IPSTAN = 40 IF (IL.EQ.21) IPSTAN = 30 IF (IL.EQ.22) IPSTAN = 20 IF (IL.EQ.23) IPSTAN = 15 IF (IL.EQ.24) IPSTAN = 10 IF (IL.EQ.25) IPSTAN = 5 RETURN END INTEGER*2 FUNCTION INV2 (I) INTEGER*2 I,I1,I2 INTEGER*4 N1 IF (I.GE.0) THEN N1 = I ELSE N1 = I + 256**2 ENDIF I1 = N1 / 256 I2 = MOD(N1,256) C -- For big-endian format -- C INV2 = 256*I2 + I1 C -- For little-endian format -- INV2 = 256*I1 + I2 RETURN END