* PACKAGE P2GRDM  !" 物理過程(2) 地表の諸量
*
************************************************************************
      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] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZHDIM)                      !" 文字列文字数
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zhdim.F"                    !" 文字列文字数
#endif
*
*   [MODIFY] 
      REAL       GDTG   ( IDIM*JDIM )        !" 地表面温度
*
      REAL       GRHC   ( IDIM*JDIM )        !" 地表熱容量
      REAL       GRALB  ( IDIM*JDIM )        !" 地表アルベド
      REAL       GRBET  ( IDIM*JDIM )        !" 地表湿潤度
      REAL       GRZ0   ( IDIM*JDIM )        !" 地表粗度長
      REAL       GRZSD  ( IDIM*JDIM )        !" 地表高度分散
      INTEGER    IDSFC  ( IDIM*JDIM )        !" 地表状態
      REAL       GFLUX  ( IDIM*JDIM )        !" 地中熱フラックス
*
*   [INPUT] 
      REAL       UFLUXS ( IDIM*JDIM )        !" Ｕのフラックス
      REAL       VFLUXS ( IDIM*JDIM )        !" Ｖのフラックス
      REAL       TFLUXS ( IDIM*JDIM )        !" Ｔのフラックス
      REAL       QFLUXS ( IDIM*JDIM )        !" ｑのフラックス
      REAL       RFLUXS ( IDIM*JDIM )        !" 長波フラックス
      REAL       SFLUXS ( IDIM*JDIM )        !" 短波フラックス
*
      REAL       GDUS   ( IDIM*JDIM )        !" 西風  ｕ
      REAL       GDVS   ( IDIM*JDIM )        !" 南風  ｖ
      REAL       GDTS   ( IDIM*JDIM )        !" 温度  Ｔ
      REAL       GDPS   ( IDIM*JDIM )        !" 地表気圧 Ｐｓ
      REAL       GDQS   ( IDIM*JDIM )        !" 比湿  ｑ
*
      INTEGER    IT                          !" 通し時間
      INTEGER    IDATE ( * )                 !" 時刻：年月日時分秒
      REAL       DELT                        !" 時間刻みΔt
      REAL       ALON  ( IDIM )              !" 経度
      REAL       ALAT  ( JDIM )              !" 緯度
*
*   [INTERNAL SAVE] 
      REAL       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       DGRSST                      !" SST デフォルト
      REAL       DGRHC                       !" 地表熱容量デフォルト
      REAL       DGRALB                      !" 地アルベドデフォルト
      REAL       DGRBET                      !" 地表湿潤度デフォルト
      REAL       DGRZ0                       !" 地表粗度長デフォルト
      REAL       DGRZSD                      !" 地表高度分散デフォルト
      REAL       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       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] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zccom.F"                    !" 標準物理定数
#endif
*
*   [MODIFY] 
      REAL       GRZ0   ( IDIM*JDIM )        !" 地表粗度長
*
*   [INPUT] 
      REAL       UFLUXS ( IDIM*JDIM )        !" Ｕのフラックス
      REAL       VFLUXS ( IDIM*JDIM )        !" Ｖのフラックス
      INTEGER    IDSFC  ( IDIM*JDIM )        !" 地表状態
      REAL       GDPS   ( IDIM*JDIM )        !" 気圧 Ｐ
      REAL       GDTS   ( IDIM*JDIM )        !" 温度  Ｔ
*
*   [INTERNAL PARM]     
      LOGICAL    OZ0CH
      REAL       CHALP     
      DATA       OZ0CH / .FALSE. /           !" Charnockを使うか
      DATA       CHALP / 20.    /            !" Charnock係数
*
      NAMELIST  /NMSEAZ/
     &           OZ0CH , CHALP
      SAVE
*
*   [INTERNAL WORK] 
      INTEGER    IJ
*
*
      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
