C------------------------------------------------------------------
C       JMA MONTHLY REPORT READING PROGRAM 
C                          AMEDAS 19 June 2001 by M.Kanda          
C                          SDP    20 June 2001 by M.Kanda
C
C------------------------------------------------------------------
      include 'ame-sdp.h'
C
        CALL INIT(NTOT)
        IF ((IIFLAG.EQ.1).OR.(IIFLAG.EQ.2)) CALL AMEDAS(NTOT)
        IF ((IIFLAG.EQ.1).OR.(IIFLAG.EQ.3)) CALL SDP(NTOT)
        CALL FIN
C
      STOP
      END
C------------------------------------------------------------------
C Data output parameters 
C------------------------------------------------------------------
      SUBROUTINE INIT
      include 'ame-sdp.h'
C
      CIY = '1999'
      CIM = '08'
      IDYSTA=1
      IDYEND=1
      MHRSTA=1
      MHREND=24
      CLATSW=35.0
      CLONSW=139.0
      CLATNE=37.0
      CLONNE=141.0
C
      NTOT=0
C
      open(15,file='AME-SDP',status='unknown',form='formatted')
C
      RETURN
      END
C------------------------------------------------------------------
      SUBROUTINE FIN
      CLOSE(15)
      RETURN
      END
C------------------------------------------------------------------
C------------------------------------------------------------------
C     AMEDAS READING 
C------------------------------------------------------------------
C------------------------------------------------------------------
      SUBROUTINE AMEDAS(NTOT)
C------------------------------------------------------------------
      include 'ame-sdp.h'
      INTEGER*2 IC1,INC,IY,IM,ID,IDAT(NMAX,KMAX,4,24),IIDAT(4,24)
      INTEGER*4 INUB
      REAL*4 DAT(NMAX,KMAX,5,24),CLAT(NMAX),CLON(NMAX),AHIG(NMAX) 
      CHARACTER CHHC*32
      INTEGER*4 INDEX(100000),INCD(NMAX),INCB(NMAX),IBNK(NMAX)

C initialization
              DO N = 1,NMAX
       IBNK(N) = 0
              DO K = 1,KMAX
              DO L = 1,5
              DO LL= 1,24
       DAT(N,K,L,LL)=100000.0
              ENDDO
              ENDDO
              ENDDO
              ENDDO
C--FILE OPEN-------------------------------------------------------
      open(11,file=CIY//'/idx'//CIY//'.'//CIM
     &             ,status='old',form='formatted')
C------------------------------------------------------------------
C----------------
C Header Reading
C----------------
              DO N = 1,NMAX
      READ(11,642) IN,CHHC,LATH,LATL,LONH,LONL,LHIG
      INDEX(IN)=N
      CLAT(N) = 1.0*LATH+(0.1*LATL)/60.0
      CLON(N) = 1.0*LONH+(0.1*LONL)/60.0
      AHIG(N) = 1.0*LHIG
             ENDDO
 642  FORMAT(I5,A32,I2,3I3,I4)
      close(11)
C-----------------------------
                   DO N=1,NMAX
      IF(CLAT(N).GE.CLATSW.AND.CLAT(N).LE.CLATNE.AND.CLON(N).GE.CLONSW
     +                    .AND.CLON(N).LE.CLONNE) THEN
         IBNK(N) = 1
                                                  ENDIF
                   ENDDO
C-----------------------------
C--FILE OPEN-------------------------------------------------------
      open(10,file=CIY//'/Amd'//CIY//'.'//CIM
     &   ,status='old',access='direct',form='unformatted',recl=256)
C-------------------------------------------------------------------
C----------------
C Amedas Reading
C----------------
      IP = 0
 10   CONTINUE
      IP = IP + 1
      READ(10,REC=IP,ERR=100) IC1,INUB,INC,IY,IM,ID
     &               ,((IIDAT(L,LL),L=1,4),LL=1,24)
C---  
      WRITE(*,*) IP
      M = INDEX(INUB)
      INCD(M)     = INC
      INCB(M)     = INUB
         DO L = 1,4
         DO LL= 1,24
      IDAT(M,ID,L,LL)= IIDAT(L,LL)
         ENDDO
         ENDDO
C---  
      GOTO 10
 100  CONTINUE
      close(10)
C-------------------------------------------------------------------
                   DO N  = 1,NMAX
         WRITE(*,*) N
                   DO K  = 1,KMAX
                   DO LL = 1,24
C rain 
         IF (IDAT(N,K,1,LL).EQ.32767) THEN 
                   DAT(N,K,4,LL)=100000.0
                                      ELSE
                   DAT(N,K,4,LL)=IDAT(N,K,1,LL)*1.0
                                      ENDIF
