* PACKAGE IDIAG 
*
*"履歴   90/05/19 沼口  敦
*"      90/11/03 沼口  敦
*
*
*******************************************************************
      SUBROUTINE DIAGP   
     I         ( GDATA , HTTL  , KDIMD , HFMT  )
*
*   [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                       )

*
*   [INPUT] 
      ReaL*8       GDATA ( * )                 
      CHARACTER  HTTL  *(*)
      INTEGER    KDIMD
      CHARACTER  HFMT  *(*)
*
*   [INTERNAL WORK] 
      LOGICAL    ODIAG
      INTEGER    JFLDIA, NCOLS, ISTR, IEND, IINT
*
*
*"         < 1. 表示する点? >
*
      CALL QDIAGP
     O     ( ODIAG , JFLDIA, NCOLS,
     O       ISTR  , IEND  , IINT ,
     I       KDIMD                  )
*
      IF ( .NOT. ODIAG )       RETURN
*
*"         < 2. 最大最小表示 >
*
      CALL MAXPRN
     I       ( GDATA , HTTL  , KDIMD , JFLDIA )
*
*"         < 3. 点表示 >
*
      CALL PRINTD
     I       ( JFLDIA, HFMT   , GDATA ,
     I         ISTR  , IEND   , IINT  , 1    ,
     I         IDIM*JDIM*KDIMD, 1     , NCOLS  )
*
      RETURN
      END
************************************************************************
      SUBROUTINE QDIAGP       
     O         ( ODIAG , JFLDIA, NCOLX ,
     O           ISTR  , IEND  , IINT  ,
     I           KDIMD                   )
*
*   [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] 
      LOGICAL    ODIAG
      INTEGER    JFLDIA
      INTEGER    NCOLX
      INTEGER    ISTR
      INTEGER    IEND
      INTEGER    IINT
*
*   [INPUT] 
      INTEGER    KDIMD
*
*   [INTERNAL PARM] 
      CHARACTER  FILE *38
      CHARACTER  UNIT  *4                    
      INTEGER    INTDIA                      
      INTEGER    IDIAG
      INTEGER    JDIAG
      INTEGER    KDIAG
      INTEGER    NCOLS
      DATA       FILE   / 'CON' /
      DATA       UNIT   / 'DAY' /
      DATA       INTDIA /  10 /
      DATA       IDIAG  /  1  /
      DATA       JDIAG  /  1  /
      DATA       KDIAG  / -1  /
      DATA       NCOLS  / 132 /
*
      NAMELIST  /NMDIAG/
     &             FILE, UNIT  , INTDIA, IDIAG, JDIAG, KDIAG, NCOLS
*
      INTEGER    IWDFL
      INTEGER    ITOLD
      DATA       IWDFL  / 21 /
      DATA       ITOLD  / -1 /
*
      LOGICAL    OFIRST
      DATA       OFIRST / .TRUE. /
      SAVE
*
*   [INTERNAL WORK] 
      LOGICAL    OADVNC
      INTEGER    IDATEA( 6 )
      INTEGER    IDATEB( 6 )
      INTEGER    IODIAG
      INTEGER    IFPAR, JFPAR
      INTEGER    JFILEZ, IERR
      INTEGER    ITA, ITB, ISTEP, KDIA0
      ReaL*8       DELT
*
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         CALL   REWNML ( IFPAR , JFPAR )
         READ   ( IFPAR, NMDIAG,  END=190 )
 190     WRITE  ( JFPAR, NMDIAG )
*
         CALL ACTIME
     I         ( INTDIA, UNIT   , '#'    ,
     O           IODIAG                   )
*
         CALL IFLOPN
     O         ( JFILEZ, IERR  ,
     I           FILE  , IWDFL , 'WRITE', 'FORMATTED'  )
      ENDIF
*
*"         < 1. 出力するか否か >
*
      CALL INQTIM
     O         ( ITA   , ITB   , IDATEA, IDATEB,
     O           ISTEP , DELT  , OADVNC          )
*
      IF ( ( .NOT. OADVNC ).OR.( IODIAG .LE. 0 ) ) THEN
         ODIAG = .FALSE.
      ELSE IF ( ITA/IODIAG .GT. ITB/IODIAG ) THEN
         ODIAG = .TRUE.
      ELSE
         ODIAG = .FALSE.
      ENDIF
*
      JFLDIA = JFILEZ
      NCOLX  = NCOLS
*
*"         < 2. 出力する点 >
*
      IF ( KDIAG .GT. 0 ) THEN
         KDIA0 = MIN( KDIAG, KDIMD )
      ELSE
         KDIA0 = KDIAG
      ENDIF
