C*********************************************************************
C         RAMS POST PROCESSOR                                        *
C                coded by M.Kanda ( 2000.7.26 )                      *
C    このプログラムはREVUの結果を読み込み　　　　　　　　　　　　　　*
C    Application Softwareのための入力データを作成するものである	     *
C*********************************************************************
                    IMPLICIT REAL*8 (A-H,O-Z)                  
C
C REVUの読み込み
      CALL REVUDATA
C AVSの入力データ
C      CALL AVSOUT
C 出力の高度補正
      CALL MODHEIGHT
C 地表面データの出力
      CALL GROUNDOUT
C TRANSFORMのための入力データ
C 
C
      STOP 
      END 
C*********************************************************************
      SUBROUTINE GROUNDOUT                                       
C*********************************************************************
                    IMPLICIT REAL*8 (A-H,O-Z)                  
      PARAMETER(MMAX=25,KMAX=30,IMAX=82,JMAX=82)
      COMMON /VELO/ U(MMAX,IMAX,JMAX,KMAX),V(MMAX,IMAX,JMAX,KMAX)
     1             ,W(MMAX,IMAX,JMAX,KMAX),UP(MMAX,IMAX,JMAX,KMAX)
      COMMON /SCL3/ TP(MMAX,IMAX,JMAX,KMAX),T(MMAX,IMAX,JMAX,KMAX)
     1             ,P(MMAX,IMAX,JMAX,KMAX),R(MMAX,IMAX,JMAX,KMAX)
     1             ,P1(MMAX,IMAX,JMAX,KMAX),P4(MMAX,IMAX,JMAX,KMAX)
     1             ,P5(MMAX,IMAX,JMAX,KMAX)
      COMMON /SCL2/ UST(MMAX,IMAX,JMAX),TST(MMAX,IMAX,JMAX)
     1             ,RST(MMAX,IMAX,JMAX)
      COMMON /PHY1/ RNN(MMAX,IMAX,JMAX),RHH(MMAX,IMAX,JMAX)
     1             ,RLE(MMAX,IMAX,JMAX),RGN(MMAX,IMAX,JMAX)
     1             ,SHEAT(MMAX,IMAX,JMAX)
      COMMON /PHY2/ ZROUGH(MMAX,IMAX,JMAX),TPSURF(MMAX,IMAX,JMAX)
     1             ,SST(MMAX,IMAX,JMAX),PCTLND(MMAX,IMAX,JMAX)
      COMMON /CTOP/ X(IMAX,JMAX,KMAX),Y(IMAX,JMAX,KMAX),ZLEVS(KMAX)
     1             ,Z(IMAX,JMAX,KMAX),ITIME(MMAX),TOPT(IMAX,JMAX)
      COMMON /MODH/ UB(MMAX,IMAX,JMAX),TB(MMAX,IMAX,JMAX)
     1             ,RB(MMAX,IMAX,JMAX),RBH(MMAX,IMAX,JMAX)
      COMMON /RADD/ RSDNN(MMAX,IMAX,JMAX),RSUPN(MMAX,IMAX,JMAX)
     1             ,RLDNN(MMAX,IMAX,JMAX),RLUPN(MMAX,IMAX,JMAX)
      COMMON /TEMP/ TXX(MMAX,IMAX,JMAX)
C---------------------------------------------------------------------
      OPEN(UNIT=30,FILE='GROUND',STATUS='UNKNOWN',FORM='FORMATTED')
C
      WRITE(30,722) MMM,MMAX,IMAX,JMAX
                        DO 200 M = 1,MMAX
	                DO 200 I = 1,IMAX
			DO 200 J = 1,JMAX 
      WRITE(30,723) UB(M,I,J),TB(M,I,J),RB(M,I,J),RBH(M,I,J)
     &             ,RSDNN(M,I,J),RSUPN(M,I,J),RLDNN(M,I,J),RLUPN(M,I,J)