c U and Udir
         IF (IDAT(N,K,2,LL).LT.0) THEN
                   DAT(N,K,1,LL)=100000.0
                   DAT(N,K,2,LL)=100000.0
                                  ELSE
                   DAT(N,K,1,LL)=(IDAT(N,K,2,LL)/256)*1.0
                   DAT(N,K,2,LL)=(MOD(IDAT(N,K,2,LL),256))*22.5
                                  ENDIF
c insolation
         IF (IDAT(N,K,3,LL).EQ.32767) THEN
                   DAT(N,K,5,LL)=100000.0
                                      ELSE
                   DAT(N,K,5,LL)=IDAT(N,K,3,LL)*0.1
                                      ENDIF
c temperature
         IF (IDAT(N,K,4,LL).EQ.32767) THEN
                   DAT(N,K,3,LL)=100000.0
                                      ELSE
                   DAT(N,K,3,LL)=IDAT(N,K,4,LL)*0.1
                                      ENDIF
                   ENDDO
                   ENDDO
                   ENDDO
C---file output-----------------------------------------
C
              DO N =1,NMAX
      IF (INCD(N).EQ.4) THEN
      IF (IBNK(N).EQ.1) THEN
      NTOT=NTOT+1
      WRITE(15,*) INCB(N),CLAT(N),CLON(N),AHIG(N)
              DO K=IDYSTA,IDYEND
                   MM1 = 1
                   MM2 = 24
                   IF (K.EQ.IDYSTA) MM1 = MHRSTA
                   IF (K.EQ.IDYEND) MM2 = MHREND
              DO LL =MM1,MM2
      WRITE(15,222) (DAT(N,K,L,LL),L=1,4),ccc,ccc
              ENDDO
              ENDDO
                        ENDIF
                        ENDIF
              ENDDO
C
 222  FORMAT(6F12.4)
C-------------------------------------------------------------
      RETURN
      END
C------------------------------------------------------------------
C------------------------------------------------------------------
C  SDP READING 
C------------------------------------------------------------------
      SUBROUTINE SDP(NTOT)
C------------------------------------------------------------------
      include 'ame-sdp.h'
      INTEGER*2 INC,IDAT(N1MAX,KMAX,24,24),IIDAT(24,24)
      REAL*4 DAT(N1MAX,KMAX,24,24),CLAT(N1MAX),CLON(N1MAX),AHIG(N1MAX) 
      CHARACTER IC1*1024,II4*4,II36*36,FNN*3
      INTEGER*4 INDEX(1000),INCD(N1MAX),INCB(N1MAX),IBNK(N1MAX)

C initialization
              DO N = 1,N1MAX
       IBNK(N) = 0
              DO K = 1,KMAX
              DO L = 1,24
              DO LL= 1,24
       DAT(N,K,L,LL)=100000.0
              ENDDO
              ENDDO
              ENDDO
              ENDDO
