*     PACKAGE ASTRT  
*"                  ver 1.00                   92/06/11 numaguti
*"                  SRC:=$GC/model/agcm5/src/admin/astrt.F
*"                  DOC:=$GC/model/agcm5/doc/admin.tex
**********************************************************************
      SUBROUTINE RDSTRT             
     O         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     O           GAVOR , GADIV ,
     O           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     O           GBVOR , GBDIV ,
     O           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     C           ITSTRT, ALAT  , DLAT                   )
*
*   [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              )

*
*   [OUTPUT]
      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)
*
      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)
*
      INTEGER    ISTEP                 
      INTEGER    ITA                   
      INTEGER    ITB                   
      INTEGER    IDATEA( 6 )           
      INTEGER    IDATEB( 6 )           
*"       : 時刻等
*
*   [CONST]
      INTEGER    ITSTRT                
      ReaL*8       ALAT  ( JDIM )        
      ReaL*8       DLAT  ( JDIM )        
*
*   [INTERNAL WORK]
      INTEGER    ITINIT                
      INTEGER    ITDBFR                
      INTEGER    ITDAFT                
      INTEGER    ISTEPV, II, ISCDIF, ITDIF
      INTEGER    IFPAR, JFPAR, IFLSTR, IERR
      INTEGER    IEOD, ISTEPA
*
*   [INTERNAL PARAM]
      CHARACTER  FILE *(NFILN)         
      CHARACTER  TUNIT  *4             
      INTEGER    TINIT                 
      INTEGER    IDATEI( 6 )           
      INTEGER    DTBFR                 
      INTEGER    DTAFTR                
      DATA       FILE   / ' ' /
      DATA       TUNIT  / 'DAY ' /
      DATA       TINIT  / -999 /
      DATA       DTBFR  / 0 /
      DATA       DTAFTR / 10 /
      INTEGER    IFILED
      INTEGER    IOMODE
      DATA       IFILED / 40 /
      DATA       IOMODE / 0  /
*
      NAMELIST /NMINIT/ FILE, TUNIT, TINIT, DTBFR, DTAFTR
      NAMELIST /NMDATE/ IDATEI
*
      WRITE ( 6,* ) ' INITIAL DATA READ DATE=92/06/18'
*
*" << INITIM : 初期値の時刻 >>
*
      ITINIT = ITSTRT
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMINIT, END=190 )
  190 WRITE  ( JFPAR, NMINIT )
*
      IF ( TINIT .NE. -999 ) THEN
         CALL ACTIME ( TINIT, TUNIT, '#', ITINIT  )
      ELSE
         ITINIT = ITSTRT
      ENDIF
*
      CALL ACTIME ( DTBFR,  TUNIT, '#', ITDBFR  )
      CALL ACTIME ( DTAFTR, TUNIT, '#', ITDAFT  )
*
      IF ( ITINIT .GE. 0 ) THEN
         WRITE ( 6,* ) ' TRY TO READ HIST AT T = ', ITINIT
      ELSE
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMDATE, END=1090 )
 1090    WRITE  ( JFPAR, NMDATE )         
         WRITE ( 6,* ) ' TRY TO READ HIST AT T = ', IDATEI
      ENDIF
*
*" << RDSTR : 初期値の読み込み >>
*
      CALL IFLOPN
     O         ( IFLSTR, IERR  ,
     I           FILE  , IFILED, 'READ', 'UNFORMATTED' )
*
      CALL RDGDST                
     O         ( GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     O           ITB   , IDATEB, ISTEP , IEOD  ,
     I           'GB'  , ITINIT, IDATEI,
     I           ITDBFR, ITDAFT, IFLSTR, IOMODE  )
*
      IF ( IEOD .GE. 1 ) THEN
         CALL MSGDMP( 'E','GRSTRT','***** No Initial Data. ******')
*        ** STOP **
      ENDIF
*
      CALL RDGDST                
     O         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     O           ITA   , IDATEA, ISTEPA, IEOD  ,
     I           'GA'  , ITINIT, IDATEI,
     I           ITDBFR, ITDAFT, IFLSTR, IOMODE  )
*
*"  << NOGA : GA 無し=>GB=GA >>
*
      IF ( ( IEOD.GE.1 ) .OR. ( ISTEPA.NE.ISTEP ) ) THEN
         CALL MSGDMP('M','GRSTRT',' ***** No Initial GA Data *******' )
         CALL MSGDMP('M','GRSTRT',' --- GA=GB Assumed' )
*
         CALL COPY ( GAU   , GBU   , IDIM*JDIM*KMAX )
         CALL COPY ( GAV   , GBV   , IDIM*JDIM*KMAX )
         CALL COPY ( GAT   , GBT   , IDIM*JDIM*KMAX )
         CALL COPY ( GAPS  , GBPS  , IDIM*JDIM      )
         CALL COPY ( GAQ   , GBQ   , IDIM*JDIM*KMAX )