C	IF ((I.eq.40).and.(J.eq.40)) THEN
C      WRITE(22,111) RSDNN(M,I,J),RSUPN(M,I,J),RLDNN(M,I,J),RLUPN(M,I,J) 
C      WRITE(23,*) UB(M,I,J),TB(M,I,J),RB(M,I,J),RBH(M,I,J) 
C	                             END IF
  200           CONTINUE
      MMM = MMAX*IMAX*JMAX
  723 FORMAT(8F12.6)
C  111 FORMAT(4F12.6)
  722 FORMAT(4I7)
C
      CLOSE(30)
      RETURN
      END 
C*********************************************************************
      SUBROUTINE REVUDATA
C          coded by M.Kanda                                        
C*********************************************************************
                    IMPLICIT REAL*8 (A-H,O-Z)                  
      PARAMETER(MMAX=25,KMAX=30,IMAX=82,JMAX=82)
      CHARACTER*3 cvar
      COMMON /VELO/ U(MMAX,IMAX,JMAX,KMAX),V(MMAX,IMAX,JMAX,KMAX)
     1             ,W(MMAX,IMAX,JMAX,KMAX),UP(MMAX,IMAX,JMAX,KMAX)
      COMMON /SCL3/ TP(MMAX,IMAX,JMAX,KMAX),T(MMAX,IMAX,JMAX,KMAX)
     1             ,P(MMAX,IMAX,JMAX,KMAX),R(MMAX,IMAX,JMAX,KMAX)
     1             ,P1(MMAX,IMAX,JMAX,KMAX),P4(MMAX,IMAX,JMAX,KMAX)
     1             ,P5(MMAX,IMAX,JMAX,KMAX)
      COMMON /SCL2/ UST(MMAX,IMAX,JMAX),TST(MMAX,IMAX,JMAX)
     1             ,RST(MMAX,IMAX,JMAX)
      COMMON /PHY1/ RNN(MMAX,IMAX,JMAX),RHH(MMAX,IMAX,JMAX)
     1             ,RLE(MMAX,IMAX,JMAX),RGN(MMAX,IMAX,JMAX)
     1             ,SHEAT(MMAX,IMAX,JMAX)
      COMMON /PHY2/ ZROUGH(MMAX,IMAX,JMAX),TPSURF(MMAX,IMAX,JMAX)
     1             ,SST(MMAX,IMAX,JMAX),PCTLND(MMAX,IMAX,JMAX)
      COMMON /CTOP/ X(IMAX,JMAX,KMAX),Y(IMAX,JMAX,KMAX),ZLEVS(KMAX)
     1             ,Z(IMAX,JMAX,KMAX),ITIME(MMAX),TOPT(IMAX,JMAX)
      COMMON /MODH/ UB(MMAX,IMAX,JMAX),TB(MMAX,IMAX,JMAX)
     1             ,RB(MMAX,IMAX,JMAX),RBH(MMAX,IMAX,JMAX)
      COMMON /RADD/ RSDNN(MMAX,IMAX,JMAX),RSUPN(MMAX,IMAX,JMAX)
     1             ,RLDNN(MMAX,IMAX,JMAX),RLUPN(MMAX,IMAX,JMAX)
C
C-----------------------------------------------------------------
         OPEN (79,FILE='RRR1',STATUS='OLD',FORM='FORMATTED')
C-----------------------------------------------------------------
            DO 100 M= 1,MMAX
	WRITE(*,*) ' READING ',M
C-----------------------------------
C 3 D Variables 
C-----------------------------------
C------------
C READ U
C------------
            DO 101 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((U(M,I,J,K),I=1,IMAX),J=1,JMAX)
 101        CONTINUE
	Write(*,*) 'U=',U(M,IMAX,JMAX,2)
C------------
C READ V
C------------
            DO 102 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((V(M,I,J,K),I=1,IMAX),J=1,JMAX)
 102        CONTINUE
	Write(*,*) 'V=',V(M,IMAX,JMAX,2)
