* PACKAGE P2GRDM  
*
************************************************************************
      SUBROUTINE PGRNDM        
     M         ( GDTG  ,
     M           GRHC  , GRALB , GRBET , GRZ0  , GRZSD ,
     M           IDSFC , GFLUX ,
     I           UFLUXS, VFLUXS, TFLUXS, QFLUXS, RFLUXS, SFLUXS,
     I           GDUS  , GDVS  , GDTS  , GDPS  , GDQS  ,
     I           IT    , IDATE , DELT  ,
     C           ALON  , ALAT                                   )
*
*   [PARAM] 





* PACKAGE  ZXT10L32 !" 格子点数，波数 X-Z
*
      INTEGER     IMAX           !" 経度格子数
      INTEGER     JMAX           !" 緯度格子数
      INTEGER     IDIM           !" 経度配列サイズ
      INTEGER     JDIM           !" 緯度配列サイズ
      INTEGER     MMAX           !" 最大東西波数
      INTEGER     LMAX           !" 最大南北波数
      INTEGER     NMAX           !" 最大全波数
      INTEGER     MINT           !" 東西波数間隔
      INTEGER     KMAX           !" 鉛直層数
      INTEGER     KDIM           !" 鉛直配列サイズ
      INTEGER     NMDIM          !" 水平波数成分数
      INTEGER     JMXHF          !" JMAX/2+1
      INTEGER     NWORK          !" ワーク領域大きさ
*
      PARAMETER ( IMAX  = 32,     JMAX =  1,
     &            IDIM  = IMAX+1, JDIM = JMAX,
     &            MMAX  = 10,     LMAX =  0,    NMAX = MMAX, MINT = 1,
     &            KMAX  = 32,     KDIM = KMAX,
     &            NMDIM = (MMAX/MINT+1)*(2*(NMAX+1)-MMAX)
     &                  - (NMAX-LMAX)/MINT*(NMAX-LMAX+1),
     &            JMXHF = JMAX/2+1,
     &            NWORK = IDIM*JDIM*KMAX*12                       )

* PACKAGE ZHDIM  !" 文字列文字数 
*
*"  [HIS]  90/08/31(numaguti)
*
      INTEGER     NCC
      INTEGER     NDC
      INTEGER     NFILN
*
      PARAMETER ( NCC   = 16, NDC   = 64 ,
     &            NFILN = 38              )

*
*   [MODIFY] 
      ReaL*8       GDTG   ( IDIM*JDIM )        
*
      ReaL*8       GRHC   ( IDIM*JDIM )        
      ReaL*8       GRALB  ( IDIM*JDIM )        
      ReaL*8       GRBET  ( IDIM*JDIM )        
      ReaL*8       GRZ0   ( IDIM*JDIM )        
      ReaL*8       GRZSD  ( IDIM*JDIM )        
      INTEGER    IDSFC  ( IDIM*JDIM )        
      ReaL*8       GFLUX  ( IDIM*JDIM )        
*
*   [INPUT] 
      ReaL*8       UFLUXS ( IDIM*JDIM )        
      ReaL*8       VFLUXS ( IDIM*JDIM )        
      ReaL*8       TFLUXS ( IDIM*JDIM )        
      ReaL*8       QFLUXS ( IDIM*JDIM )        
      ReaL*8       RFLUXS ( IDIM*JDIM )        
      ReaL*8       SFLUXS ( IDIM*JDIM )        
*
      ReaL*8       GDUS   ( IDIM*JDIM )        
      ReaL*8       GDVS   ( IDIM*JDIM )        
      ReaL*8       GDTS   ( IDIM*JDIM )        
      ReaL*8       GDPS   ( IDIM*JDIM )        
      ReaL*8       GDQS   ( IDIM*JDIM )        
*
      INTEGER    IT                          
      INTEGER    IDATE ( * )                 
      ReaL*8       DELT                        
      ReaL*8       ALON  ( IDIM )              
      ReaL*8       ALAT  ( JDIM )              
*
*   [INTERNAL SAVE] 
      ReaL*8       GRSST  ( IDIM*JDIM )        
      INTEGER    ITNSST
      INTEGER    ITNHC
      INTEGER    ITNALB
      INTEGER    ITNBET
      INTEGER    ITNZ0
      INTEGER    ITNZSD
      INTEGER    ITNIND
      DATA       ITNSST, ITNHC , ITNALB, ITNBET, 
     &           ITNZ0 , ITNZSD, ITNIND
     &                  / 7*-999 /
      SAVE