C------------------------------------------------------------------
C Data output parameters 
C------------------------------------------------------------------
c
c
C--FILE OPEN-------------------------------------------------------
      open(11,file=CIY//'/sdp.idx',status='old',form='formatted')
C------------------------------------------------------------------
C----------------
C Header Reading
C----------------
              DO N = 1,N1MAX
      READ(11,*) IN,CLATH,CLATL,CLONH,CLONL,CLHIG
      INDEX(IN)=N
      INCB(N) = IN
      CLAT(N) = CLATH+CLATL/60.0
      CLON(N) = CLONH+CLONL/60.0
      AHIG(N) = CLHIG
C      WRITE(25,*) INCB(N),CLAT(N),CLON(N),AHIG(N)
             ENDDO
      close(11)
C-----------------------------
                   DO N=1,N1MAX
      IF(CLAT(N).GE.CLATSW.AND.CLAT(N).LE.CLATNE.AND.CLON(N).GE.CLONSW
     +                    .AND.CLON(N).LE.CLONNE) THEN
      IBNK(N) = 1
                                                  ENDIF
                   ENDDO
C-----------------------------
C
                   DO N=1,N1MAX
      WRITE(*,*) N
      WRITE(FNN,'(i3.3)') INCB(N)
C--FILE OPEN-------------------------------------------------------
      open(10,file=CIY//'/47'//FNN//'/SD'//CIY//CIM//'.'//FNN
     &   ,status='old',access='direct',form='unformatted',recl=3072)
C-------------------------------------------------------------------
C------------------------------------
C SDP Reading
C IC1 : SKIP OF DAILY DATA 1024 byte
C------------------------------------
                   DO K=1,KMAX
      IP = K + 1                   ! SKIP HEADER PAGE 3072 byte
      READ(10,REC=IP) IC1,
     &     II4,(((IIDAT(L,LL),L=1,24),II36),LL=1,3),
     &     II4,(((IIDAT(L,LL),L=1,24),II36),LL=4,6),
     &     II4,(((IIDAT(L,LL),L=1,24),II36),LL=7,9),
     &     II4,(((IIDAT(L,LL),L=1,24),II36),LL=10,12),
     &     II4,(((IIDAT(L,LL),L=1,24),II36),LL=13,15),
     &     II4,(((IIDAT(L,LL),L=1,24),II36),LL=16,18),
     &     II4,(((IIDAT(L,LL),L=1,24),II36),LL=19,21),
     &     II4,(((IIDAT(L,LL),L=1,24),II36),LL=22,24)
C---  
         DO L = 1,24
         DO LL= 1,24
      IDAT(N,K,L,LL)= IIDAT(L,LL)
         ENDDO
         ENDDO
C---  
                   ENDDO
      close(10)
                   ENDDO
C-------------------------------------------------------------------
C-------------------------------------------------------------------
C - TEMP AND SO ON-----------------------------------
                   DO N  = 1,N1MAX
                   DO K  = 1,KMAX
                   DO  L = 1,24
                   DO LL = 1,24
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=0.1*INT(IDAT(N,K,L,LL)/10)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
                   ENDDO
                   ENDDO
                   ENDDO
                   ENDDO
C--------------------------------------------------------
C--------------------------------------------------------
                   DO N  = 1,N1MAX
                   DO K  = 1,KMAX
                   DO LL = 1,24
C-S ---------
         L = 12
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=100/36*INT(IDAT(N,K,L,LL)/10)
                        ELSE
            DAT(N,K,L,LL)= 0.0
                        ENDIF
C-RH(%)---------
         L = 22
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=1.0*INT(IDAT(N,K,L,LL)/10)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
C-SNOW-FALL ---------
         L = 15
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=1.0*INT(IDAT(N,K,L,LL)/10)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
C-SNOW-DEPTH ---------
         L = 16
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=1.0*INT(IDAT(N,K,L,LL)/10)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
C- INTEGRATED DIRECT SOLAR ---------
         L = 23
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=0.01*INT(IDAT(N,K,L,LL)/10)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
C- Udir ---------
         L = 9
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=22.5*INT(IDAT(N,K,L,LL)/10)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
C- Local Pressure ---------
         L = 1
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=0.1*(INT(IDAT(N,K,L,LL)/10)+8000)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
C- Sea Level Pressure ---------
         L = 2
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=0.1*(INT(IDAT(N,K,L,LL)/10)+8000)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
C- Rainfall ---------
         L = 13
C ----------------------------------------------------
         IRMK = MOD(IDAT(N,K,L,LL),10)
         IF (IRMK.EQ.8) THEN 
            DAT(N,K,L,LL)=0.1*5*INT(IDAT(N,K,L,LL)/10)
                        ELSE
            DAT(N,K,L,LL)=100000.0
                        ENDIF
         IF (IRMK.EQ.6)  DAT(N,K,L,LL)=0.0
C-------------------------------------------------------
C Water Vapor Mixing ratio calculator 
C Vapor is assigned to L = 3 
C-------------------------------------------------------
      DAT(N,K,3,LL)=0.622*(DAT(N,K,7,LL)/DAT(N,K,1,LL))
     &             /(1-0.378*(DAT(N,K,7,LL)/DAT(N,K,1,LL)))
     &             *1000.0
                   ENDDO
                   ENDDO
                   ENDDO
C ----------------------------------------------------
C---file output-----------------------------------------
C
              DO N =1,N1MAX
      IF (IBNK(N).EQ.1) THEN
      NTOT=NTOT+1
      WRITE(15,*) INCB(N),CLAT(N),CLON(N),AHIG(N)
              DO K=IDYSTA,IDYEND
                   MM1 = 1
                   MM2 = 24
                   IF (K.EQ.IDYSTA) MM1 = MHRSTA
                   IF (K.EQ.IDYEND) MM2 = MHREND
              DO LL =MM1,MM2
      WRITE(15,222) DAT(N,K,10,LL),DAT(N,K,9,LL)
     &             ,DAT(N,K,5,LL),DAT(N,K,13,LL)
     &             ,DAT(N,K,3,LL),DAT(N,K,12,LL)
              ENDDO
              ENDDO
                        ENDIF
              ENDDO
      WRITE(15,*) NTOT
 222  FORMAT(6F12.4)
C-------------------------------------------------------------
      RETURN
      END