*
         ITA = ITB
         DO 4100 II = 1, 6
            IDATEA( II ) = IDATEB( II )
 4100    CONTINUE
      ENDIF
*
*"  << VORDIV : 渦度発散の読み込みと生成 >>
*
      CALL RDGDSV                
     O         ( GBVOR , GBDIV ,
     O           ISTEPV, IEOD  ,
     I           'GB'  , IFLSTR, IOMODE  )
*
      IF ( ( IEOD.GE.1 ) .OR. ( ISTEPV.NE.ISTEP ) ) THEN
         CALL DSTRT             
     M        (  GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     O           GBVOR , GBDIV ,
     C           ALAT  , DLAT                           )
      ENDIF
*
      CALL RDGDSV                
     O         ( GAVOR , GADIV ,
     O           ISTEPV, IEOD  ,
     I           'GA'  , IFLSTR, IOMODE  )
*
      IF ( ( IEOD.GE.1 ) .OR. ( ISTEPV.NE.ISTEP ) ) THEN
         CALL DSTRT             
     M        (  GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     O           GAVOR , GADIV ,
     C           ALAT  , DLAT                           )
      ENDIF
*
      CALL GFCLSE ( IFLSTR )
*
*"  << CHGDAT : 日付の変更 >>
*
      IF ( ITINIT .GE. 0 ) THEN
         DO 5100 II = 1,6
            IDATEI( II ) = IDATEB( II )
 5100    CONTINUE
*
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMDATE, END=5190 )
 5190    WRITE  ( JFPAR, NMDATE )
*
         CALL DIDATE
     O      ( ISCDIF,
     I        IDATEA, IDATEB )
         DO 5300 II = 1, 6
            IDATEB( II ) = IDATEI( II )
 5300    CONTINUE
         CALL AIDATE
     O      ( IDATEA,
     I        IDATEB, ISCDIF )
*
         ITDIF = ITB - ITINIT
         ITA   = ITA - ITB + ITDIF + ITSTRT
         ITB   =             ITDIF + ITSTRT
      ELSE
*
         ITA   = ITA - ITB + ITSTRT
         ITB   =             ITSTRT
      ENDIF
*
      IF ( ITINIT .NE. ITSTRT ) THEN
         CALL MSGDMP('M', 'GRSTRT', 'INITIAL TIME IT IS MODIFIED' )
      ENDIF
      WRITE ( 6,* ) ' **** INITIAL IT, DATE ', 
     &              ITB, (IDATEB( II ), II=1, 6)
*
      RETURN
      END
***********************************************************************
      SUBROUTINE RDGDST        
     O         ( GDU   , GDV   , GDT   , GDPS  , GDQ   ,
     O           ITD   , IDATED, ISTEP , IEOD  ,
     I           HAB   , ITINIT, IDATEI,
     I           ITDBFR, ITDAFT, IFLSTR, IOMODE  )
*
*   [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                       )

*
*   [OUTPUT]
      ReaL*8       GDU   ( IDIM, JDIM, KMAX )  
      ReaL*8       GDV   ( IDIM, JDIM, KMAX )  
      ReaL*8       GDT   ( IDIM, JDIM, KMAX )  
      ReaL*8       GDPS  ( IDIM, JDIM       )  
      ReaL*8       GDQ   ( IDIM, JDIM, KMAX )  
*"       : 格子点データ
*
      INTEGER    ISTEP                 
      INTEGER    ITD                   
      INTEGER    IDATED( 6 )           
*"       : 時刻等
      INTEGER    IEOD                  
*
*   [INPUT]
      CHARACTER  HAB *(*)              
      INTEGER    ITINIT                
      INTEGER    IDATEI( 6 )           
      INTEGER    ITDBFR                
      INTEGER    ITDAFT                
      INTEGER    IFLSTR                
      INTEGER    IOMODE                
*
*   [INTERNAL WORK]
      INTEGER    IEODU, IEODV, IEODT, IEODP, IEODQ
      INTEGER    ITDUR, ISCDIF
      CHARACTER  HU*3, HV*3, HT*3, HPS*4, HQ*3
      HU  = HAB(1:2)//'U'
      HV  = HAB(1:2)//'V'
      HT  = HAB(1:2)//'T'
      HPS = HAB(1:2)//'PS'
      HQ  = HAB(1:2)//'Q'
*
 1100 CONTINUE
*
         CALL GDREAD
     O         ( GDU   , IEODU ,
     O           ITD   , IDATED, ISTEP , ITDUR ,
     I           IFLSTR, HU    , IOMODE, 'ALEV'  )