*
*   [INTERNAL PARM] 
      CHARACTER  HGRSST *(NFILN)             
      CHARACTER  HGRHC  *(NFILN)             
      CHARACTER  HGRALB *(NFILN)             
      CHARACTER  HGRBET *(NFILN)             
      CHARACTER  HGRZ0  *(NFILN)             
      CHARACTER  HGRZSD *(NFILN)             
      CHARACTER  HIDSFC *(NFILN)             
      DATA       HGRSST / '30' /
      DATA       HGRHC  / ' ' /
      DATA       HGRALB / ' ' /
      DATA       HGRBET / ' ' /
      DATA       HGRZ0  / ' ' /
      DATA       HGRZSD / ' ' /
      DATA       HIDSFC / ' ' /
      NAMELIST  /NMBFIL/ HGRSST, HGRHC , HGRALB, HGRBET, 
     &                   HGRZ0 , HGRZSD, HIDSFC
*
      ReaL*8       DGRSST                      
      ReaL*8       DGRHC                       
      ReaL*8       DGRALB                      
      ReaL*8       DGRBET                      
      ReaL*8       DGRZ0                       
      ReaL*8       DGRZSD                      
      ReaL*8       DIDSFC                      
      DATA       DGRSST  / -999.    /
      DATA       DGRHC   / 0.0      /
      DATA       DGRALB  / 0.15     /
      DATA       DGRBET  / 1.0      /
      DATA       DGRZ0   / 0.0001   /
      DATA       DGRZSD  / 0.0      /
      DATA       DIDSFC  / 0.0       /
      NAMELIST  /NMBDEF/ DGRSST, DGRHC , DGRALB, DGRBET, 
     &                   DGRZ0 , DGRZSD, DIDSFC
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
*
*   [INTERNAL WORK] 
      COMMON    /COMWRK/
     &           RIDSFC
      ReaL*8       RIDSFC ( IDIM*JDIM )        
*
      INTEGER    IFPAR, JFPAR
      INTEGER    IJ
*
*   [ONCE] 
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         WRITE ( 6,* ) ' GROUND MODEL P2.4 DATE=92/04/17'
*
*"         < 1. ファイル名  >
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMBFIL, END=1190 )
 1190    WRITE  ( JFPAR, NMBFIL )
*
*"         < 2. デフォルト値 >
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMBDEF, END=2190 )
 2190    WRITE  ( JFPAR, NMBDEF )
*
      ENDIF
*
*"         < 3. 境界条件の読み込み >
*
      IF ( IT .GE. ITNSST ) THEN
         CALL RDCON
     M         ( GRSST , ITNSST  ,
     I           HGRSST, 'GRSST' , DGRSST, 'ASFC', IT     )
      ENDIF
*
      IF ( IT .GE. ITNHC  ) THEN
         CALL RDCON
     M         ( GRHC  , ITNHC  ,
     I           HGRHC , 'GRHC' , DGRHC , 'ASFC', IT     )
      ENDIF
*
      IF ( IT .GE. ITNALB ) THEN
         CALL RDCON
     M         ( GRALB , ITNALB ,
     I           HGRALB, 'GRALB', DGRALB, 'ASFC', IT     )
      ENDIF
*
      IF ( IT .GE. ITNBET ) THEN
         CALL RDCON
     M         ( GRBET , ITNBET ,
     I           HGRBET, 'GRBET', DGRBET, 'ASFC', IT     )
      ENDIF
*
      IF ( IT .GE. ITNZ0  ) THEN
         CALL RDCON
     M         ( GRZ0  , ITNZ0  ,
     I           HGRZ0 , 'GRZ0' , DGRZ0 , 'ASFC', IT     )
      ENDIF
*
      IF ( IT .GE. ITNZSD  ) THEN
         CALL RDCON
     M         ( GRZSD , ITNZSD,
     I           HGRZSD, 'GRZSD', DGRZSD, 'ASFC', IT     )
      ENDIF
*
      IF ( IT .GE. ITNIND ) THEN
         CALL RDCON
     M         ( RIDSFC,  ITNIND,
     I           HIDSFC, 'IDSFC', DIDSFC, 'ASFC', IT     )
*
         DO 3100 IJ = 1, IDIM*JDIM
            IDSFC( IJ ) = NINT( RIDSFC( IJ ) )
 3100    CONTINUE
*
      ENDIF
*
*"         < 4. 地表面温度をＳＳＴで置き換え >
*
      DO 4100 IJ = 1, IDIM*JDIM
         IF (     ( GRSST( IJ ) .GT. 0.   )
     &       .AND.( IDSFC( IJ ) .LE. 0    ) ) THEN
               GDTG( IJ ) = GRSST( IJ )
         ENDIF
 4100 CONTINUE
*
      CALL SEAZ0              
     M         ( GRZ0  ,
     I           UFLUXS, VFLUXS, IDSFC ,
     I           GDPS , GDTS            )
