* PACKAGE DDIAG  !" 力学 診断 
*
*"  [HIS]  90/05/19(numaguti)
*"         96/09/13(takepiro)  for baro
*"         96/11/15(takepiro)
*
***********************************************************************
      SUBROUTINE DDIAG      !"  診断出力 
     I         ( GDU   , GDV   , GDVOR )
*
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数, 波数
      INCLUDE   (ZCCOM)                      !" 文字列文字数
#else
#include        "zcdim.F"                    !" 格子点数, 波数
#include        "zccom.F"                    !" 文字列文字数
#endif
*
*   [INPUT]
      REAL       GDU   ( IDIM, JDIM, KMAX )  !" 西風  Ｕ
      REAL       GDV   ( IDIM, JDIM, KMAX )  !" 南風  Ｖ
      REAL       GDVOR ( IDIM, JDIM, KMAX )  !" 渦度  ζ
*
*
*   [INTERNAL WORK]
      COMMON    /COMWRK /
     &           GDKE  , GDPV , GDENS, GDAM
*
      REAL       GDKE  ( IDIM, JDIM, KMAX )  !" 運動エネルギー
      REAL       GDAM  ( IDIM, JDIM, KMAX )  !" 角運動量
      REAL       GDPV  ( IDIM, JDIM, KMAX )  !" ポテンシャル渦度
      REAL       GDENS ( IDIM, JDIM, KMAX )  !" エンストロフィー
*
      REAL       ALON  ( IDIM )              !" 経度
      REAL       DLON  ( IDIM )              !" 経度荷重
      REAL       ALAT  ( JDIM )              !" 緯度
      REAL       DLAT  ( JDIM )              !" 緯度荷重
*
      REAL       CORIOL ( IDIM, JDIM )       !" コリオリ係数 ｆ
*
      INTEGER    I,J,K
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
*
      SAVE       OFIRST, ALON, ALAT, DLON, DLAT, CORIOL
*
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
*
         CALL ACRGET
     O        ( ALON  , DLON  ,
     O         ALAT  , DLAT   )
*
         CALL DCCORL
     O        ( CORIOL, 
     I          ALAT  , DLAT )
      ENDIF
*
*"         < 1. エネルギー，エンストロフィー >
*
      DO 1100 K = 1, KMAX
         DO 1100 J = 1, JDIM
            DO 1100 I = 1, IDIM
*
               GDKE ( I,J,K )
     &                = ( GDU( I,J,K )**2 + GDV( I,J,K )**2 )/ 2.  
*
               GDAM ( I,J,K )
     &                = GDU( I,J,K ) * ER * COS( ALAT(J) )
*
               GDPV ( I,J,K )
     &                = GDVOR( I,J,K ) + CORIOL( I, J )
*
               GDENS( I,J,K )
     &                = GDVOR ( I,J,K ) **2 / 2.
*
 1100 CONTINUE
*
      CALL HISTIN ( GDKE  , 'KE'  )
      CALL HISTIN ( GDAM  , 'AM'  )
      CALL HISTIN ( GDPV  , 'PV'  )
      CALL HISTIN ( GDENS , 'ENS' )
*
      RETURN
      END
