* PACKAGE DADMN  
*"                  ver 1.00                   92/06/12 numaguti
*"                  SRC:=$GC/model/agcm5/src/dynamics/dadmn.F
*"                  DOC:=$GC/model/agcm5/doc/dynamics.tex
**********************************************************************
      SUBROUTINE DYNMCS                      
     M         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     M           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     M           GAVOR , GADIV , GBVOR , GBDIV ,
     M           GTUA  , GTVA  , GTH   , GTR   ,
     I           IT    , DELT  , OADVNC,
     C           ALON  , DLON  , ALAT  , DLAT  ,
     C           SIG   , SIGM  , DSIG  , DSIGM           )
*
*"              semi-implicit 時間積分
*"              implicit diffusion
*
*   [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              )

* 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       GAU   ( IDIM, JDIM, KMAX )  
      ReaL*8       GAV   ( IDIM, JDIM, KMAX )  
      ReaL*8       GAT   ( IDIM, JDIM, KMAX )  
      ReaL*8       GAPS  ( IDIM, JDIM       )  
      ReaL*8       GAQ   ( IDIM, JDIM, KMAX )  
      ReaL*8       GAVOR ( IDIM, JDIM, KMAX )  
      ReaL*8       GADIV ( IDIM, JDIM, KMAX )  
*"       : 格子点データ(t) <GENGD> 格子点データ(t+Δt)
*
      ReaL*8       GBU   ( IDIM, JDIM, KMAX )  
      ReaL*8       GBV   ( IDIM, JDIM, KMAX )  
      ReaL*8       GBT   ( IDIM, JDIM, KMAX )  
      ReaL*8       GBPS  ( IDIM, JDIM       )  
      ReaL*8       GBQ   ( IDIM, JDIM, KMAX )  
      ReaL*8       GBVOR ( IDIM, JDIM, KMAX )  
      ReaL*8       GBDIV ( IDIM, JDIM, KMAX )  
*"       : 格子点データ(t-Δt) <MOVGD>  格子点データ(t)
*
      ReaL*8       GTUA  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTVA  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTH   ( IDIM, JDIM, KMAX )  
      ReaL*8       GTR   ( IDIM, JDIM, KMAX )  
*"       :  格子点変化項を足し込む
*
      INTEGER    IT                          
      ReaL*8       DELT                        
      LOGICAL    OADVNC                      
*"       :  時刻変数
*
*   [INPUT]
      ReaL*8       ALON  ( IDIM )              
      ReaL*8       DLON  ( IDIM )              
      ReaL*8       ALAT  ( JDIM )              
      ReaL*8       DLAT  ( JDIM )              
      ReaL*8       SIG   ( KMAX )              
      ReaL*8       SIGM  (KMAX+1)              
      ReaL*8       DSIG  ( KMAX )              
      ReaL*8       DSIGM (KMAX+1)              
*"        : 座標格子
*
*   [INTERNAL SAVE]
      ReaL*8       DMLU  ( NMDIM, KMAX, KMAX ) 
      INTEGER    KPIV  ( NMDIM, KMAX       ) 
      ReaL*8       DELTSV                      
      DATA       DELTSV / 0.0  /
      SAVE       DMLU, KPIV, DELTSV
*
*   [INTERNAL ONCE]
      INTEGER    NMO   ( 2, 0:MMAX, 0:LMAX ) 
      ReaL*8       FLAPLA( NMDIM  )            
      ReaL*8       EDEL  ( NMDIM  )            
*
      ReaL*8       CORIOL ( IDIM, JDIM )       
      ReaL*8       UVFACT ( IDIM, JDIM )       
*
      ReaL*8       DIFV  ( NMDIM  )            
      ReaL*8       DIFT  ( NMDIM  )            
*
      ReaL*8       SALPHA( KMAX )              
      ReaL*8       SBETA ( KMAX )              
      ReaL*8       SKAPPA( KMAX )              
      ReaL*8       ATF   ( KMAX )              
      ReaL*8       BTF   ( KMAX )              
      ReaL*8       TBAR  ( KMAX )              
      ReaL*8       TBARM ( KMAX )              
      ReaL*8       GG    ( KMAX )              
      ReaL*8       TMTX  ( KMAX, KMAX )        
      ReaL*8       WHMTX ( KMAX, KMAX )        
      ReaL*8       GCMTX ( KMAX, KMAX )        
*
      ReaL*8       WPHIS ( NMDIM )             