*
         IF ( IEODU .EQ. 0  ) THEN
            WRITE ( 6,* ) '        READ HIST AT T = ', ITD
*
            IF ( ( ITDBFR .GE. 0 ) .AND. ( ITDAFT .GE. 0 ) ) THEN
               IF ( ITINIT .GE. 0 ) THEN
                  IF ( ( ITD .LT. ITINIT-ITDBFR ).OR.
     &                 ( ITD .GT. ITINIT+ITDAFT )     ) THEN
                     GOTO 1100
*"                              ------> 次のデータ ----->
                  ENDIF
               ELSE
                  CALL DIDATE   
     O               ( ISCDIF,
     I                 IDATED, IDATEI )
                  IF ( ( ISCDIF .LT. -ITDBFR ) .OR. 
     &                 ( ISCDIF .GT. ITDAFT  )      ) THEN
                     GOTO 1100 
*"                              ------> 次のデータ ----->
                  ENDIF
               ENDIF
            ENDIF
        ENDIF
*
      CALL GDREAD
     O         ( GDV   , IEODV ,
     O           ITD   , IDATED, ISTEP , ITDUR ,
     I           IFLSTR, HV    , IOMODE, 'ALEV' )
*
      CALL GDREAD
     O         ( GDT   , IEODT ,
     O           ITD   , IDATED, ISTEP , ITDUR ,
     I           IFLSTR, HT    , IOMODE, 'ALEV' )
*
      CALL GDREAD
     O         ( GDPS  , IEODP ,
     O           ITD   , IDATED, ISTEP , ITDUR ,
     I           IFLSTR, HPS   , IOMODE, 'ASFC' )
*
      CALL GDREAD
     O         ( GDQ   , IEODQ ,
     O           ITD   , IDATED, ISTEP , ITDUR ,
     I           IFLSTR, HQ    , IOMODE, 'ALEV' )
*
      IEOD = MAX( IEODU, IEODV, IEODT, IEODP, IEODQ )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE RDGDSV               
     O         ( GDVOR , GDDIV ,
     O           ISTEP , IEOD  ,
     I           HAB   , IFLSTR, IOMODE  )
*
*   [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                       )

*
*   [OUTPUT]
      ReaL*8       GDVOR ( IDIM, JDIM, KMAX )  
      ReaL*8       GDDIV ( IDIM, JDIM, KMAX )  
*"       : 格子点データ
*
      INTEGER    ISTEP                 
      INTEGER    IEOD                  
*
*   [INPUT]
      CHARACTER  HAB *(*)              
      INTEGER    IFLSTR                
      INTEGER    IOMODE                
*
*   [INTERNAL WORK]
      INTEGER    ITD                   
      INTEGER    IDATED( 6 )           
      INTEGER    IEODV, IEODD, ITDUR
*
      CHARACTER  HVOR*5, HDIV*5
      HVOR  = HAB(1:2)//'VOR'
      HDIV  = HAB(1:2)//'DIV'
*
      CALL GDREAD
     O         ( GDVOR , IEODV ,
     O           ITD   , IDATED, ISTEP , ITDUR ,
     I           IFLSTR, HVOR  , IOMODE, 'ALEV' )
*
      CALL GDREAD
     O         ( GDDIV , IEODD ,
     O           ITD   , IDATED, ISTEP , ITDUR ,
     I           IFLSTR, HDIV  , IOMODE, 'ALEV' )
*
      IEOD = MAX( IEODV, IEODD )
*
      RETURN
      END
**********************************************************************
      SUBROUTINE RDSTRG             
     O         ( GBTG  ,
     I           GBT   ,
     C           ITSTRT  )
*
*   [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              )

*
*   [OUTPUT]
      ReaL*8       GBTG  ( IDIM, JDIM )        
*
*   [INPUT]
      ReaL*8       GBT   ( IDIM, JDIM, KMAX )  
*
*   [CONST]
      INTEGER    ITSTRT                
*
*   [INTERNAL WORK]
      INTEGER    ISTEPG                
      INTEGER    ITG                   
      INTEGER    IDATEG( 6 )           
      INTEGER    ITINIT                
      INTEGER    ITDBFR                
      INTEGER    ITDAFT                
      INTEGER    IFPAR, JFPAR, IFLGST, IERR
      INTEGER    IEODG, ITDURG, ISCDIF
*
*   [INTERNAL PARAM]
      CHARACTER  FILE   *(NFILN)       
      CHARACTER  TUNIT  *4             
      INTEGER    TINIT                 
      INTEGER    IDATEI( 6 )           
      INTEGER    DTBFR                 
      INTEGER    DTAFTR                
      DATA       FILE    / ' ' /
      DATA       TUNIT  / 'DAY ' /
      DATA       TINIT  / -999 /
      DATA       DTBFR  / 0 /
      DATA       DTAFTR / 10 /
      INTEGER    IFILED
      INTEGER    IOMODE
      DATA       IFILED / 42 /
      DATA       IOMODE / 0  /