*
      RETURN
      END
********************************************************************
      SUBROUTINE SEAZ0              
     M         ( GRZ0  ,
     I           UFLUXS, VFLUXS, IDSFC ,
     I           GDPS  , GDTS            )
*
*"     海面粗度 (Charnock)
*
*   [PARAM] 





* PACKAGE  ZXT10L32 !" 格子点数，波数 X-Z
*
      INTEGER     IMAX           !" 経度格子数
      INTEGER     JMAX           !" 緯度格子数
      INTEGER     IDIM           !" 経度配列サイズ
      INTEGER     JDIM           !" 緯度配列サイズ
      INTEGER     MMAX           !" 最大東西波数
      INTEGER     LMAX           !" 最大南北波数
      INTEGER     NMAX           !" 最大全波数
      INTEGER     MINT           !" 東西波数間隔
      INTEGER     KMAX           !" 鉛直層数
      INTEGER     KDIM           !" 鉛直配列サイズ
      INTEGER     NMDIM          !" 水平波数成分数
      INTEGER     JMXHF          !" JMAX/2+1
      INTEGER     NWORK          !" ワーク領域大きさ
*
      PARAMETER ( IMAX  = 32,     JMAX =  1,
     &            IDIM  = IMAX+1, JDIM = JMAX,
     &            MMAX  = 10,     LMAX =  0,    NMAX = MMAX, MINT = 1,
     &            KMAX  = 32,     KDIM = KMAX,
     &            NMDIM = (MMAX/MINT+1)*(2*(NMAX+1)-MMAX)
     &                  - (NMAX-LMAX)/MINT*(NMAX-LMAX+1),
     &            JMXHF = JMAX/2+1,
     &            NWORK = IDIM*JDIM*KMAX*12                       )

* PACKAGE ZHDIM  !" 標準物理定数(common)  
*
*"  [HIS]  90/08/31(numaguti)
*
      ReaL*8       ER             !" 地球半径
      ReaL*8       GRAV                        !" 重力加速度
      ReaL*8       CP                          !" 大気定圧比熱
      ReaL*8       RAIR                        !" 大気気体定数
      ReaL*8       EL                          !" 水の凝結の潜熱
      ReaL*8       CPVAP                       !" 水蒸気定圧比熱
      ReaL*8       RVAP                        !" 水蒸気気体定数
      ReaL*8       DH2O                        !" 水の密度
      ReaL*8       EPSV                        !" 水と大気の分子量比ε
      ReaL*8       ES0                         !" ０℃飽和蒸気圧：Ｐａ
      ReaL*8       STB                         !" Stefan-Boltzman
      ReaL*8       FKARM                       !" Karman 定数
      ReaL*8       EPSVT                       !" 1/ε-1
*
      COMMON   /COMCON/
     &          ER    , GRAV  ,
     &          CP    , RAIR  ,
     &          EL    , CPVAP , RVAP  , DH2O  , EPSV  , ES0   ,
     &          STB   , FKARM , EPSVT

*
*   [MODIFY] 
      ReaL*8       GRZ0   ( IDIM*JDIM )        
*
*   [INPUT] 
      ReaL*8       UFLUXS ( IDIM*JDIM )        
      ReaL*8       VFLUXS ( IDIM*JDIM )        
      INTEGER    IDSFC  ( IDIM*JDIM )        
      ReaL*8       GDPS   ( IDIM*JDIM )        
      ReaL*8       GDTS   ( IDIM*JDIM )        
*
*   [INTERNAL PARM]     
      LOGICAL    OZ0CH
      ReaL*8       CHALP     
      DATA       OZ0CH / .FALSE. /           
      DATA       CHALP / 20.    /            
*
      NAMELIST  /NMSEAZ/
     &           OZ0CH , CHALP
      SAVE
      integer ifpar, jfpar
      LOGICAL  OFIRST
      DATA OFIRST /.TRUE./
*
*   [INTERNAL WORK] 
      INTEGER    IJ
*
      IF ( OFIRST ) THEN
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMSEAZ, END=190 )
  190    WRITE  ( JFPAR, NMSEAZ )
         OFIRST = .FALSE.
      ENDIF

*
      IF ( OZ0CH ) THEN

         DO 1100 IJ = 1, IDIM*JDIM
            IF ( IDSFC( IJ ) .LE. 0 ) THEN
               GRZ0 ( IJ )
     &            =  SQRT( UFLUXS( IJ )**2 + VFLUXS( IJ )**2 )
     &                / (  GDPS( IJ ) / ( RAIR * GDTS( IJ ) )  )
     &                / CHALP / GRAV
            ENDIF
 1100    CONTINUE
      ENDIF
*
      RETURN
      END
