SUBROUTINE AMDHR + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) INTEGER*4 ISTA(NX),IYY,IMM,IMISS, + ITYPE(IDX,NX), + IR(IHX,IDX,NX),ID(IHX,IDX,NX),IW(IHX,IDX,NX) REAL S(IHX,IDX,NX),T(IHX,IDX,NX) IF ((IYY.GE.1975).AND.(IYY.LE.2000)) THEN CALL AMDHR1 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) ENDIF IF ((IYY.GE.2001).AND.(IYY.LE.2003)) THEN CALL AMDHR2 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) ENDIF IF ((IYY.GE.2004).AND.(IYY.LE.2009)) THEN CALL AMDHR3 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) ENDIF IF ((IYY.GE.2010).AND.(IYY.LE.2010)) THEN CALL AMDHR4 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) ENDIF C IF ((IYY.GE.2011).AND.(IYY.LE.2013)) THEN IF (IYY.GE.2011) THEN CALL AMDHR5 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) ENDIF RETURN END C ======================================== SUBROUTINE AMDHR1 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) INTEGER*4 ISTA(NX),IYY,IMM,IMISS, + ITYPE(IDX,NX), + IR(IHX,IDX,NX),ID(IHX,IDX,NX),IW(IHX,IDX,NX) INTEGER*2 IREC2,ITYPE2,IYY2,IMM2,IDD2, + INV2,IDV2, + IR2(24),IW2(24),IS2(24),IT2(24) INTEGER*4 ISTA4,INV4,ISTA1,IDD REAL S(IHX,IDX,NX),T(IHX,IDX,NX) CHARACTER AMDF1*80 DO 11 N=1,NX DO 12 IDD=1,IDX ITYPE(IDD,N) = 0 DO 13 IHH=1,IHX IR(IHH,IDD,N) = IMISS ID(IHH,IDD,N) = IMISS IW(IHH,IDD,N) = IMISS S(IHH,IDD,N) = RMISS T(IHH,IDD,N) = RMISS 13 CONTINUE 12 CONTINUE 11 CONTINUE OPEN(10,FILE=AMDF1(IYY,IMM),STATUS='OLD', + FORM='UNFORMATTED', + ACCESS='DIRECT',RECL=256,ERR=29) I = 1 21 CONTINUE READ(10,REC=I,ERR=29) + IREC2,ISTA4,ITYPE2,IYY2,IMM2,IDD2, + (IR2(IHH),IW2(IHH),IS2(IHH),IT2(IHH),IHH=1,24) ISTA1 = INV4(ISTA4) N = 0 DO 31 NN=1,NX IF (ISTA1.EQ.ISTA(NN)) THEN N = NN GO TO 39 ENDIF 31 CONTINUE 39 CONTINUE IF (N.NE.0) THEN IDD = INV2(IDD2) ITYPE(IDD,N) = INV2(ITYPE2) IF ((ITYPE(IDD,N).EQ.1).OR.(ITYPE(IDD,N).EQ.4)) THEN DO 41 IHH=1,IHX IF (INV2(IR2(IHH)).NE.32767) + IR(IHH,IDD,N) = INV2(IR2(IHH)) 41 CONTINUE ENDIF IF (ITYPE(IDD,N).EQ.4) THEN DO 42 IHH=1,IHX IF (INV2(IW2(IHH)).NE.-1) THEN ID(IHH,IDD,N) = IDV2(2,INV2(IW2(IHH))) IW(IHH,IDD,N) = IDV2(1,INV2(IW2(IHH))) ENDIF IF (INV2(IS2(IHH)).NE.32767) + S(IHH,IDD,N) = 0.1E0 * REAL(INV2(IS2(IHH))) IF (INV2(IT2(IHH)).NE.32767) + T(IHH,IDD,N) = 0.1E0 * REAL(INV2(IT2(IHH))) 42 CONTINUE ENDIF ENDIF I = I + 1 GO TO 21 29 CONTINUE CLOSE(10) RETURN END SUBROUTINE AMDHR2 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) 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) CHARACTER AMDF2H*80 CHARACTER*1 A1(1000) DO 11 N=1,NX DO 12 IDD=1,IDX ITYPE(IDD,N) = 0 DO 13 IHH=1,IHX IR(IHH,IDD,N) = IMISS ID(IHH,IDD,N) = IMISS IW(IHH,IDD,N) = IMISS S(IHH,IDD,N) = RMISS T(IHH,IDD,N) = RMISS 13 CONTINUE 12 CONTINUE 11 CONTINUE DO 21 N=1,NX OPEN(10,FILE=AMDF2H(IYY,IMM,ISTA(N)),STATUS='OLD', + FORM='FORMATTED',ERR=49) READ(10,'()',END=49,ERR=99) READ(10,'()',END=49,ERR=99) READ(10,'()',END=49,ERR=99) READ(10,'()',END=49,ERR=99) 41 CONTINUE READ(10,'(1000A1)',END=49,ERR=99) (A1(II),II=1,1000) CALL AMDCR(1000,A1,1,RDD,NDD) IDD = NINT(RDD) CALL AMDCR(1000,A1,2,RHH,NHH) IHH = NINT(RHH) ITYPE(IDD,N) = 4 IF ((IDD.LT.1).OR.(IDD.GT.IDX)) GO TO 41 IF ((IHH.LT.1).OR.(IHH.GT.IHX)) GO TO 41 CALL AMDCR(1000,A1,3,RR1,NR1) CALL AMDCR(1000,A1,4,RD1,ND1) CALL AMDCR(1000,A1,5,RW1,NW1) CALL AMDCR(1000,A1,7,RS1,NS1) CALL AMDCR(1000,A1,6,RT1,NT1) IF (NR1.GE.1) IR(IHH,IDD,N) = NINT(RR1) IF (ND1.GE.1) ID(IHH,IDD,N) = NINT(RD1) IF (NW1.GE.1) IW(IHH,IDD,N) = NINT(RW1) IF (NS1.GE.1) S(IHH,IDD,N) = RS1 IF (NT1.GE.1) T(IHH,IDD,N) = RT1 GO TO 41 49 CONTINUE CLOSE(10) 21 CONTINUE RETURN 99 CLOSE(10) WRITE(6,*) 'Can not read file.' STOP END SUBROUTINE AMDHR3 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) 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) CHARACTER AMDF3H*80 CHARACTER*1 A1(1000) DO 11 N=1,NX DO 12 IDD=1,IDX ITYPE(IDD,N) = 0 DO 13 IHH=1,IHX IR(IHH,IDD,N) = IMISS ID(IHH,IDD,N) = IMISS IW(IHH,IDD,N) = IMISS S(IHH,IDD,N) = RMISS T(IHH,IDD,N) = RMISS 13 CONTINUE 12 CONTINUE 11 CONTINUE DO 21 N=1,NX OPEN(10,FILE=AMDF3H(IYY,IMM,ISTA(N)),STATUS='OLD', + FORM='FORMATTED',ERR=49) READ(10,'()',END=49,ERR=99) READ(10,'()',END=49,ERR=99) READ(10,'()',END=49,ERR=99) READ(10,'()',END=49,ERR=99) 41 CONTINUE READ(10,'(1000A1)',END=49,ERR=99) (A1(II),II=1,1000) CALL AMDCR(1000,A1,1,RDD,NDD) IDD = NINT(RDD) CALL AMDCR(1000,A1,2,RHH,NHH) IHH = NINT(RHH) ITYPE(IDD,N) = 4 IF ((IDD.LT.1).OR.(IDD.GT.IDX)) GO TO 41 IF ((IHH.LT.1).OR.(IHH.GT.IHX)) GO TO 41 CALL AMDCR(1000,A1,3,RR1,NR1) CALL AMDCR(1000,A1,5,RD1,ND1) CALL AMDCR(1000,A1,7,RW1,NW1) CALL AMDCR(1000,A1,11,RS1,NS1) CALL AMDCR(1000,A1,9,RT1,NT1) IF (NR1.GE.1) IR(IHH,IDD,N) = NINT(RR1) IF (ND1.GE.1) ID(IHH,IDD,N) = NINT(RD1) IF (NW1.GE.1) IW(IHH,IDD,N) = NINT(RW1) IF (NS1.GE.1) S(IHH,IDD,N) = RS1 IF (NT1.GE.1) T(IHH,IDD,N) = RT1 GO TO 41 49 CONTINUE CLOSE(10) 21 CONTINUE RETURN 99 CLOSE(10) WRITE(6,*) 'Can not read file.' STOP END SUBROUTINE AMDHR4 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) 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) CHARACTER AMDF4H*80 CHARACTER*1 A1(262) DO 11 N=1,NX DO 12 IDD=1,IDX ITYPE(IDD,N) = 0 DO 13 IHH=1,IHX IR(IHH,IDD,N) = IMISS ID(IHH,IDD,N) = IMISS IW(IHH,IDD,N) = IMISS S(IHH,IDD,N) = RMISS T(IHH,IDD,N) = RMISS 13 CONTINUE 12 CONTINUE 11 CONTINUE DO 21 N=1,NX OPEN(10,FILE=AMDF4H(IYY,IMM,ISTA(N)),STATUS='OLD', + FORM='UNFORMATTED', + ACCESS='DIRECT',RECL=262,ERR=49) DO 31 IDD=1,IDX DO 32 IHH=1,IHX I = 6*IHH+6*24*(IDD-1) READ(10,REC=I,ERR=49) + (A1(II),II=1,262) ITYPE(IDD,N) = 4 IF (ICHAR(A1(67)).LE.11) THEN IR1 = 256*256*256*ICHAR(A1(66)) + 256*256*ICHAR(A1(65)) + + 256*ICHAR(A1(64)) + ICHAR(A1(63)) IR(IHH,IDD,N) = NINT(0.1E0*REAL(IR1)) ENDIF IF (ICHAR(A1(131)).LE.11) THEN ID1 = 256*256*256*ICHAR(A1(130)) + 256*256*ICHAR(A1(129)) + + 256*ICHAR(A1(128)) + ICHAR(A1(127)) ID(IHH,IDD,N) = ID1 ENDIF IF (ICHAR(A1(159)).LE.11) THEN IW1 = 256*256*256*ICHAR(A1(158)) + 256*256*ICHAR(A1(157)) + + 256*ICHAR(A1(156)) + ICHAR(A1(155)) IW(IHH,IDD,N) = NINT(0.1E0*REAL(IW1)) ENDIF IF (ICHAR(A1(191)).LE.11) THEN IT1 = 256*256*256*ICHAR(A1(190)) + 256*256*ICHAR(A1(189)) + + 256*ICHAR(A1(188)) + ICHAR(A1(187)) T(IHH,IDD,N) = 0.1E0*REAL(IT1) ENDIF IF (ICHAR(A1(243)).LE.11) THEN IS1 = 256*256*256*ICHAR(A1(242)) + 256*256*ICHAR(A1(241)) + + 256*ICHAR(A1(240)) + ICHAR(A1(239)) S(IHH,IDD,N) = 0.1E0*REAL(IS1) ENDIF 32 CONTINUE 31 CONTINUE 49 CONTINUE CLOSE(10) 21 CONTINUE RETURN 99 CLOSE(10) WRITE(6,*) 'Can not read file.' STOP END SUBROUTINE AMDHR5 + (IHX,IDX,NX,ISTA,IYY,IMM,IMISS,RMISS,ITYPE,IR,ID,IW,S,T) 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) CHARACTER AMDF5H*80 CHARACTER*1 A1(262) DO 11 N=1,NX DO 12 IDD=1,IDX ITYPE(IDD,N) = 0 DO 13 IHH=1,IHX IR(IHH,IDD,N) = IMISS ID(IHH,IDD,N) = IMISS IW(IHH,IDD,N) = IMISS S(IHH,IDD,N) = RMISS T(IHH,IDD,N) = RMISS 13 CONTINUE 12 CONTINUE 11 CONTINUE DO 21 N=1,NX OPEN(10,FILE=AMDF5H(IYY,IMM,ISTA(N)),STATUS='OLD', + FORM='UNFORMATTED', + ACCESS='DIRECT',RECL=262,ERR=49) DO 31 IDD=1,IDX DO 32 IHH=1,IHX I = 6*IHH+6*24*(IDD-1) READ(10,REC=I,ERR=49) + (A1(II),II=1,262) ITYPE(IDD,N) = 4 IF (ICHAR(A1(67)).LE.11) THEN IR1 = 256*256*256*ICHAR(A1(66)) + 256*256*ICHAR(A1(65)) + + 256*ICHAR(A1(64)) + ICHAR(A1(63)) IR(IHH,IDD,N) = NINT(0.1E0*REAL(IR1)) ENDIF IF (ICHAR(A1(131)).LE.11) THEN ID1 = 256*256*256*ICHAR(A1(130)) + 256*256*ICHAR(A1(129)) + + 256*ICHAR(A1(128)) + ICHAR(A1(127)) ID(IHH,IDD,N) = ID1 ENDIF IF (ICHAR(A1(159)).LE.11) THEN IW1 = 256*256*256*ICHAR(A1(158)) + 256*256*ICHAR(A1(157)) + + 256*ICHAR(A1(156)) + ICHAR(A1(155)) IW(IHH,IDD,N) = NINT(0.1E0*REAL(IW1)) ENDIF IF (ICHAR(A1(191)).LE.11) THEN IT1 = 256*256*256*ICHAR(A1(190)) + 256*256*ICHAR(A1(189)) + + 256*ICHAR(A1(188)) + ICHAR(A1(187)) T(IHH,IDD,N) = 0.1E0*REAL(IT1) ENDIF IF (ICHAR(A1(243)).LE.11) THEN IS1 = 256*256*256*ICHAR(A1(242)) + 256*256*ICHAR(A1(241)) + + 256*ICHAR(A1(240)) + ICHAR(A1(239)) S(IHH,IDD,N) = 0.1E0*REAL(IS1) ENDIF 32 CONTINUE 31 CONTINUE 49 CONTINUE CLOSE(10) 21 CONTINUE RETURN 99 CLOSE(10) WRITE(6,*) 'Can not read file.' STOP END SUBROUTINE AMDCR (IX,A,N,G,NG) CHARACTER*1 A(IX) ICRD = 0 ISIGN = 1 ICHECK = 0 IPOINT = 0 IFIG = 0 I1 = 0 I2 = 0 ICOUNT = 0 G = 0.0E0 NG = 0 DO 11 I=1,IX IF (ICOUNT.EQ.N-1) THEN I1 = I GO TO 12 ENDIF IF (A(I).EQ.',') ICOUNT = ICOUNT + 1 11 CONTINUE 12 CONTINUE ICOUNT = 0 DO 13 I=1,IX IF (ICOUNT.EQ.N) THEN I2 = I - 2 GO TO 14 ENDIF IF (A(I).EQ.',') ICOUNT = ICOUNT + 1 13 CONTINUE 14 CONTINUE IF (I1.GT.I2) RETURN DO 21 I=I1,I2 IADD = -1 IF ((ICHAR(A(I)).GE.48).AND.(ICHAR(A(I)).LE.57)) THEN ICHECK = 1 IADD = ICHAR(A(I)) - 48 ICRD = 10 * ICRD + IADD IF (IPOINT.EQ.1) IFIG = IFIG+1 ENDIF IF ((ICHECK.EQ.0).AND.(A(I).EQ.' ')) THEN IADD = 0 ENDIF IF ((ICHECK.EQ.0).AND.(A(I).EQ.'-')) THEN ICHECK = 1 ISIGN = -1 IADD = 0 ENDIF IF ((IPOINT.EQ.0).AND.(A(I).EQ.'.')) THEN ICHECK = 1 IPOINT = 1 IADD = 0 ENDIF IF (IADD.LT.0) THEN RETURN ENDIF 21 CONTINUE G = REAL(ISIGN) * REAL(ICRD) * 1.0E-1**(IFIG) NG = 1 RETURN END CHARACTER*80 FUNCTION AMDF1 (IY,IM) CHARACTER CHAR*1,CY*4,CM*2 AMDF1 = ' ' CY = CHAR(48+MOD(IY/1000,10))//CHAR(48+MOD(IY/100 ,10)) + //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.1976).AND.(IY.LE.1978)) + AMDF1 = 'CD1976/AMEDAS/'//CY//'/AMD'//CY//'.'//CM IF ((IY.GE.1979).AND.(IY.LE.1982)) + AMDF1 = 'CD1979/AMEDAS/'//CY//'/AMD'//CY//'.'//CM IF ((IY.GE.1983).AND.(IY.LE.1986)) + AMDF1 = 'CD1983/AMEDAS/'//CY//'/AMD'//CY//'.'//CM IF ((IY.GE.1987).AND.(IY.LE.1990)) + AMDF1 = 'CD1987/AMEDAS/'//CY//'/AMD'//CY//'.'//CM IF ((IY.GE.1991).AND.(IY.LE.1994)) + AMDF1 = 'CD1991/AMEDAS/'//CY//'/AMD'//CY//'.'//CM IF ((IY.GE.1995).AND.(IY.LE.1997)) + AMDF1 = 'CD'//CY//'/AMEDAS/'//CY//'/AMD'//CY//'.'//CM IF (IY.EQ.1998) + AMDF1 = 'CD1998/amedas/'//CY//'/amd'//CY//'.'//CM IF (IY.EQ.1999) + AMDF1 = 'CD1999/amedas/'//CY//'/Amd'//CY//'.'//CM IF (IY.EQ.2000) + AMDF1 = 'CD2000/amedas/'//CY//'/amd'//CY//'.'//CM IF (AMDF1.NE.' ') + AMDF1 = 'AMeDAS/'//AMDF1 RETURN END CHARACTER*80 FUNCTION AMDF2D (IY,IM,ISTA) CHARACTER CHAR*1,CY2*2,CY4*4,CM*2,CSTA2*2,CSTA5*5 AMDF2D = ' ' CY2 = CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CY4 = CHAR(48+MOD(IY /1000,10))//CHAR(48+MOD(IY /100,10)) + //CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM /10 ,10))//CHAR(48+MOD(IM ,10)) CSTA2 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) CSTA5 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) + //CHAR(48+MOD(ISTA/100 ,10))//CHAR(48+MOD(ISTA/10 ,10)) + //CHAR(48+MOD(ISTA ,10)) AMDF2D = 'CD'//CY4//'/amedas'//'/'//CY4//CM//'/' + //'area'//CSTA2//'/d'//CSTA5//'_'//CY4//CM//'.csv' IF (AMDF2D.NE.' ') + AMDF2D = 'AMeDAS/'//AMDF2D RETURN END CHARACTER*80 FUNCTION AMDF2H (IY,IM,ISTA) CHARACTER CHAR*1,CY2*2,CY4*4,CM*2,CSTA2*2,CSTA5*5 AMDF2H = ' ' CY2 = CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CY4 = CHAR(48+MOD(IY /1000,10))//CHAR(48+MOD(IY /100,10)) + //CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM /10 ,10))//CHAR(48+MOD(IM ,10)) CSTA2 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) CSTA5 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) + //CHAR(48+MOD(ISTA/100 ,10))//CHAR(48+MOD(ISTA/10 ,10)) + //CHAR(48+MOD(ISTA ,10)) AMDF2H = 'CD'//CY4//'/amedas'//'/'//CY4//CM//'/' + //'area'//CSTA2//'/h'//CSTA5//'_'//CY4//CM//'.csv' IF (AMDF2H.NE.' ') + AMDF2H = 'AMeDAS/'//AMDF2H RETURN END CHARACTER*80 FUNCTION AMDF3D (IY,IM,ISTA) CHARACTER CHAR*1,CY2*2,CY4*4,CD*1,CM*2,CSTA2*2,CSTA5*5 AMDF3D = ' ' CY2 = CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CY4 = CHAR(48+MOD(IY /1000,10))//CHAR(48+MOD(IY /100,10)) + //CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM /10 ,10))//CHAR(48+MOD(IM ,10)) CSTA2 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) CSTA5 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) + //CHAR(48+MOD(ISTA/100 ,10))//CHAR(48+MOD(ISTA/10 ,10)) + //CHAR(48+MOD(ISTA ,10)) IF (IY.LE.2008) THEN IF (IM.LE.6) CD = '1' IF (IM.GT.6) CD = '2' IF (IY.GE.2008) CD = '1' AMDF3D = 'CD'//CY4//CD//'/amedas'//'/daily/'//CY4//CM//'/' + //'area'//CSTA2//'/ad'//CSTA5//'_'//CY4//CM//'.csv' ELSE AMDF3D = 'CD'//CY4//'/amedas'//'/daily/'//CY4//CM//'/' + //'area'//CSTA2//'/ad'//CSTA5//'_'//CY4//CM//'.csv' ENDIF IF (AMDF3D.NE.' ') + AMDF3D = 'AMeDAS/'//AMDF3D RETURN END CHARACTER*80 FUNCTION AMDF3H (IY,IM,ISTA) CHARACTER CHAR*1,CY2*2,CY4*4,CD*1,CM*2,CSTA2*2,CSTA5*5 AMDF3H = ' ' CY2 = CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CY4 = CHAR(48+MOD(IY /1000,10))//CHAR(48+MOD(IY /100,10)) + //CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM /10 ,10))//CHAR(48+MOD(IM ,10)) CSTA2 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) CSTA5 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) + //CHAR(48+MOD(ISTA/100 ,10))//CHAR(48+MOD(ISTA/10 ,10)) + //CHAR(48+MOD(ISTA ,10)) IF (IY.LE.2008) THEN IF (IM.LE.6) CD = '1' IF (IM.GT.6) CD = '2' IF (IY.GE.2008) CD = '1' AMDF3H = 'CD'//CY4//CD//'/amedas'//'/hourly/'//CY4//CM//'/' + //'area'//CSTA2//'/ah'//CSTA5//'_'//CY4//CM//'.csv' ELSE AMDF3H = 'DVD'//CY4//'/amedas'//'/hourly/'//CY4//CM//'/' + //'area'//CSTA2//'/ah'//CSTA5//'_'//CY4//CM//'.csv' ENDIF IF (AMDF3H.NE.' ') + AMDF3H = 'AMeDAS/'//AMDF3H RETURN END CHARACTER*80 FUNCTION AMDF4D (IY,IM,ISTA) CHARACTER CHAR*1,CY2*2,CY4*4,CM*2,CSTA5*5 AMDF4D = ' ' CY2 = CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CY4 = CHAR(48+MOD(IY /1000,10))//CHAR(48+MOD(IY /100,10)) + //CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM /10 ,10))//CHAR(48+MOD(IM ,10)) CSTA5 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) + //CHAR(48+MOD(ISTA/100 ,10))//CHAR(48+MOD(ISTA/10 ,10)) + //CHAR(48+MOD(ISTA ,10)) AMDF4D = 'DVD'//CY4//'/amedas'//'/daily/'//CY4//'/'//CM//'/' + //'amd_d_'//CY4//CM//'.'//CSTA5 IF (AMDF4D.NE.' ') + AMDF4D = 'AMeDAS/'//AMDF4D RETURN END CHARACTER*80 FUNCTION AMDF4H (IY,IM,ISTA) CHARACTER CHAR*1,CY2*2,CY4*4,CM*2,CSTA5*5 AMDF4H = ' ' CY2 = CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CY4 = CHAR(48+MOD(IY /1000,10))//CHAR(48+MOD(IY /100,10)) + //CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM /10 ,10))//CHAR(48+MOD(IM ,10)) CSTA5 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) + //CHAR(48+MOD(ISTA/100 ,10))//CHAR(48+MOD(ISTA/10 ,10)) + //CHAR(48+MOD(ISTA ,10)) AMDF4H = 'DVD'//CY4//'/amedas'//'/10min_h/'//CY4//'/'//CM//'/' + //'amd_10minh_'//CY4//CM//'.'//CSTA5 IF (AMDF4H.NE.' ') + AMDF4H = 'AMeDAS/'//AMDF4H RETURN END CHARACTER*80 FUNCTION AMDF5D (IY,IM,ISTA) CHARACTER CHAR*1,CY2*2,CY4*4,CM*2,CSTA5*5 AMDF5D = ' ' CY2 = CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CY4 = CHAR(48+MOD(IY /1000,10))//CHAR(48+MOD(IY /100,10)) + //CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM /10 ,10))//CHAR(48+MOD(IM ,10)) CSTA5 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) + //CHAR(48+MOD(ISTA/100 ,10))//CHAR(48+MOD(ISTA/10 ,10)) + //CHAR(48+MOD(ISTA ,10)) AMDF5D = 'CD'//CY4//CM//'/amedas'//'/10min_h/'//CY4//'/'//CM//'/' + //'amd_d_'//CY4//CM//'.'//CSTA5 IF (AMDF5D.NE.' ') + AMDF5D = 'JMAMMD/'//AMDF5D RETURN END CHARACTER*80 FUNCTION AMDF5H (IY,IM,ISTA) CHARACTER CHAR*1,CY2*2,CY4*4,CM*2,CSTA5*5 AMDF5H = ' ' CY2 = CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CY4 = CHAR(48+MOD(IY /1000,10))//CHAR(48+MOD(IY /100,10)) + //CHAR(48+MOD(IY /10 ,10))//CHAR(48+MOD(IY ,10)) CM = CHAR(48+MOD(IM /10 ,10))//CHAR(48+MOD(IM ,10)) CSTA5 = CHAR(48+MOD(ISTA/10000,10))//CHAR(48+MOD(ISTA/1000 ,10)) + //CHAR(48+MOD(ISTA/100 ,10))//CHAR(48+MOD(ISTA/10 ,10)) + //CHAR(48+MOD(ISTA ,10)) AMDF5H = 'CD'//CY4//CM//'/amedas'//'/10min_h/'//CY4//'/'//CM//'/' + //'amd_10minh_'//CY4//CM//'.'//CSTA5 IF (AMDF5H.NE.' ') + AMDF5H = 'JMAMMD/'//AMDF5H 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 INTEGER*4 FUNCTION INV4 (I) INTEGER*4 I,I1,I2,I3,I4 INTEGER*4 N1 N1 = I N0 = 0 IF (I.LT.0) THEN N1 = N1 + 2**30 N1 = N1 + 2**30 N0 = 1 ENDIF I1 = N1 / 256**3 I2 = MOD(N1,256**3) / 256**2 I3 = MOD(N1,256**2) / 256**1 I4 = MOD(N1,256**1) / 256**0 I1 = I1 + 256/2 * N0 C -- For big-endian format -- C INV4 = (256**3)*I4 + (256**2)*I3 + 256*I2 + I1 C -- For little-endian format -- INV4 = (256**3)*I1 + (256**2)*I2 + 256*I3 + I4 RETURN END INTEGER*2 FUNCTION IDV2 (M,I) INTEGER*2 I,I1,I2 INTEGER*4 N N = I I1 = N / 256 I2 = MOD(N,256) IF (M.EQ.1) IDV2 = I1 IF (M.EQ.2) IDV2 = I2 RETURN END C ======================================== SUBROUTINE AMDID (NX,ISTA,XX,YY,HH) INTEGER ISTA(NX) REAL XX(NX),YY(NX),HH(NX) C CHARACTER*24 CSTA(NX) CHARACTER*24 CSTA OPEN(10,FILE='index.txt', + STATUS='OLD',FORM='FORMATTED') DO 11 N=1,NX 101 FORMAT (1X,I5,1X,A24,1X,I2,1X,F4.1,1X,I3,1X,F4.1,1X,I4) READ(10,101,END=19) ISTA(N),CSTA,IY,RY,IX,RX,IH YY(N) = REAL(IY) + RY / REAL(60) XX(N) = REAL(IX) + RX / REAL(60) HH(N) = REAL(IH) 11 CONTINUE 19 CONTINUE CLOSE(10) RETURN END