*" PACKAGE ASTEDY !" $B@~7?2r@O%a%$%s%k!<%A%s(B
*"                  ver 1.1                   93/07/14 takepiro
***********************************************************************
      PROGRAM GSTEDY                         !" $B%a%$%s%k!<%A%s(B
*
*"    Boussinesq $BA45e%b%G%k(B
*"      $B=i4|CM$rHs@~7A6/@)NO$H$9$kBS>uJ?6Q@~7?Dj>o2r$r5a$a$k(B
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" $B3J;RE@?t(B, $BGH?t(B
      INCLUDE   (ZLDIM)                      !" $B%Q%i%a%?!<?t(B, $B78?t9TNs(B
      INCLUDE   (ZHDIM)                      !" $BJ8;zNsJ8;z?t(B
      INCLUDE   (ZCCOM)                      !" $BI8=`J*M}Dj?t(B
#else
#include        "zcdim.F"                    !" $B3J;RE@?t(B, $BGH?t(B
#include        "zldim.F"                    !" $B%Q%i%a%?!<?t(B, $B78?t9TNs(B
#include        "zhdim.F"                    !" $BJ8;zNsJ8;z?t(B
#include        "zccom.F"                    !" $BI8=`J*M}Dj?t(B
#endif
*
*   [VAR]
      REAL       GAU   ( IDIM, JDIM, 0:KDIM )  !" $B@>Iw(B   $B#u(B
      REAL       GAV   ( IDIM, JDIM, 0:KDIM )  !" $BFnIw(B   $B#v(B
      REAL       GAW   ( IDIM, JDIM, 0:KDIM )  !" $B1tD>Iw(B $B#w(B
      REAL       GAT   ( IDIM, JDIM, 0:KDIM )  !" $B29EY(B   $B#T(B
      REAL       GATOR ( IDIM, JDIM, 0:KDIM )  !" $B%H%m%$%@%k(B $B&7(B
      REAL       GAPOR ( IDIM, JDIM, 0:KDIM )  !" $B%]%m%$%@%k(B $B&5(B
*"       : $B3J;RE@%G!<%?(B(t) <DYNMCS>  $B3J;RE@%G!<%?(B(t+$B&$(Bt)
*
      INTEGER    ISTEP                 !" $BDL$7%9%F%C%W?t(B
      INTEGER    ITA                   !" $BDL$7;~4V(B(t), $BI8=`;~4VC10L(B
c$$$      INTEGER    IDATEA( 6 )           !" $B;~9oG/7nF|;~J,IC(B($B%@%_!<(B)
      REAL       DELT                  !" $B;~4V9o$_&$(Bt(DAY)
      LOGICAL    OADVNC                !" $B;~9o$,?J9T$9$k$+H]$+(B
      LOGICAL    ORSTR                 !" $B:F=PH/=PNO$9$k$+H]$+(B
*"       : $B;~9oEy(B
*
*   [ONCE]
      INTEGER    ITSTRT                !" $B7W;;3+;O;~9o(B($BI8=`;~4VC10L(B)
      INTEGER    ITEND                 !" $B7W;;=*N;;~9o(B($BI8=`;~4VC10L(B)
      INTEGER    IORSTR                !" $B=PNO4V3V!':F=PH/(B($BI8=`;~4VC10L(B)
*"       : $B<B834IM}%Q%i%a!<%?(B
*
      INTEGER    IDELT                 !" $BI8=`;~4V9o$_(B(SEC)
*"       : $B;~4V%9%F%C%W%Q%i%a!<%?(B
*
*"    COMMON /COMCON/ ( include ZCCOM )
*     REAL       ERI                        !" $BFb7B(B
*     REAL       ERO                        !" $B307B(B
*     REAL       ETA                        !" $BFb7B(B/$B307B(B
*"    COMMON /COMCON/ end
*"       : $BJ*M}%Q%i%a!<%?(B
*
      REAL       ALAT  ( JDIM )             !" $B0^EY(B
      REAL       DLAT  ( JDIM )             !" $B0^EY2Y=E(B
      REAL       ALON  ( IDIM )             !" $B7PEY(B
      REAL       DLON  ( IDIM )             !" $B7PEY2Y=E(B
      REAL       ARAD  ( 0:KDIM )           !" $B#r%l%Y%k(B($B@0?t(B)
      REAL       DRAD  ( 0:KDIM )           !" $B&$#r(B($B@0?t(B)
*"       : $B:BI8CM(B
*
*   [WORK]
      COMMON    /COMWRK/ WORK
      REAL       WORK  ( MATDMX*MATDMX  )   !" $B%o!<%/NN0h(B
*
      INTEGER    IUNIT                      !" $BI8=`=PNOAuCVHV9f(B
*
*
c$$$      DATA      IDATEA / 1992, 12, 18, 0, 0, 0/
*
#ifdef DEBUG
      external common_handler
      integer i, ieee_handler
      i = ieee_handler("set","common",common_handler )
      if( i.ne. 0 ) print *, "Could not establish fp signal handler"
#endif
*
*" << SETPUP : $B=i4|@_Dj(B >>
*
      CALL GLPGET( 'MSGUNIT', IUNIT )
      WRITE ( IUNIT, * )' LINEAR ANALYSIS GSTEDY'
     &                   //NAME
     &                   //' ver.1.1, 93/07/14'
*
      CALL CLCSTR ( 'SETUP' )
      CALL YPREP                       !" $B%7%9%F%`A0=hM}(B 
*
      CALL SETPAR                      !" $B<B83%Q%i%a!<%?(B
     O         ( ITSTRT , ITEND , IORSTR ,
     O           IDELT                      )
*
      CALL SETCOR                      !" $B:BI8CM(B
     O         ( ALON  , DLON  ,
     O           ALAT  , DLAT  ,
     O           ARAD  , DRAD   )
*
      CALL RDSTRT                      !" $B=i4|CM$NFI$_9~$_$H:F@8@.(B
     O         ( GAU   , GAV   , GAW   , GAT   , 
     O           GATOR , GAPOR ,
     O           ITA   , ISTEP ,
     C           ITSTRT, ALAT  , DLAT  , ARAD  , DRAD     )
*
      CALL ADMXMN 
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR , ITA   , 'after RDSTRT'    )
*
      CALL DHSTRG