C------------
C READ W
C------------
            DO 103 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((W(M,I,J,K),I=1,IMAX),J=1,JMAX)
 103        CONTINUE
	Write(*,*) 'W=',W(M,IMAX,JMAX,2)
C------------
C READ cloud
C------------
            DO 104 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((P1(M,I,J,K),I=1,IMAX),J=1,JMAX)
 104        CONTINUE
	Write(*,*) 'cloud=',P1(M,IMAX,JMAX,2)
C------------
C READ theta
C------------
            DO 105 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((TP(M,I,J,K),I=1,IMAX),J=1,JMAX)
 105        CONTINUE
	Write(*,*) 'tp=',TP(M,IMAX,JMAX,2)
C------------
C READ tempc
C------------
            DO 111 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((T(M,I,J,K),I=1,IMAX),J=1,JMAX)
 111        CONTINUE
	Write(*,*) 'T=',T(M,IMAX,JMAX,2)
C-------------
C READ r_vapor
C-------------
            DO 112 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((R(M,I,J,K),I=1,IMAX),J=1,JMAX)
 112        CONTINUE
	Write(*,*) 'R=',R(M,IMAX,JMAX,2)
C-------------
C READ press
C-------------
            DO 113 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((P(M,I,J,K),I=1,IMAX),J=1,JMAX)
 113         CONTINUE
	Write(*,*) 'P=',P(M,IMAX,JMAX,2)
C-------------
C READ speed
C--------------
             DO 114 K=1,KMAX
               READ (79,777) 
     +                CVAR,ZLEVS(K),ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((UP(M,I,J,K),I=1,IMAX),J=1,JMAX)
	Write(*,*) K,'U=',UP(M,70,33,K)
 114         CONTINUE