*
      NAMELIST /NMINIG/ FILE, TUNIT, TINIT, DTBFR, DTAFTR
      NAMELIST /NMDATG/ IDATEI
*
      WRITE ( 6,* ) ' INITIAL TG READ DATE=92/06/18'
*
*" << INITIM : 初期値の時刻 >>
*
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMINIG, END=1080 )
 1080 WRITE  ( JFPAR, NMINIG )
*
      IF ( TINIT .NE. -999 ) THEN
         CALL ACTIME ( TINIT, TUNIT, '#', ITINIT )
      ELSE
         ITINIT = ITSTRT
      ENDIF
      CALL ACTIME ( DTBFR,  TUNIT, '#', ITDBFR  )
      CALL ACTIME ( DTAFTR, TUNIT, '#', ITDAFT  )
*
      IF ( ITINIT .GE. 0 ) THEN
         WRITE ( 6,* ) ' TRY TO READ TG HIST AT T = ', ITINIT
      ELSE
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMDATG, END=1090 )
 1090    WRITE  ( JFPAR, NMDATG )         
         WRITE ( 6,* ) ' TRY TO READ TG HIST AT T = ', IDATEI
      ENDIF
*
*" << READ : 読み込み >>
*
      CALL IFLOPN
     O         ( IFLGST, IERR  ,
     I           FILE  , IFILED, 'READ', 'UNFORMATTED' )
*
 1100 CONTINUE
*
         CALL GDREAD
     O         ( GBTG  , IEODG ,
     O           ITG   , IDATEG, ISTEPG, ITDURG,
     I           IFLGST, 'GBTG', IOMODE, 'ASFC' )
* 
         IF ( IEODG .EQ. 0  ) THEN
            WRITE ( 6,* ) '        READ TG AT T = ', ITG
*
            IF ( ( ITDBFR .GE. 0 ) .AND. ( ITDAFT .GE. 0 ) ) THEN
               IF ( ITINIT .GE. 0 ) THEN
                  IF ( ( ITG .LT. ITINIT-ITDBFR ).OR.
     &                 ( ITG .GT. ITINIT+ITDAFT )     ) THEN
                     GOTO 1100
*"                              ------> 次のデータ ----->
                  ENDIF
               ELSE
                  CALL DIDATE   
     O               ( ISCDIF,
     I                 IDATEG, IDATEI )
                  IF ( ( ISCDIF .LT. -ITDBFR ) .OR. 
     &                 ( ISCDIF .GT. ITDAFT  )      ) THEN
                     GOTO 1100 
*"                              ------> 次のデータ ----->
                  ENDIF
               ENDIF
            ENDIF
        ENDIF
*
      IF ( IEODG .NE. 0 ) THEN
         CALL MSGDMP('M','GRSTRT',' ***** No Initial Tg Data *******' )
         CALL MSGDMP('M','GRSTRT',' Assume Atmospherric Temprerature' )
         CALL COPY ( GBTG  , GBT   , IDIM*JDIM )
      ENDIF
*
      CALL GFCLSE ( IFLGST )
*
      RETURN
      END
**********************************************************************
      SUBROUTINE RDSTRH             
     O         ( GBHI  ,
     C           ITSTRT  )
*
*   [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              )

*
*   [OUTPUT]
      ReaL*8       GBHI  ( IDIM, JDIM )        
*
*   [CONST]
      INTEGER    ITSTRT                
*
*   [INTERNAL WORK]
      INTEGER    ISTEPG                
      INTEGER    ITG                   
      INTEGER    IDATEG( 6 )           
      INTEGER    ITINIT                
      INTEGER    ITDBFR                
      INTEGER    ITDAFT                
      INTEGER    IFPAR, JFPAR, IFLGST, IERR
      INTEGER    IEODG, ITDURG, ISCDIF
*
*   [INTERNAL PARAM]
      CHARACTER  FILE   *(NFILN)       
      CHARACTER  TUNIT  *4             
      INTEGER    TINIT                 
      INTEGER    IDATEI( 6 )           
      INTEGER    DTBFR                 
      INTEGER    DTAFTR                
      DATA       FILE    / ' ' /
      DATA       TUNIT  / 'DAY ' /
      DATA       TINIT  / -999 /
      DATA       DTBFR  / 0 /
      DATA       DTAFTR / 10 /
      INTEGER    IFILED
      INTEGER    IOMODE
      DATA       IFILED / 45 /
      DATA       IOMODE / 0  /
*
      NAMELIST /NMINIH/ FILE, TUNIT, TINIT, DTBFR, DTAFTR
      NAMELIST /NMDATH/ IDATEI