*
      IF      ( IDIAG .LE. 0 ) THEN
         ISTR  = 1 + IDIM*(ABS(JDIAG)-1) + IDIM*JDIM*(ABS(KDIA0)-1)
         IEND  = ISTR  + IDIM-1
         IINT  = MAX( -IDIAG, 1 )
      ELSE IF ( JDIAG .LE. 0 ) THEN
         ISTR  = IDIAG + IDIM*JDIM*(ABS(KDIA0)-1)
         IEND  = ISTR  + IDIM*JDIM-1
         IINT  = MAX( -JDIAG, 1 )*IDIM
      ELSE IF ( KDIA0 .LE. 0 ) THEN
         ISTR  = IDIAG + IDIM*(JDIAG-1)
         IEND  = IDIM*JDIM*KDIMD
         IINT  = MAX( -KDIA0, 1 )*IDIM*JDIM
      ELSE
         ISTR  = IDIAG + IDIM*(JDIAG-1) + IDIM*JDIM*(KDIA0-1)
         IEND  = ISTR
         IINT  = IDIM*JDIM*KDIMD
      ENDIF
      IF ( IEND  .GT. IDIM*JDIM*KDIMD ) IEND = IDIM*JDIM*KDIMD
*
*"         < 3. 時刻を印刷 >
*
      IF ( ITA .NE. ITOLD ) THEN
         ITOLD = ITA
*
         IF ( ODIAG ) THEN
            WRITE ( JFLDIA, * ) '==========[ TIME = ', ITA,
     &                          ']=========', IDIAG, JDIAG, KDIAG
         ENDIF
      ENDIF
*
      RETURN
      END
*******************************************************************
      SUBROUTINE MAXPRN      
     I         ( GDATA , HTTL  , KDIMD , JFLOUT )
*
*   [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       GDATA ( * )
      CHARACTER  HTTL  *(*)
      INTEGER    KDIMD
      INTEGER    JFLOUT
*
*   [INTERNAL WORK] 
      CHARACTER  HTITLE *(NCC)
      ReaL*8       VMIN, VMAX
      INTEGER    IPMIN, JPMIN, KPMIN
      INTEGER    IPMAX, JPMAX, KPMAX
*
*"         < 1. 最大最小算出 >
*
      CALL MAXCAL
     O     ( VMAX  , IPMAX , JPMAX , KPMAX ,
     O       VMIN  , IPMIN , JPMIN , KPMIN ,
     I       GDATA , KDIMD                   )
*
*"         < 2. 最大最小印刷 >
*
      HTITLE = HTTL
      WRITE ( JFLOUT, 6010 ) HTITLE, VMAX, IPMAX, JPMAX, KPMAX
      WRITE ( JFLOUT, 6020 )         VMIN, IPMIN, JPMIN, KPMIN
 6010 FORMAT ( ' ***[',A16,']*** MAX= ',D12.4,' AT ',I4,',',I4,',',I4 )
 6020 FORMAT ( '     ',16X,'     MIN= ',D12.4,' AT ',I4,',',I4,',',I4 )
*
      RETURN
      END
*******************************************************************
      SUBROUTINE MAXCAL          
     O         ( VMAX  , IPMAX , JPMAX , KPMAX ,
     O           VMIN  , IPMIN , JPMIN , KPMIN ,
     I           GDATA , KDIMD                   )
*
*   [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       VMAX
      ReaL*8       VMIN
      INTEGER    IPMAX
      INTEGER    JPMAX
      INTEGER    KPMAX
      INTEGER    IPMIN
      INTEGER    JPMIN
      INTEGER    KPMIN
*
*   [INPUT] 
      ReaL*8       GDATA ( IDIM, JDIM, KDIMD )
      INTEGER    KDIMD
*
*   [INTERNAL WORK] 
      INTEGER    I, J, K
*
      VMAX  = GDATA ( 1,1,1 )
      VMIN  = VMAX
      IPMAX = 1
      JPMAX = 1
      KPMAX = 1
      IPMIN = 1
      JPMIN = 1
      KPMIN = 1
*
      DO 1100 K = 1, KDIMD
         DO 1110 J = 1, JMAX
            DO 1120 I = 1, IMAX
               IF      ( GDATA(I,J,K) .GT. VMAX ) THEN
                  VMAX = GDATA(I,J,K)
                  IPMAX = I
                  JPMAX = J
                  KPMAX = K
               ELSE IF ( GDATA(I,J,K) .LT. VMIN ) THEN
                  VMIN = GDATA(I,J,K)
                  IPMIN = I
                  JPMIN = J
                  KPMIN = K
               ENDIF
 1120       CONTINUE
 1110    CONTINUE
 1100 CONTINUE
*
      RETURN
      END
