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