*
      WRITE ( 6,* ) ' INITIAL HI READ DATE=2000/09/07'
*
*" << INITIM : 初期値の時刻 >>
*
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMINIH, END=1080 )
 1080 WRITE  ( JFPAR, NMINIH )
*
      IF ( TINIT .NE. -999 ) THEN
         CALL ACTIME ( TINIT, TUNIT, '#', ITINIT )
      ELSE
         ITINIT = ITSTRT
      ENDIF
      CALL ACTIME ( DTBFR,  TUNIT, '#', ITDBFR  )
      CALL ACTIME ( DTAFTR, TUNIT, '#', ITDAFT  )
*
      IF ( ITINIT .GE. 0 ) THEN
         WRITE ( 6,* ) ' TRY TO READ Hi HIST AT T = ', ITINIT
      ELSE
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMDATH, END=1090 )
 1090    WRITE  ( JFPAR, NMDATH )         
         WRITE ( 6,* ) ' TRY TO READ Hi HIST AT T = ', IDATEI
      ENDIF
*
*" << READ : 読み込み >>
*
      CALL IFLOPN
     O         ( IFLGST, IERR  ,
     I           FILE  , IFILED, 'READ', 'UNFORMATTED' )
*
 1100 CONTINUE
*
         CALL GDREAD
     O         ( GBHI  , IEODG ,
     O           ITG   , IDATEG, ISTEPG, ITDURG,
     I           IFLGST, 'GBHI', IOMODE, 'ASFC' )
* 
         IF ( IEODG .EQ. 0  ) THEN
            WRITE ( 6,* ) '        READ HI AT T = ', ITG
*
            IF ( ( ITDBFR .GE. 0 ) .AND. ( ITDAFT .GE. 0 ) ) THEN
               IF ( ITINIT .GE. 0 ) THEN
                  IF ( ( ITG .LT. ITINIT-ITDBFR ).OR.
     &                 ( ITG .GT. ITINIT+ITDAFT )     ) THEN
                     GOTO 1100
*"                              ------> 次のデータ ----->
                  ENDIF
               ELSE
                  CALL DIDATE   
     O               ( ISCDIF,
     I                 IDATEG, IDATEI )
                  IF ( ( ISCDIF .LT. -ITDBFR ) .OR. 
     &                 ( ISCDIF .GT. ITDAFT  )      ) THEN
                     GOTO 1100 
*"                              ------> 次のデータ ----->
                  ENDIF
               ENDIF
            ENDIF
        ENDIF
*
      IF ( IEODG .NE. 0 ) THEN
         CALL MSGDMP('M','GRSTRH',' ***** No Initial Hi Data *******' )
         CALL MSGDMP('M','GRSTRH',' Assume No Ice' )
         CALL RESET ( GBHI  , IDIM*JDIM )
      ENDIF
*
      CALL GFCLSE ( IFLGST )
*
      RETURN
      END
**********************************************************************
      SUBROUTINE RDSTRTO             
     O         ( GBTO  ,
     I           GBT   ,
     C           ITSTRT  )
*
*   [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              )

*
*   [OUTPUT]
      ReaL*8       GBTO  ( IDIM, JDIM )        
*
*   [INPUT]
      ReaL*8       GBT   ( IDIM, JDIM, KMAX )  
*
*   [CONST]
      INTEGER    ITSTRT                
*
*   [INTERNAL WORK]
      INTEGER    ISTEPG                
      INTEGER    ITG                   
      INTEGER    IDATEG( 6 )           
      INTEGER    ITINIT                
      INTEGER    ITDBFR                
      INTEGER    ITDAFT                
      INTEGER    IFPAR, JFPAR, IFLGST, IERR
      INTEGER    IEODG, ITDURG, ISCDIF
*
*   [INTERNAL PARAM]
      CHARACTER  FILE   *(NFILN)       
      CHARACTER  TUNIT  *4             
      INTEGER    TINIT                 
      INTEGER    IDATEI( 6 )           
      INTEGER    DTBFR                 
      INTEGER    DTAFTR                
      DATA       FILE    / ' ' /
      DATA       TUNIT  / 'DAY ' /
      DATA       TINIT  / -999 /
      DATA       DTBFR  / 0 /
      DATA       DTAFTR / 10 /
      INTEGER    IFILED
      INTEGER    IOMODE
      DATA       IFILED / 47 /
      DATA       IOMODE / 0  /
*
      NAMELIST /NMINIO/ FILE, TUNIT, TINIT, DTBFR, DTAFTR
      NAMELIST /NMDATO/ IDATEI
*
      WRITE ( 6,* ) ' INITIAL HI READ DATE=2000/09/07'
*
*" << INITIM : 初期値の時刻 >>
*
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMINIO, END=1080 )
 1080 WRITE  ( JFPAR, NMINIO )
