* PACKAGE P2RADM   !" 物理過程(2) 放射(ダミー)
*
* [HIS] 92/07/14(takepiro)
*
*********************************************************************
      SUBROUTINE RADFLX            !" 放射フラックス
     O         ( RFLUX , RMTXS , DRFLUX,
     O           SFLUX ,
     I           GDTM  , GDTG  , GDQ   , GDPM  ,
     I           IT    , IDATE ,
     C           ALON  , ALAT  , GRALB          )
*
*"       ダミー放射
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zccom.F"                    !" 標準物理定数
#endif
*
*   [OUTPUT] 
      REAL       RFLUX  ( IDIM*JDIM, KMAX+1 )     !" 長波フラックス
      REAL       RMTXS  ( IDIM*JDIM,  -1:1 )      !" Ｔ陰解行列：地表
      REAL       DRFLUX ( IDIM*JDIM, KMAX+1, 0:1 )!" 長波地表温度変化
      REAL       SFLUX  ( IDIM*JDIM, KMAX+1 )     !" 日射フラックス
*
*   [INPUT] 
      REAL       GDTM   ( IDIM*JDIM, KMAX+1 ) !" 温度(半整数)
      REAL       GDTG   ( IDIM*JDIM )         !" 地表面温度
      REAL       GDQ    ( IDIM*JDIM, KMAX )   !" 比湿  ｑ
      REAL       GDPM   ( IDIM*JDIM, KMAX+1 ) !" 気圧(半整数)
      INTEGER    IT                           !" 時刻
      INTEGER    IDATE  ( 6 )                 !" 日付
*
      REAL       ALON   ( IDIM )              !" 経度
      REAL       ALAT   ( JDIM )              !" 緯度
      REAL       GRALB  ( IDIM*JDIM )         !" 地表アルベド
*
*   [INTERNAL PARM]
      CHARACTER  TUNIT *4                     !" INTLNG等の単位
      INTEGER    INTLNG                       !" 長波計算間隔
      INTEGER    INTSHT                       !" 短波計算間隔
      DATA       TUNIT  / 'HOUR'/
      DATA       INTLNG / 3     /
      DATA       INTSHT / 1     /
*
      NAMELIST  /NMRADM/ TUNIT , INTLNG, INTSHT
*
*   [INTERNAL SAVE] 
      INTEGER    IORADL                       !" 長波計算間隔：秒
      INTEGER    IORADS                       !" 短波計算間隔：秒
      INTEGER    ITLSTL                       !" 以前長波計算した時刻
      INTEGER    ITLSTS                       !" 以前短波計算した時刻
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE
*
*   [INTERNAL WORK] 
      INTEGER    IJ, K, L
      INTEGER    IFPAR, JFPAR
*
*   [ONCE]
      IF ( OFIRST ) THEN
         WRITE ( 6,* ) ' RADIATION PACKAGE - Dummy Rad. DATE=92/07/14'
         OFIRST = .FALSE.
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMRADM, END=190 )
  190    WRITE  ( JFPAR, NMRADM )
      ENDIF
*
      IF (  ( IT - ITLSTL ) .GE. IORADL ) THEN
*
         ITLSTL = IT
*
*"         < 2. 長波フラックスの算出 >
*
         DO 1000 K = 1, KMAX+1
            DO 1100 IJ = 1, IDIM*JDIM
               RFLUX( IJ, K ) = 0.0
               DO 1200 L = 0,1
                  DRFLUX( IJ, K, L ) = 0.0
 1200          CONTINUE 
 1100    CONTINUE 
 1000    CONTINUE 
*
*"         < 3. 長波陰解用行列 >
*
         DO 3000 IJ = 1, IDIM*JDIM
            RMTXS ( IJ,0  ) =   DRFLUX( IJ,1,0 )
            RMTXS ( IJ,1  ) = - DRFLUX( IJ,1,1 )
            RMTXS ( IJ,-1 ) = 0.  
 3000    CONTINUE
*
      ENDIF
*
      IF (  ( IT - ITLSTS ) .GE. IORADS ) THEN
*
         ITLSTS = IT
*
*"         < 4. 短波入射, フラックス >
*
         DO 4000 IJ = 1, IDIM*JDIM
            DO 4100 K = 1, KMAX+1
               SFLUX(IJ,K) = 0.0
 4100       CONTINUE 
 4000    CONTINUE 
*
      ENDIF
*
      RETURN
      END
************************************************************************
      SUBROUTINE RADCOR             !" 放射フラックス補正
     M         ( RFLUX ,
     I           DRFLUX, GTT   , GTTG  , DELT  )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                       !" 格子点数，波数
#else
#include        "zcdim.F"                     !" 格子点数，波数
#endif
*
*   [MODIFY] 
      REAL       RFLUX  ( IDIM*JDIM, KMAX+1 )     !" 長波フラックス
*
*   [INPUT] 
      REAL       DRFLUX ( IDIM*JDIM, KMAX+1, 0:1 )!" 長波地表温度変化
      REAL       GTT    ( IDIM*JDIM, KMAX )       !" 温度時間変化項
      REAL       GTTG   ( IDIM*JDIM )             !" 地表温度変化率
      REAL       DELT                             !" 時間刻みΔt
*
*   [INTERNAL WORK] 
      INTEGER    IJ, K
*
*
      DO 1100 K = 1, KMAX+1
         DO 1100 IJ = 1, IDIM*JDIM
            RFLUX ( IJ,K ) = RFLUX ( IJ,K )
     &                     + (   GTTG ( IJ )   * DRFLUX( IJ,K,0 )
     &                         - GTT  ( IJ,1 ) * DRFLUX( IJ,K,1 ) )
     &                      * DELT
 1100 CONTINUE
*
      RETURN
      END
*********************************************************************
      SUBROUTINE RADTND               !" 放射加熱率
     O         ( GTTRL , GTTRS ,
     I           RFLUX , SFLUX , GDPM    )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                       !" 格子点数，波数
      INCLUDE   (ZCCOM)                       !" 標準物理定数
#else
#include        "zcdim.F"                     !" 格子点数，波数
#include        "zccom.F"                     !" 標準物理定数
#endif
*
*   [OUTPUT] 
      REAL       GTTRL  ( IDIM*JDIM, KMAX   ) !" 長波加熱率
      REAL       GTTRS  ( IDIM*JDIM, KMAX   ) !" 短波加熱率
*
*   [INPUT] 
      REAL       RFLUX  ( IDIM*JDIM, KMAX+1 ) !" 長波フラックス
      REAL       SFLUX  ( IDIM*JDIM, KMAX+1 ) !" 短波フラックス
      REAL       GDPM   ( IDIM*JDIM, KMAX+1 ) !" 気圧
*
*   [INTERNAL WORK] 
      INTEGER    IJ, K
*
*
      DO 1100 K = 1, KMAX
         DO 1110 IJ = 1, IDIM*JDIM
            GTTRL ( IJ,K )
     &         =  (  RFLUX( IJ,K ) - RFLUX( IJ,K+1 )   )
     &           /(  GDPM ( IJ,K ) - GDPM ( IJ,K+1 )   )
     &           / CP * GRAV
 1110    CONTINUE
 1100 CONTINUE
*
      DO 2100 K = 1, KMAX
         DO 2110 IJ = 1, IDIM*JDIM
            GTTRS ( IJ,K )
     &         =  (  SFLUX( IJ,K ) - SFLUX( IJ,K+1 )  )
     &           /(  GDPM ( IJ,K ) - GDPM ( IJ,K+1 )   )
     &           / CP * GRAV
 2110    CONTINUE
 2100 CONTINUE
*
      RETURN
      END