C-----------------------------------
C 2 D Variables 
C-----------------------------------
C-----------
C READ topo
C-----------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((TOPT(I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'TOPT=',TOPT(IMAX,JMAX)
C-------------
C READ ustarl
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((UST(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'UST=',UST(M,70,33)
C-------------
C READ tstarl
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((TST(M,I,J),I=1,IMAX),J=1,JMAX)
C-------------
C READ rstarl
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((RST(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'RST=',RST(M,40,40)
C-------------
C READ SDWON
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((RSDNN(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'RSDNN=',RSDNN(M,40,40)
C-------------
C READ SUP
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((RSUPN(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'RSUPN=',RSUPN(M,40,40)
C-------------
C READ LDWON
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((RLDNN(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'RLDNN=',RLDNN(M,40,40)
C-------------
C READ LUP
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((RLUPN(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'RLUPN=',RLUPN(M,40,40)
C-------------
C READ Rn
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((RNN(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'RNN=',RNN(M,40,40)
C-------------
C READ H
C-------------
                READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
                READ (79,888) 
     +              ((RHH(M,I,J),I=1,IMAX),J=1,JMAX)
 	Write(*,*) 'RHH=',RHH(M,40,40)
C-------------
C READ LE
C-------------
                READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
                READ (79,888) 
     +              ((RLE(M,I,J),I=1,IMAX),J=1,JMAX)
 	Write(*,*) 'RLE=',RLE(M,40,40)
C-------------
C READ G
C-------------
                READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
                READ (79,888) 
     +              ((RGN(M,I,J),I=1,IMAX),J=1,JMAX)
 	Write(*,*) 'RGN=',RGN(M,40,40)
C-------------
C READ sheat
C-------------
                READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
                READ (79,888) 
     +              ((sheat(M,I,J),I=1,IMAX),J=1,JMAX)
 	Write(*,*) 'sheat=',sheat(M,40,40)
C-------------
C READ zrough
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((ZROUGH(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'zo=',ZROUGH(M,40,40)
C-------------
C READ zrough
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((PCTLND(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'pctlnd=',PCTLND(M,40,40)
C-------------
C READ TP-SURF
C-------------
C
	         DO K=1,7
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((CCC,I=1,IMAX),J=1,JMAX)
	         ENDDO
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((TPSURF(M,I,J),I=1,IMAX),J=1,JMAX)
         ttcc = TPSURF(M,40,40)-273.15
	Write(*,*) 'tpsurf=',ttcc
C-------------
C READ SST
C-------------
               READ (79,777) 
     +                CVAR,cccc,ICCC,ICCC,ICCC
               READ (79,888) 
     +              ((SST(M,I,J),I=1,IMAX),J=1,JMAX)
	Write(*,*) 'sst=',SST(M,40,40)
C-------------------------------------------------------------------
 100        CONTINUE
C-------------------------------------------------------------------
      CLOSE(79,STATUS='KEEP')
C
C
 777  FORMAT(A3,F10.2,3I3) 
 888  FORMAT(5E14.6) 
      RETURN
      END 
C*********************************************************************
      SUBROUTINE AVSOUT                                        
C        coded by M.Kanda
C*********************************************************************
                    IMPLICIT REAL*8 (A-H,O-Z)                  
      PARAMETER(MMAX=25,KMAX=30,IMAX=82,JMAX=82)
      CHARACTER*18 FLM(MMAX)
      COMMON /VELO/ U(MMAX,IMAX,JMAX,KMAX),V(MMAX,IMAX,JMAX,KMAX)
     1             ,W(MMAX,IMAX,JMAX,KMAX),UP(MMAX,IMAX,JMAX,KMAX)
      COMMON /SCL3/ TP(MMAX,IMAX,JMAX,KMAX),T(MMAX,IMAX,JMAX,KMAX)
     1             ,P(MMAX,IMAX,JMAX,KMAX),R(MMAX,IMAX,JMAX,KMAX)
     1             ,P1(MMAX,IMAX,JMAX,KMAX),P4(MMAX,IMAX,JMAX,KMAX)
     1             ,P5(MMAX,IMAX,JMAX,KMAX)
      COMMON /SCL2/ UST(MMAX,IMAX,JMAX),TST(MMAX,IMAX,JMAX)
     1             ,RST(MMAX,IMAX,JMAX)
      COMMON /PHY1/ RNN(MMAX,IMAX,JMAX),RHH(MMAX,IMAX,JMAX)
     1             ,RLE(MMAX,IMAX,JMAX),RGN(MMAX,IMAX,JMAX)
     1             ,SHEAT(MMAX,IMAX,JMAX)
      COMMON /PHY2/ ZROUGH(MMAX,IMAX,JMAX),TPSURF(MMAX,IMAX,JMAX)
     1             ,SST(MMAX,IMAX,JMAX),PCTLND(MMAX,IMAX,JMAX)
      COMMON /CTOP/ X(IMAX,JMAX,KMAX),Y(IMAX,JMAX,KMAX),ZLEVS(KMAX)
     1             ,Z(IMAX,JMAX,KMAX),ITIME(MMAX),TOPT(IMAX,JMAX)
      COMMON /MODH/ UB(MMAX,IMAX,JMAX),TB(MMAX,IMAX,JMAX)
     1             ,RB(MMAX,IMAX,JMAX),RBH(MMAX,IMAX,JMAX)
      COMMON /RADD/ RSDNN(MMAX,IMAX,JMAX),RSUPN(MMAX,IMAX,JMAX)
     1             ,RLDNN(MMAX,IMAX,JMAX),RLUPN(MMAX,IMAX,JMAX)
C---------------------------
C AVS のための切り出し領域
C---------------------------                            
       i1 = 23
       i2 = 32 
       j1 = 23
       j2 = 32
       k1 = 1
       k2 = 1
C----------------------------------
C MAKING OF XYZ DATA               
C----------------------------------
        ZLEVS(1) = 0.0
                   DO 333 I = 1,IMAX
                   DO 333 J = 1,JMAX
                   DO 333 K = 1,KMAX
         X(I,J,K) = 1000.0*(I-1)
         Y(I,J,K) = 1000.0*(J-1)
         Z(I,J,K) = (ZLEVS(K)-ZLEVS(1))/(ZLEVS(KMAX)-ZLEVS(1))*
     1             ((ZLEVS(KMAX)-ZLEVS(1))-TOPT(I,J)) + TOPT(I,J)
 333               CONTINUE
C----------------------------------
C DATA TRANSFORMATION                
C----------------------------------
C
                   DO 515 I = 1,IMAX
                   DO 515 J = 1,JMAX
                   DO 515 K = 1,KMAX
         Z(I,J,K)= 5.0*Z(I,J,K)
 515               CONTINUE 
                   DO 555 M = 1,MMAX
                   DO 555 I = 1,IMAX
                   DO 555 J = 1,JMAX
                   DO 555 K = 1,KMAX
         W(M,I,J,K)= 5.0*W(M,I,J,K)*0.01
 555               CONTINUE 
C---------------------------------
C MAKING OF AVS DATA 
C---------------------------------
         FLM(1)='408-'//'06g3'
         FLM(2)='408-'//'07g3'
         FLM(3)='408-'//'08g3'
         FLM(4)='408-'//'09g3'
         FLM(5)='408-'//'10g3'
         FLM(6)='408-'//'11g3'
         FLM(7)='408-'//'12g3'
         FLM(8)='408-'//'13g3'
         FLM(9)='408-'//'14g3'
         FLM(10)='408-'//'15g3'
         FLM(11)='408-'//'16g3'
         FLM(12)='408-'//'17g3'
         FLM(13)='408-'//'18g3'
         FLM(14)='408-'//'19g3'
         FLM(15)='408-'//'20g3'
C
         NCC = 1
         OPEN (89,FILE='XYZg3',STATUS='unknown',FORM='FORMATTED')
                   DO 232 K = k1,k2
                   DO 232 J = j1,j2
                   DO 232 I = i1,i2
         WRITE(89,197) X(I,J,K),Y(I,J,K),Z(I,J,K)
  232              CONTINUE
         CLOSE(89,STATUS='KEEP')
C
                   DO 224 M = 1,MMAX
         OPEN (99,FILE=FLM(M),STATUS='NEW',FORM='FORMATTED')
         write(*,*) FLM(M)
                   DO 222 K = k1,k2
                   DO 222 J = j1,j2
                   DO 222 I = i1,i2
         IF(Z(I,J,K).LT.0.0) Z(I,J,K)=Z(I,J,K)-10000.0
         WRITE(99,117)  U(M,I,J,K),V(M,I,J,K),W(M,I,J,K),
     1                TP(M,I,J,K),P1(M,I,J,K),Z(I,J,K)
  222              CONTINUE
         CLOSE(99,STATUS='KEEP')
  224    CONTINUE
  117    FORMAT(SP,6E13.5)
  197    FORMAT(SP,3E13.5)
C
      RETURN
      END 
C*********************************************************************
      SUBROUTINE MODHEIGHT                                        
C      by T.Fukuda (1997.3.27)
C      by Pek      (2000.6.27)
C*********************************************************************
                   IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER(MMAX=25,KMAX=30,IMAX=82,JMAX=82)
      COMMON /VELO/ U(MMAX,IMAX,JMAX,KMAX),V(MMAX,IMAX,JMAX,KMAX)
     1             ,W(MMAX,IMAX,JMAX,KMAX),UP(MMAX,IMAX,JMAX,KMAX)
      COMMON /SCL3/ TP(MMAX,IMAX,JMAX,KMAX),T(MMAX,IMAX,JMAX,KMAX)
     1             ,P(MMAX,IMAX,JMAX,KMAX),R(MMAX,IMAX,JMAX,KMAX)
     1             ,P1(MMAX,IMAX,JMAX,KMAX),P4(MMAX,IMAX,JMAX,KMAX)
     1             ,P5(MMAX,IMAX,JMAX,KMAX)
      COMMON /SCL2/ UST(MMAX,IMAX,JMAX),TST(MMAX,IMAX,JMAX)
     1             ,RST(MMAX,IMAX,JMAX)
      COMMON /PHY1/ RNN(MMAX,IMAX,JMAX),RHH(MMAX,IMAX,JMAX)
     1             ,RLE(MMAX,IMAX,JMAX),RGN(MMAX,IMAX,JMAX)
     1             ,SHEAT(MMAX,IMAX,JMAX)
      COMMON /PHY2/ ZROUGH(MMAX,IMAX,JMAX),TPSURF(MMAX,IMAX,JMAX)
     1             ,SST(MMAX,IMAX,JMAX),PCTLND(MMAX,IMAX,JMAX)
      COMMON /CTOP/ X(IMAX,JMAX,KMAX),Y(IMAX,JMAX,KMAX),ZLEVS(KMAX)
     1             ,Z(IMAX,JMAX,KMAX),ITIME(MMAX),TOPT(IMAX,JMAX)
      COMMON /MODH/ UB(MMAX,IMAX,JMAX),TB(MMAX,IMAX,JMAX)
     1             ,RB(MMAX,IMAX,JMAX),RHB(MMAX,IMAX,JMAX)
      COMMON /RADD/ RSDNN(MMAX,IMAX,JMAX),RSUPN(MMAX,IMAX,JMAX)
     1             ,RLDNN(MMAX,IMAX,JMAX),RLUPN(MMAX,IMAX,JMAX)
      COMMON /TEMP/ TXX(MMAX,IMAX,JMAX)
C
C-------------------------------------------
                    DO M=1,MMAX
                    DO J=1,JMAX
                    DO I=1,IMAX
C-------------------------------------------
           Z1=1.5
           Z2=50.0
C--------------------------------
C EXCLUDING UNREALISTIC U* VALUE
C--------------------------------
C
C      IF (UST(M,I,J).LE.0.1) THEN
C	TST(M,I,J)=UST(M,I,J)*TST(M,I,J)/0.1
C      UST(M,I,J)=0.1
C	                       END IF     
      USTR=UST(M,I,J)
      TSTR=TST(M,I,J)
      RSTR=RST(M,I,J)
      UU=UP(M,I,J,2)
      TT=T(M,I,J,2)
      RR=R(M,I,J,2)
      PP=P(M,I,J,2)
C TSS : tempc at the ground surface
                  IF (PCTLND(M,I,J).LE.0.1) THEN 
      TSS = SST(M,I,J)
                                     ELSE
      TSS = (TPSURF(M,I,J))*(PP/1013)**0.286-273.15
                                     ENDIF
      TXX(M,I,J) = TSS
C 
      ZOO = ZROUGH(M,I,J)
C----------------------------------------------------
C CALL MOS
C      MOS-KATSU  RE-CALCULATION OF T* and U* and R*
C      MOLOW      HEIGHT-MODIFICATION
C----------------------------------------------------
      CALL MOSKATSU(Z1,Z2,UU,TT,TSS,ZOO,USTR,TSTR)
           RSTR=RSTR*(TSTR/TST(M,I,J))
      CALL MOLOW(Z1,Z2,USTR,TSTR,RSTR,UU,TT,RR,UBAR,TBAR,RBAR)
C
           UB(M,I,J)=UBAR
           TB(M,I,J)=TBAR
           RB(M,I,J)=RBAR
C T*,U*の入れ替え！！
           UST(M,I,J)=USTR
           TST(M,I,J)=TSTR
           RST(M,I,J)=RSTR
C-------------------
C CALL RELATIVE HUM
C-------------------
      CALL  REHU(TBAR,RBAR,PP,RH)
C
            RHB(M,I,J)=RH
C
                   ENDDO
                   ENDDO
                   ENDDO
C
      RETURN
      END
C-----------------------------------------------------------------------
      SUBROUTINE MOLOW(Z1,Z2,USTR,TSTR,RSTR,UU,TT,RR,UBAR,TBAR,RBAR)
C-----------------------------------------------------------------------
                   IMPLICIT REAL*8(A-H,O-Z)
C
      PARAMETER(AK=0.4,AG=9.8)
C      
      A=LOG(Z2/Z1)
      OL=USTR*USTR/(AK*(AG/(273.15+TT))*TSTR)
      ETA1=Z1/OL
      ETA2=Z2/OL
C
C----[INSTABILITY]-----
      IF(OL.LT.0)THEN
C
        X1=(1.0-16.0*ETA1)**0.25
        X2=(1.0-16.0*ETA2)**0.25
        Y1=(1.0-16.0*ETA1)**0.5 
        Y2=(1.0-16.0*ETA2)**0.5
C
        B=LOG(((X1*X1+1)*(X1+1)**2)/((X2*X2+1)*(X2+1)**2))
        C=ATAN(X2)-ATAN(X1)
C
        D=LOG((Y1+1)/(Y2+1))      
C
        PSIM=A+B+2.0*C
        PSIH=A+2.0*D
C
C-----[STABILITY]-----
      ELSEIF(OL.GE.0)THEN
C
        AM=3.0
        BM=10.0
        CM=7.0/3.0
C
        AH=7.0/400.0
        BH=0.005
        CH=400.0
C
        E=LOG((1.0+AM*ETA2+BM*ETA2**3.0)/(1.0+AM*ETA1+BM*ETA1**3.0))
        F=LOG((1.0+AH*ETA2+BH*ETA2**2.0)/(1.0+AH*ETA1+BH*ETA1**2.0))
C
C---------------------------
C MOS THEORETICAL FUNCTIONS
C---------------------------
        PSIM=A+CM*E
        PSIH=A+CH*F
C---------------------------
C NEUTRAL APPROXIMATION
C---------------------------
C        PSIM=A
C        PSIH=A
C
        END IF
C
      UBAR=-USTR*PSIM/AK+UU
      UBAR = MAX(UBAR,0.1) 
      TBAR=-TSTR*PSIH/AK+TT
      RBAR=-RSTR*PSIH/AK+RR

C
      RETURN
      END
C--------------------------------------------------------------------
      SUBROUTINE REHU(TBAR,RBAR,PP,RH)
C--------------------------------------------------------------------
                   IMPLICIT REAL*8(A-H,O-Z)
      E=((RBAR/1000)*PP)/(0.622+0.378*(RBAR/1000))
      ESAT=6.1078*10**(7.5*TBAR/(237.3+TBAR))
      RH=E/ESAT*100
C-----------------------------
C CHECKING OF OVER-SATURATION
C-----------------------------
	IF (RH.GE.100) THEN
	RH   = 100
	RBAR = ESAT
	               END IF  
C-----------------------------      
	RETURN
	END
C \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
C         U*,T* CONVERGENCE CALCULATION 
C          BY S.KATSUYAMA (2000/7/19)
C         QUOTE "MIZUKANKYOUNOKISYOUGAKU"
C \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
C *********************************************************
         SUBROUTINE MOSKATSU (ZR,Z,UX,TX,TXS,ZO,USTA,TSTA)
C *********************************************************
      IMPLICIT REAL*8(A-H,O-Z)
C -----------------------------------
      CONK = 0.4
      ZT   = ZO
      G    = 9.8
C-------------------------------------
C   [ FIRST VALUE ]
C
 400               CONTINUE
      USTA=CONK*UX/LOG(Z/ZO)
      TSTA=-CONK*(TXS-TX)/LOG(Z/ZT)
C
                   IF (TSTA.GT.0.) THEN
C
C   [ CASE OF STABILITY ]
C
      DO 100 I=1,20
C
      OL=(TX+273.15)*USTA**2.0/(CONK*G*TSTA)
      ETA=Z/OL
      ETAO=ZO/OL
      ETAT=ZT/OL
C
      PSIM=LOG(Z/ZO)+(7.0/3.0)*LOG((1.0+3.0*ETA+10.0*(ETA**3.0))
     1     /(1.0+3.0*ETAO+10.0*(ETAO**3.0)))
      PSIH=LOG(Z/ZO)+400.0*LOG((1.0+(7.0/400.0)*ETA+0.005
     1     *(ETA**2.0))/(1.0+(7.0/400.0)*ETAT+0.005*(ETAT**2.0)))
C
      USTA=CONK*UX/PSIM
      TSTA=-CONK*(TXS-TX)/PSIH
C
  100 CONTINUE
C
C
        ELSEIF (TSTA.LT.0.) THEN
C
C   [ CASE OF UNSTABILITY ]
C
      DO 200 I=1,20
C
      OL=(TX+273.15)*USTA**2.0/(CONK*G*TSTA)
      ETA=Z/OL
      ETAO=ZO/OL
      ETAT=ZT/OL
C
      X=(1.0-16.0*ETA)**0.25
      XO=(1.0-16.0*ETAO)**0.25
      Y=(1.0-16.0*ETA)**0.5
      YO=(1.0-16.0*ETAO)**0.5
      YT=(1.0-16.0*ETAT)**0.5
C
      PSIM=LOG(Z/ZO)+LOG(((XO**2.0+1.0)*(XO+1.0)**2.0)/
     1     ((X**2.0+1.0)*(X+1.0)**2.0))+2.0*(ATAN(X)-ATAN(XO))
      PSIH=LOG(Z/ZT)+2.0*LOG((YT+1.0)/(Y+1.0))
C
      USTA=CONK*UX/PSIM
      TSTA=-CONK*(TXS-TX)/PSIH
C
C
  200 CONTINUE
C
                   ELSE
              	   END IF
C
C--------- HEIGHT MODIFICATION --------------------------
C
C                   IF (TSTA.GT.0.) THEN
C
C   [ CASE OF STABILITY ]
C      ETA=ZR/OL
C
C      PSIM=LOG(Z/ZO)+(7.0/3.0)*LOG((1.0+3.0*ETA+10.0*(ETA**3.0))
C     1     /(1.0+3.0*ETAO+10.0*(ETAO**3.0)))
C      PSIH=LOG(Z/ZO)+400.0*LOG((1.0+(7.0/400.0)*ETA+0.005
C     1     *(ETA**2.0))/(1.0+(7.0/400.0)*ETAT+0.005*(ETAT**2.0)))
C
C      UXM = USTA/CONK*PSIM
C      TXM = 1.0*TSTA/CONK*PSIH + TXS
C
C
C        ELSEIF (TSTA.LT.0.) THEN
C
C   [ CASE OF UNSTABILITY ]
C      ETA=ZR/OL
C      ETAO=ZO/OL
C      ETAT=ZT/OL
C
C      X=(1.0-16.0*ETA)**0.25
C      XO=(1.0-16.0*ETAO)**0.25
C      Y=(1.0-16.0*ETA)**0.5
C      YO=(1.0-16.0*ETAO)**0.5
C      YT=(1.0-16.0*ETAT)**0.5
C
C      PSIM=LOG(Z/ZO)+LOG(((XO**2.0+1.0)*(XO+1.0)**2.0)/
C     1     ((X**2.0+1.0)*(X+1.0)**2.0))+2.0*(ATAN(X)-ATAN(XO))
C      PSIH=LOG(Z/ZT)+2.0*LOG((YT+1.0)/(Y+1.0))
C
C      UXM = USTA/CONK*PSIM
C      TXM = TSTA/CONK*PSIH+TXS
C
       RETURN
       END