*
      SAVE       NMO   , FLAPLA, EDEL  ,
     &           CORIOL, UVFACT, DIFV  , DIFT  ,
     &           SALPHA, SBETA , SKAPPA,
     &           ATF   , BTF   , TBAR  , TBARM ,
     &           GG    , TMTX  , WHMTX , GCMTX ,
     &           WPHIS
*
      LOGICAL    OSETC , OSETV
      DATA       OSETC , OSETV  / .FALSE., .FALSE.  /
      SAVE       OSETC , OSETV
*
*   [INTERNAL PARAM]
      LOGICAL    ODIASP
      DATA       ODIASP         / .FALSE. /
      SAVE       ODIASP
*
*   [INTERNAL WORK]
      ReaL*8       GAPIX ( IDIM, JDIM       )  
      ReaL*8       GAPIY ( IDIM, JDIM       )  
*        : 気圧傾度
*
      ReaL*8       GTKE  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTUT  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTVT  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTPI  ( IDIM, JDIM       )  
      ReaL*8       GTUQ  ( IDIM, JDIM, KMAX )  
      ReaL*8       GTVQ  ( IDIM, JDIM, KMAX )  
      ReaL*8       GSIGD ( IDIM, JDIM, KMAX+1 )
      ReaL*8       GPID  ( IDIM, JDIM       )  
*"       : 時間変化項
*
      ReaL*8       WDVOR ( NMDIM , KMAX     )  
      ReaL*8       WDDIV ( NMDIM , KMAX     )  
      ReaL*8       WDT   ( NMDIM , KMAX     )  
      ReaL*8       WDPI  ( NMDIM            )  
      ReaL*8       WDQ   ( NMDIM , KMAX     )  
*"       : スペクトルデータ
*
      ReaL*8       WTVOR ( NMDIM, KMAX      )  
      ReaL*8       WTDIV ( NMDIM, KMAX      )  
      ReaL*8       WTT   ( NMDIM, KMAX      )  
      ReaL*8       WTPI  ( NMDIM            )  
      ReaL*8       WTQ   ( NMDIM, KMAX      )  
      ReaL*8       WTVDIF( NMDIM, KMAX      )  
      ReaL*8       WTDDIF( NMDIM, KMAX      )  
*"       : スペクトル時間変化項
*
*
*"  << SETCON : 定数設定 >>
*
*   [ONCE]
      IF ( .NOT. OSETC ) THEN
         OSETC = .TRUE.
         CALL    DSETC                 
     O         ( NMO   , FLAPLA, EDEL  ,
     O           CORIOL, UVFACT, DIFV  , DIFT  ,
     C           ALAT  , DLAT                   )
      ENDIF
*   [ONCE]
      IF ( .NOT. OSETV ) THEN
         OSETV = .TRUE.
         CALL    DSETV                 
     O         ( SALPHA, SBETA , SKAPPA,
     O           ATF   , BTF   , TBAR  , TBARM ,
     O           GG    , TMTX  , WHMTX , GCMTX ,
     C           SIG   , SIGM  , DSIG            )
*
         CALL    DHSTRG                
      ENDIF
*
      IF ( DELT .NE. DELTSV ) THEN
         CALL DMTRIX                   
     O         ( DMLU  , KPIV  ,
     I           DELT  ,
     C           WHMTX , GCMTX ,
     C           NMO   , ER    , DIFV  , DIFT  )
         DELTSV = DELT
      ENDIF
*
      CALL SETPHS                      
     O         ( WPHIS ,
     I           IT      )
*
*" << TNDNCY : 時間変化項 >>
*
      CALL PIXPIY                      
     O         ( GAPIX , GAPIY ,
     I           GAPS            )
*
      CALL GRDDYN                      
     M         ( GTUA  , GTVA  , GTH   , GTR   ,
     O           GTKE  , GTUT  , GTVT  , GTPI  , GTUQ  , GTVQ  ,
     O           GSIGD , GPID  ,
     I           GAU   , GAV   , GAT   , GAQ   ,
     I           GAVOR , GADIV , GAPIX , GAPIY ,
     C           CORIOL, UVFACT, SIGM  , DSIG  ,
     C           SALPHA, SBETA , SKAPPA,
     C           ATF   , BTF   , TBAR  , TBARM                   )
*
      CALL TENG2W                      
     O         ( WTVOR , WTDIV , WTT   , WTPI  , WTQ   ,
     I           GTUA  , GTVA  , GTKE  , GTUT  , GTVT  , GTH   ,
     I           GTPI  , GTUQ  , GTVQ  , GTR   ,
     C           FLAPLA                                          )
