C Sample program to read AMeDAS data C C by Naoki Sato, June 11, 2001 C revised by Naoki Sato, November 1, 2010 C revised by Naoki Sato, September 15, 2011 C C ======================================== C C Subroutine AMDHR reads AMeDAS data from the data files. C C Output of subroutine AMDHR C ITYPE : Type of the station. C 1: Precipitation only. C 4: Precipitation, wind, C sunshine duration and temperature. C IR : Precipitation during the last one hour [mm/hr] C ID : Wind direction C 1: NNE, 2: NE, ... , 16: N C IW : Wind speed [m/s] C S : Sunshine duration [hr/hr] C T : Temperature [C] C IR and S are the total amounts during the last one hour. C Note that ID, IW, S and T are available only when ITYPE = 4. C C Input of subroutine AMDHR C IHH : Time [o'clock]. C e.g. IHH = 12 : 12: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 and IDD. C IHX and IDX must be set as IHX = 24 and IDX = 31. C NX : The number of stations where you want to investigate the C data. C ISTA : Station No. C e.g. ISTA = 44126 : Setagaya. C e.g. If you want to look into the data at Setagaya (44126), C Tokyo (44131) and Sagamihara (46046), set NX and ISTA as C follows. C NX = 3, C ISTA(1) = 44126, C ISTA(2) = 44131, C ISTA(3) = 46046. 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 precipitation from 1100 to 1200 on C August 15, 1995 at Setagaya (44126) and Tokyo (44131). C First, please assign the proper values to IHX (=24) and IDX (=31), C and set NX as NX = 2. C Then, please set the values of ISTA, IYY and IMM as C ISTA(1) = 44126, C ISTA(2) = 44131, C IYY = 1995, C IMM = 8. C After calling subroutine AMDHR, you will get the values at the two C stations as those of IR(12,15,1) and IR(12,15,2). PARAMETER (IHX=24,IDX=31,NX=1) INTEGER ISTA(NX),ITYPE(IDX,NX), + IR(IHX,IDX,NX),ID(IHX,IDX,NX),IW(IHX,IDX,NX) REAL S(IHX,IDX,NX),T(IHX,IDX,NX) PARAMETER (IMISS=999999,RMISS=1.0E9) WRITE(6,*) 'Station No. ?' READ (5,*) ISTA(1) WRITE(6,*) 'Year, Month, Day ?' READ (5,*) IYY,IMM,IDD WRITE(6,*) 'Reading data ...' CALL AMDHR + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) CALL PRINT + (IHX,IDX,NX,ISTA,1,IYY,IMM,IDD,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) STOP END C ======================================== SUBROUTINE PRINT + (IHX,IDX,NX,ISTA,N,IYY,IMM,IDD,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) INTEGER ISTA(NX),IYY,IMM, + ITYPE(IDX,NX), + IR(IHX,IDX,NX),ID(IHX,IDX,NX),IW(IHX,IDX,NX) REAL S(IHX,IDX,NX),T(IHX,IDX,NX) CHARACTER CMONTH*4,CDIREC*3,CD1*3 IF (ITYPE(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,1X,I2,A1,1X,I4) 103 FORMAT (1X,A12) 104 FORMAT (1X,A36) 105 FORMAT ((3X,I2),(5X,I3)) 106 FORMAT ((3X,I2),(5X,I3),(2X,A3),(4X,I2),(4X,F3.1),(1X,F5.1)) WRITE(10,101) 'Station No. =',ISTA(N),',' WRITE(10,102) 'Date =',CMONTH(IMM),IDD,',',IYY IF (ITYPE(IDD,N).EQ.1) THEN WRITE(10,103) 'Time Precip.' WRITE(10,103) ' hr mm' DO 11 IHH=1,IHX IF (IR(IHH,IDD,N).NE.IMISS) THEN IR1 = IR(IHH,IDD,N) ELSE IR1 = 999999 ENDIF WRITE(10,105) IHH,IR1 11 CONTINUE ENDIF IF (ITYPE(IDD,N).EQ.4) THEN WRITE(10,104) 'Time Precip. Dir. Speed S.D. Temp.' WRITE(10,104) ' hr mm m/s hr C' DO 12 IHH=1,IHX IF (IR(IHH,IDD,N).NE.IMISS) THEN IR1 = IR(IHH,IDD,N) ELSE IR1 = 999999 ENDIF IF (ID(IHH,IDD,N).NE.IMISS) THEN CD1 = CDIREC(ID(IHH,IDD,N)) ELSE CD1 = '***' ENDIF IF (IW(IHH,IDD,N).NE.IMISS) THEN IW1 = IW(IHH,IDD,N) ELSE IW1 = 999999 ENDIF IF (S(IHH,IDD,N).NE.RMISS) THEN RS1 = S(IHH,IDD,N) ELSE RS1 = 1.0E9 ENDIF IF (T(IHH,IDD,N).NE.RMISS) THEN RT1 = T(IHH,IDD,N) ELSE RT1 = 1.0E9 ENDIF WRITE(10,106) IHH,IR1,CD1,IW1,RS1,RT1 12 CONTINUE ENDIF 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) 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 CHARACTER*3 FUNCTION CDIREC(I) CDIREC = ' ' IF (I.EQ. 1) CDIREC = 'NNE' IF (I.EQ. 2) CDIREC = 'NE ' IF (I.EQ. 3) CDIREC = 'ENE' IF (I.EQ. 4) CDIREC = 'E ' IF (I.EQ. 5) CDIREC = 'ESE' IF (I.EQ. 6) CDIREC = 'SE ' IF (I.EQ. 7) CDIREC = 'SSE' IF (I.EQ. 8) CDIREC = 'S ' IF (I.EQ. 9) CDIREC = 'SSW' IF (I.EQ.10) CDIREC = 'SW ' IF (I.EQ.11) CDIREC = 'WSW' IF (I.EQ.12) CDIREC = 'W ' IF (I.EQ.13) CDIREC = 'WNW' IF (I.EQ.14) CDIREC = 'NW ' IF (I.EQ.15) CDIREC = 'NNW' IF (I.EQ.16) CDIREC = 'N ' IF (I.EQ. 0) CDIREC = 'C ' RETURN END