*
      CALL SETTIM                      !" $B;~9o$r5-21(B 
     I         ( ITA-IDELT, ISTEP-1  )
      CALL HISTOU
*
      CALL SETTIM                      !" $B;~9o$r5-21(B 
     I         ( ITA   , ISTEP  )
*
      CALL CLCEND ( 'SETUP' )
*
*  << $BDj>o2r7W;;(B ($BF~NO(B:$BHs@~7A9`7W;;(B, $B=PNO(B:$B@~7?Dj>o2r(B) >>
*
      CALL LSTEDY               !" $BDj>o2r7W;;(B
     M         ( GAU   , GAV   , GAW   , GAT   , 
     M           GATOR , GAPOR , 
     I           0     , 
     C           ALON  , DLON  , ALAT  , DLAT  ,
     C           ARAD  , DRAD                    )
*
      CALL ADMXMN 
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR , ITA   , 'after LSTDY'    )
*
*"    << OUTPUT : $B%G!<%?=PNO(B >>
*
      CALL WRRSTR               !" $B%j%9%?!<%H%U%!%$%k=q$-9~$_(B
     I         ( GAU   , GAV   , GAW   , GAT   , 
     I           GATOR , GAPOR ,
     I           ITA   , ISTEP                    )
*
      CALL SETTIM                      !" $B;~9o$r5-21(B 
     I         ( ITA   , ISTEP  )
*
      CALL HISTOU
*
      CALL CLCOUT                      !" CPU$B;~4V=PNO(B
      CALL YFINE                       !" $B%7%9%F%`8e=hM}(B
*
      STOP
      END
*************************************************************************
      SUBROUTINE ADMXMN        !" debug monitor
     I         ( GDU   , GDV   , GDW   , GDT   , 
     I           GDTOR , GDPOR , IT    , HLABEL          )
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" $B3J;RE@?t(B, $BGH?t(B
#else
#include        "zcdim.F"                    !" $B3J;RE@?t(B, $BGH?t(B
#endif
*
*   [INPUT] 
      REAL       GDU   ( IDIM, JDIM, KMAX )  !" $B@>Iw(B   $B#u(B
      REAL       GDV   ( IDIM, JDIM, KMAX )  !" $BFnIw(B   $B#v(B
      REAL       GDW   ( IDIM, JDIM, KMAX )  !" $B1tD>Iw(B $B#w(B
      REAL       GDT   ( IDIM, JDIM, KMAX )  !" $B29EY(B   $B#T(B
      REAL       GDTOR ( IDIM, JDIM, KMAX )  !" $B%H%m%$%@%k(B $B&7(B
      REAL       GDPOR ( IDIM, JDIM, KMAX )  !" $B%]%m%$%@%k(B $B&5(B

*
      INTEGER    IT
      CHARACTER  HLABEL *(*)
*
      WRITE ( 6,* ) HLABEL, ' IT= ', IT
      CALL MAXMIN( GDU,   IDIM, JDIM, KMAX, IDIM, JDIM, 'U'   )
      CALL MAXMIN( GDV,   IDIM, JDIM, KMAX, IDIM, JDIM, 'V'   )
      CALL MAXMIN( GDW,   IDIM, JDIM, KMAX, IDIM, JDIM, 'W'   )
      CALL MAXMIN( GDT,   IDIM, JDIM, KMAX, IDIM, JDIM, 'T'   )
      CALL MAXMIN( GDTOR, IDIM, JDIM, KMAX, IDIM, JDIM, 'TOR' )
      CALL MAXMIN( GDPOR, IDIM, JDIM, KMAX, IDIM, JDIM, 'POR' )
*
      RETURN
      END
