C Sample program to read the aerological data C C by Naoki Sato, June 11, 2001 C revised by Naoki Sato, July 11, 2012 C revised by Naoki Sato, February 14, 2020 C C ======================================== C C Subroutine AERDT reads 'Aerological Data of Japan' from the data C file. C C Output of subroutine AERDT C ICHECK : The number which indicates whether data C actually exist or not. C 0: Not exist. C 1: Exist. C C Output of subroutine AERDT C P : Air pressure [hPa] C IZ : Geopotential height [m] C T : Temperature [C] C IU : Relative humidity [%] C ID : Wind direction [deg.] C 0: N, 90: E. C S : Wind speed [m/s] C C Input of subroutine AERDT C IHH : Time [o'clock]. C e.g. IHH = 1: 03:00 JST, 2: 09:00 JST, C 3: 15:00 JST, 4: 21:00 JST. C IDD, IMM, IYY : Date. C e.g. IDD = 15, IMM = 8, IYY = 1995 : August 15, C 1995. C IHX, IDX : The maximum values of IHH, IDD and IMM. C IHX, IDX and IMX must be set as IHX = 4 and IDX = 31. C ILX : The number of layers. C ILX must be set as ILX = 26. C NX : The number of stations where you want to investigate the C data. C ISTA : Station No. C e.g. ISTA = 47600 : Wajima. C e.g. If you want to look into the data at Sapporo (47412), C Wajima (47600) and Kagoshima (47827), set NX and ISTA as C follows. C NX = 3, C ISTA(1) = 47412, C ISTA(2) = 47600, C ISTA(3) = 47827. C In this sample program, NX is set as NX = 1, intending to C look data at only one station. C C An example of the usage C Assume that you want to know the temperatures at the 850 hPa C at 0900 on August 15, 1995 at Sapporo (47412) and Wajima (47600). C First, please assign the proper values to IHX (=4), IDX (=31), and C ILX (=26), and set NX as NX = 2. C Then, please set the values of ISTA and IYY as C ISTA(1) = 47412, C ISTA(2) = 47600, C IMM = 8, C IYY = 1995. C After calling subroutine AERDT, you will get the values at the two C stations as those of T(2,15,5,1) and T(2,15,5,2). PARAMETER (IHX=4,IDX=31,ILX=26,NX=1) INTEGER ISTA(NX),ICHECK(IHX,IDX,NX), + IZ(IHX,IDX,ILX,NX),IU(IHX,IDX,ILX,NX), + ID(IHX,IDX,ILX,NX) REAL P(IHX,IDX,ILX,NX),T(IHX,IDX,ILX,NX), + S(IHX,IDX,ILX,NX) PARAMETER (IMISS=999999,RMISS=1.0E9) WRITE(6,*) 'Station No. ?' READ (5,*) ISTA(1) WRITE(6,*) 'Year, Month, Day, Hour(3,9,15,21) ?' READ (5,*) IYY,IMM,IDD,IHH IHH = (IHH + 3) / 6 WRITE(6,*) 'Reading data ...' CALL AERDT + (IHX,IDX,ILX,NX,ISTA,IYY,IMM,IMISS,RMISS, + ICHECK,P,IZ,T,IU,ID,S) CALL PRINT + (IHX,IDX,ILX,NX,ISTA,1,IYY,IMM,IDD,IHH,IMISS,RMISS, + ICHECK,P,IZ,T,IU,ID,S) STOP END C ======================================== SUBROUTINE PRINT + (IHX,IDX,ILX,NX,ISTA,N,IYY,IMM,IDD,IHH,IMISS,RMISS, + ICHECK,P,IZ,T,IU,ID,S) INTEGER ISTA(NX),ICHECK(IHX,IDX,NX), + IZ(IHX,IDX,ILX,NX),IU(IHX,IDX,ILX,NX), + ID(IHX,IDX,ILX,NX) REAL P(IHX,IDX,ILX,NX),T(IHX,IDX,ILX,NX), + S(IHX,IDX,ILX,NX) CHARACTER CMONTH*4,CH1*4,CS1*5 IF (ICHECK(IHH,IDD,N).EQ.0) THEN WRITE(6,*) 'Data not found.' RETURN ENDIF OPEN(10,FILE='output.txt', + STATUS='UNKNOWN',FORM='FORMATTED',ERR=99) 101 FORMAT (1X,A13,1X,I5,A1) 102 FORMAT (1X,A6,1X,A4,A1,1X,A4,1X,I2,A1,1X,I4) 103 FORMAT (1X,A34) 104 FORMAT (1X,F6.1,1X,A5,1X,F5.1,2X,I3,2X,I3,1X,F5.1) 105 FORMAT (1X,I4 ,3X,I5,1X,F5.1,2X,I3,2X,I3,1X,F5.1) IF (IHH.EQ.1) CH1 = '0300' IF (IHH.EQ.2) CH1 = '0900' IF (IHH.EQ.3) CH1 = '1500' IF (IHH.EQ.4) CH1 = '2100' WRITE(10,101) 'Station No. =',ISTA(N),',' WRITE(10,102) 'Time =',CH1,',',CMONTH(IMM),IDD,',',IYY WRITE(10,103) 'Pres. GPH Temp. Hum. Dir. Speed' WRITE(10,103) ' hPa m C % deg. m/s' DO 11 IL=1,ILX IF (P(IHH,IDD,IL,N).NE.RMISS) THEN RP1 = P(IHH,IDD,IL,N) ELSE RP1 = 1.0E9 ENDIF IF (P(IHH,IDD,IL,N).NE.RMISS) THEN IP1 = NINT(P(IHH,IDD,IL,N)) ELSE IP1 = 999999 ENDIF IF (IZ(IHH,IDD,IL,N).NE.IMISS) THEN IZ1 = IZ(IHH,IDD,IL,N) ELSE IZ1 = 999999 ENDIF IF (T(IHH,IDD,IL,N).NE.RMISS) THEN RT1 = T(IHH,IDD,IL,N) ELSE RT1 = 1.0E9 ENDIF IF (IU(IHH,IDD,IL,N).NE.IMISS) THEN IU1 = IU(IHH,IDD,IL,N) ELSE IU1 = 999999 ENDIF IF (ID(IHH,IDD,IL,N).NE.IMISS) THEN ID1 = ID(IHH,IDD,IL,N) ELSE ID1 = 999999 ENDIF IF (S(IHH,IDD,IL,N).NE.RMISS) THEN RS1 = S(IHH,IDD,IL,N) ELSE RS1 = 1.0E9 ENDIF IF (IL.EQ.1) THEN IF (IZ(IHH,IDD,IL,N).NE.IMISS) THEN CS1 = 'Surf.' ELSE CS1 = '*****' ENDIF WRITE(10,104) RP1,CS1,RT1,IU1,ID1,RS1 ELSE WRITE(10,105) IP1,IZ1,RT1,IU1,ID1,RS1 ENDIF 11 CONTINUE CLOSE(10) WRITE(6,*) "Output was written to file 'output.txt'." RETURN 99 CLOSE(10) WRITE(6,*) "Can not write data to file 'output.txt'." STOP END CHARACTER*4 FUNCTION CMONTH(IM) CMONTH = ' ' IF (IM.EQ. 1) CMONTH = 'Jan.' IF (IM.EQ. 2) CMONTH = 'Feb.' IF (IM.EQ. 3) CMONTH = 'Mar.' IF (IM.EQ. 4) CMONTH = 'Apr.' IF (IM.EQ. 5) CMONTH = 'May ' IF (IM.EQ. 6) CMONTH = 'Jun.' IF (IM.EQ. 7) CMONTH = 'Jul.' IF (IM.EQ. 8) CMONTH = 'Aug.' IF (IM.EQ. 9) CMONTH = 'Sep.' IF (IM.EQ.10) CMONTH = 'Oct.' IF (IM.EQ.11) CMONTH = 'Nov.' IF (IM.EQ.12) CMONTH = 'Dec.' RETURN END