*
      CALL GD2WD                       
     O         ( WDVOR , WDDIV , WDT   , WDPI  , WDQ   ,
     I           GBVOR , GBDIV , GBT   , GBPS  , GBQ    )
*
*" << INTGR : 時間積分 >>
*
      CALL TINTGR                      
     M         ( WDVOR , WDDIV , WDT   , WDPI  , WDQ   ,
     I           WTVOR , WTDIV , WTT   , WTPI  , WTQ   ,
     I           DMLU  , KPIV  , DELT  ,
     C           DIFV  , DIFT  , FLAPLA, WPHIS ,
     C           GG    , TMTX  , DSIG                   )
*
      IF ( OADVNC ) THEN
         CALL MOVGD                    
     O         ( GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     O           GBVOR , GBDIV ,
     I           GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GAVOR , GADIV                          )
      ENDIF
*
      CALL GENGD                       
     O         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     O           GAVOR , GADIV ,
     I           WDVOR , WDDIV , WDT   , WDPI  , WDQ   ,
     C           EDEL  , UVFACT                          )
*
*" << CORRCT : 補正 >>
*
      CALL TENDIF                      
     O         ( WTVDIF, WTDDIF,
     I           WDVOR , WDDIV ,
     I           DIFV           )
*
      CALL CORDIF                      
     M         ( GAT   ,
     I           WTVDIF, WTDDIF,
     I           GAU   , GAV   , DELT  ,
     C           EDEL  , UVFACT         )
*
*" << OUTPUT : 出力 >>
*
      CALL HISTIN ( GSIGD , 'SIGDOT')  
      CALL HISTIN ( GPID  , 'PIDOT' )
*
      CALL DDIAG                       
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GAVOR , GADIV                          )
*
      IF ( ODIASP ) THEN
        CALL SPCTLD                    
     I         ( WDVOR , 'VOR' , KMAX  , NMO   )
        CALL SPCTLD
     I         ( WDDIV , 'DIV' , KMAX  , NMO   )
        CALL SPCTLD
     I         ( WDT   , 'TMP' , KMAX  , NMO   )
        CALL SPCTLD
     I         ( WDQ   , 'Q'   , KMAX  , NMO   )
        CALL SPCTLD
     I         ( WDPI  , 'PI'  , 1     , NMO   )
      ENDIF
*
      RETURN
*======================================================================
      ENTRY DSTRT                      
     M         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     O           GAVOR , GADIV ,
     C           ALAT  , DLAT                           )
*
*   [MODIFY]
*     ReaL*8       GAU   ( IDIM, JDIM, KMAX )  
*     ReaL*8       GAV   ( IDIM, JDIM, KMAX )  
*     ReaL*8       GAT   ( IDIM, JDIM, KMAX )  
*     ReaL*8       GAPS  ( IDIM, JDIM       )  
*     ReaL*8       GAQ   ( IDIM, JDIM, KMAX )  
*
*   [OUTNPUT]
*     ReaL*8       GAVOR ( IDIM, JDIM, KMAX )  
*     ReaL*8       GADIV ( IDIM, JDIM, KMAX )  
*
*   [INPUT]
*     ReaL*8       ALAT  ( JDIM )              
*     ReaL*8       DLAT  ( JDIM )              
*
*   [ONCE]
      IF ( .NOT. OSETC ) THEN
         OSETC = .TRUE.
         CALL    DSETC                 
     O         ( NMO   , FLAPLA, EDEL  ,
     O           CORIOL, UVFACT, DIFV  , DIFT  ,
     C           ALAT  , DLAT                   )
      ENDIF
*
      CALL STRTV                       
     M         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     O           GAVOR , GADIV ,
     C           EDEL  , UVFACT,
     W           WDVOR , WDDIV , WDT   , WDPI  , WDQ    )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE DHSTRG                
*
*   [INTERNAL PARAM]
      INTEGER    ISTYPL
      DATA       ISTYPL / 1 /
*
*   [INTERNAL WORK]
      ReaL*8       VMISS
*
      CALL GZDBGT ( 'MISS' , VMISS )   
*
      CALL HISTRG                      
     I       ( 'SIGDOT', 'sigma-vertical vel. ' ,'1/s   ', 'AMLEV',
     I           VMISS , VMISS , VMISS , VMISS , ISTYPL  ,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      CALL HISTRG
     I       ( 'PIDOT ', 'pi-tendency         ' ,'1/s   ', 'ASFC',
     I           VMISS , VMISS , VMISS , VMISS , ISTYPL  ,
     I         '   '   , '   ' , 0     , 0     , 'X'     ,'(1PE12.3)' )
*
      RETURN
      END