*
      IF ( TINIT .NE. -999 ) THEN
         CALL ACTIME ( TINIT, TUNIT, '#', ITINIT )
      ELSE
         ITINIT = ITSTRT
      ENDIF
      CALL ACTIME ( DTBFR,  TUNIT, '#', ITDBFR  )
      CALL ACTIME ( DTAFTR, TUNIT, '#', ITDAFT  )
*
      IF ( ITINIT .GE. 0 ) THEN
         WRITE ( 6,* ) ' TRY TO READ To HIST AT T = ', ITINIT
      ELSE
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMDATO, END=1090 )
 1090    WRITE  ( JFPAR, NMDATO )         
         WRITE ( 6,* ) ' TRY TO READ To HIST AT T = ', IDATEI
      ENDIF
*
*" << READ : 読み込み >>
*
      CALL IFLOPN
     O         ( IFLGST, IERR  ,
     I           FILE  , IFILED, 'READ', 'UNFORMATTED' )
*
 1100 CONTINUE
*
         CALL GDREAD
     O         ( GBTO  , IEODG ,
     O           ITG   , IDATEG, ISTEPG, ITDURG,
     I           IFLGST, 'GBTO', IOMODE, 'ASFC' )
* 
         IF ( IEODG .EQ. 0  ) THEN
            WRITE ( 6,* ) '        READ To AT T = ', ITG
*
            IF ( ( ITDBFR .GE. 0 ) .AND. ( ITDAFT .GE. 0 ) ) THEN
               IF ( ITINIT .GE. 0 ) THEN
                  IF ( ( ITG .LT. ITINIT-ITDBFR ).OR.
     &                 ( ITG .GT. ITINIT+ITDAFT )     ) THEN
                     GOTO 1100
*"                              ------> 次のデータ ----->
                  ENDIF
               ELSE
                  CALL DIDATE   
     O               ( ISCDIF,
     I                 IDATEG, IDATEI )
                  IF ( ( ISCDIF .LT. -ITDBFR ) .OR. 
     &                 ( ISCDIF .GT. ITDAFT  )      ) THEN
                     GOTO 1100 
*"                              ------> 次のデータ ----->
                  ENDIF
               ENDIF
            ENDIF
        ENDIF
*
      IF ( IEODG .NE. 0 ) THEN
         CALL MSGDMP('M','GRSTRTO',' ***** No Initial To Data *******' )
         CALL MSGDMP('M','GRSTRTO',' Assume  Atmospherric Temprerature')
         CALL COPY ( GBTO  , GBT   , IDIM*JDIM )
      ENDIF
*
      CALL GFCLSE ( IFLGST )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE WRRSTR            
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GAVOR , GADIV ,
     I           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           GBVOR , GBDIV ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP  )
*
*   [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              )

*
*   [INPUT]
      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) <DYNMCS>  格子点データ(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) <DYNMCS>  格子点データ(t)
*
      INTEGER    ISTEP                 
      INTEGER    ITA                   
      INTEGER    ITB                   
      INTEGER    IDATEA( 6 )           
      INTEGER    IDATEB( 6 )           
*"       : 時刻等
*
*    [INTERNAL PARAM]
      CHARACTER  FILE   *(NFILN)       
      CHARACTER  DFMT  *(NCC)          
      DATA       FILE   / '  ' /
      DATA       DFMT   / 'UR8' /
      LOGICAL    OVORDV                
      DATA       OVORDV / .TRUE. /
      INTEGER    JFILED
      DATA       JFILED / 41 /
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE
*
      NAMELIST  /NMRSTR/ FILE, DFMT, OVORDV
*    
*    [INTERNAL WORK]
      INTEGER    IFPAR, JFPAR, JFLRST, IERR
*
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMRSTR, END=1090 )
 1090    WRITE  ( JFPAR, NMRSTR )         
*
         CALL IFLOPN
     O         ( JFLRST, IERR  ,
     I           FILE  , JFILED, 'WRITE', 'UNFORMATTED' )
      ENDIF
*
      CALL WRRSTX           
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     I           JFLRST, DFMT                            )
*
      CALL WRRSTY           
     I         ( GAVOR , GADIV ,
     I           GBVOR , GBDIV ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     I           JFLRST, DFMT                            )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE WRRSTX           
     I         ( GAU   , GAV   , GAT   , GAPS  , GAQ   ,
     I           GBU   , GBV   , GBT   , GBPS  , GBQ   ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     I           JFLRST, HDFMT                            )
*
*   [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              )

*
*   [INPUT]
      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 )  
*"       : 格子点データ(t) <DYNMCS>  格子点データ(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 )  
*"       : 格子点データ(t-Δt) <DYNMCS>  格子点データ(t)
*
      INTEGER    ISTEP                 
      INTEGER    ITA                   
      INTEGER    ITB                   
      INTEGER    IDATEA( 6 )           
      INTEGER    IDATEB( 6 )           
*"       : 時刻等
*
      INTEGER    JFLRST                
      CHARACTER  HDFMT  *(*)           
*
*    [INTERNAL PARAM]
      INTEGER    IOMODE
      INTEGER    NOEND
      INTEGER    ITDUR
      DATA       IOMODE / 0  /
      DATA       NOEND  / 0  /
      DATA       ITDUR  / 1  /
*
*" << GBWRIT : ファイル出力 (GB) >>
*
      CALL GDWRIT
     I        ( GBU   ,
     I         'GBU'  , 'u-velocity @ t      ','1/s' ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      CALL GDWRIT
     I        ( GBV   ,
     I         'GBV'  , 'v-velocity @ t      ','1/s' ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      CALL GDWRIT
     I        ( GBT   ,
     I         'GBT'   , 'temperature @ t     ','K'  ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      CALL GDWRIT
     I        ( GBPS  ,
     I         'GBPS' , 'Ps        @ t       ','mb'  ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ASFC', HDFMT  )
*
      CALL GDWRIT
     I        ( GBQ   ,
     I         'GBQ'  , 'moisture @t         ','g/g' ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
*" << GAWRIT : ファイル出力 (GA) >>
*
      CALL GDWRIT
     I        ( GAU   ,
     I         'GAU'  , 'u-velocity @ t+dt   ','1/s' ,
     I          ITA   , IDATEA, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      CALL GDWRIT
     I        ( GAV   ,
     I         'GAV'  , 'v-velocity @ t+dt   ','1/s' ,
     I          ITA   , IDATEA, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      CALL GDWRIT
     I        ( GAT   ,
     I         'GAT'  , 'temperature @ t+dt  ','K'   ,
     I          ITA   , IDATEA, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      CALL GDWRIT
     I        ( GAPS  ,
     I         'GAPS' ,   'Ps        @ t+dt  ','mb'  ,
     I          ITA   , IDATEA, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ASFC', HDFMT  )
*
      CALL GDWRIT
     I        ( GAQ   ,
     I         'GAQ'  , 'moisture @t+dt      ','g/g' ,
     I          ITA   , IDATEA, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE WRRSTY     
     I         ( GAVOR , GADIV ,
     I           GBVOR , GBDIV ,
     I           ITA   , ITB   , IDATEA, IDATEB, ISTEP ,
     I           JFLRST, HDFMT                            )
*
*   [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              )

*
*   [INPUT]
      ReaL*8       GAVOR ( IDIM, JDIM, KMAX )  
      ReaL*8       GADIV ( IDIM, JDIM, KMAX )  
*"       : 格子点データ(t) <DYNMCS>  格子点データ(t+Δt)
*
      ReaL*8       GBVOR ( IDIM, JDIM, KMAX )  
      ReaL*8       GBDIV ( IDIM, JDIM, KMAX )  
*"       : 格子点データ(t-Δt) <DYNMCS>  格子点データ(t)
*
      INTEGER    ISTEP                 
      INTEGER    ITA                   
      INTEGER    ITB                   
      INTEGER    IDATEA( 6 )           
      INTEGER    IDATEB( 6 )           
*"       : 時刻等
*
      INTEGER    JFLRST                
      CHARACTER  HDFMT  *(*)           
*
*    [INTERNAL PARAM]
      INTEGER    IOMODE
      INTEGER    NOEND
      INTEGER    ITDUR
      DATA       IOMODE / 0  /
      DATA       NOEND  / 0  /
      DATA       ITDUR  / 1  /
*
      CALL GDWRIT
     I        ( GBVOR ,
     I         'GBVOR', 'volticity @ t      ','1/s' ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      CALL GDWRIT
     I        ( GBDIV ,
     I         'GBDIV', 'divergence @ t      ','1/s' ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
*" << GAVRDV : 渦度発散 (GA) >>
*
      CALL GDWRIT
     I        ( GAVOR ,
     I         'GAVOR', 'volticity @ t+dt  ','1/s' ,
     I          ITA   , IDATEA, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      CALL GDWRIT
     I        ( GADIV ,
     I         'GADIV', 'divergence @ t+dt  ','1/s' ,
     I          ITA   , IDATEA, ISTEP , ITDUR ,
     I          JFLRST, IOMODE, NOEND , 'ALEV', HDFMT  )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE WRRSTG        
     I         ( GBTG  ,
     I           ITB   , IDATEB, ISTEP  )
*
*   [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              )

*
*   [INPUT]
      ReaL*8       GBTG  ( IDIM, JDIM )        
*
      INTEGER    ISTEP                 
      INTEGER    ITB                   
      INTEGER    IDATEB( 6 )           
*"       : 時刻等
*
*   [INTERNAL PARAM]
      CHARACTER  FILE   *(NFILN)       
      CHARACTER  DFMT   *(NCC)         
      DATA       FILE   / ' ' /
      DATA       DFMT   / 'UR8' /
      INTEGER    JFILED
      INTEGER    IOMODE
      INTEGER    NOEND
      INTEGER    ITDUR
      DATA       JFILED / 43 /
      DATA       IOMODE / 0  /
      DATA       NOEND  / 0  /
      DATA       ITDUR  / 1  /
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE       IOMODE, OFIRST
*
      NAMELIST  /NMRSTG/ FILE, DFMT
*
*    [INTERNAL WORK]
      INTEGER    IFPAR, JFPAR, JFLRSG, IERR
* 
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMRSTG, END=1090 )
 1090    WRITE  ( JFPAR, NMRSTG )         
*
         CALL IFLOPN
     O         ( JFLRSG, IERR  ,
     I           FILE  , JFILED, 'WRITE', 'UNFORMATTED' )
      ENDIF
*
      CALL GDWRIT               
     I        ( GBTG  ,
     I         'GBTG' , 'ground temperature  ','K'   ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRSG, IOMODE, NOEND , 'ASFC', DFMT  )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE WRRSTH        
     I         ( GBHI  ,
     I           ITB   , IDATEB, ISTEP  )
*
*"                  作成    2000/09/06 石渡
*   [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              )

*
*   [INPUT]
      ReaL*8       GBHI  ( IDIM, JDIM )        
*
      INTEGER    ISTEP                 
      INTEGER    ITB                   
      INTEGER    IDATEB( 6 )           
*"       : 時刻等
*
*   [INTERNAL PARAM]
      CHARACTER  FILE   *(NFILN)       
      CHARACTER  DFMT   *(NCC)         
      DATA       FILE   / ' ' /
      DATA       DFMT   / 'UR8' /
      INTEGER    JFILED
      INTEGER    IOMODE
      INTEGER    NOEND
      INTEGER    ITDUR
      DATA       JFILED / 44 /
      DATA       IOMODE / 0  /
      DATA       NOEND  / 0  /
      DATA       ITDUR  / 1  /
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE       IOMODE, OFIRST
*
      NAMELIST  /NMRSTH/ FILE, DFMT
*
*    [INTERNAL WORK]
      INTEGER    IFPAR, JFPAR, JFLRSG, IERR
* 
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMRSTH, END=1090 )
 1090    WRITE  ( JFPAR, NMRSTH )         
*
         CALL IFLOPN
     O         ( JFLRSG, IERR  ,
     I           FILE  , JFILED, 'WRITE', 'UNFORMATTED' )
      ENDIF
*
      CALL GDWRIT               
     I        ( GBHI  ,
     I         'GBHI' , 'ice depth   ','m'   ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRSG, IOMODE, NOEND , 'ASFC', DFMT  )
*
      RETURN
      END
***********************************************************************
      SUBROUTINE WRRSTO        
     I         ( GBTO  ,
     I           ITB   , IDATEB, ISTEP  )
*
*"                  作成    2000/09/10 石渡
*   [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              )

*
*   [INPUT]
      ReaL*8       GBTO  ( IDIM, JDIM )        
*
      INTEGER    ISTEP                 
      INTEGER    ITB                   
      INTEGER    IDATEB( 6 )           
*"       : 時刻等
*
*   [INTERNAL PARAM]
      CHARACTER  FILE   *(NFILN)       
      CHARACTER  DFMT   *(NCC)         
      DATA       FILE   / ' ' /
      DATA       DFMT   / 'UR8' /
      INTEGER    JFILED
      INTEGER    IOMODE
      INTEGER    NOEND
      INTEGER    ITDUR
      DATA       JFILED / 46 /
      DATA       IOMODE / 0  /
      DATA       NOEND  / 0  /
      DATA       ITDUR  / 1  /
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE       IOMODE, OFIRST
*
      NAMELIST  /NMRSTO/ FILE, DFMT
*
*    [INTERNAL WORK]
      INTEGER    IFPAR, JFPAR, JFLRSG, IERR
* 
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMRSTO, END=1090 )
 1090    WRITE  ( JFPAR, NMRSTO )         
*
         CALL IFLOPN
     O         ( JFLRSG, IERR  ,
     I           FILE  , JFILED, 'WRITE', 'UNFORMATTED' )
      ENDIF
*
      CALL GDWRIT               
     I        ( GBTO  ,
     I         'GBTO' , 'mixed layer temp','K'   ,
     I          ITB   , IDATEB, ISTEP , ITDUR ,
     I          JFLRSG, IOMODE, NOEND , 'ASFC', DFMT  )
*
      RETURN
      END
