* PACKAGE IHIST !"  ヒストリーパッケージ
*
*   [SRC] $CCSR/model/agcm5/src/io/ihist.F
*   [DOC] $CCSR/model/agcm5/doc/io.tex
*   [VER] 92/06/18(numaguti)
*   [HIS] 
***********************************************************************
      SUBROUTINE HISTOU   !" 時間平均ヒストリー・ファイル出力
*
*     内部にデータを格納し, 平均をとって出力する.
*
*
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZIDIM)                      !" 出力の数
      INCLUDE   (ZHDIM)                      !" 文字数
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zidim.F"                    !" 出力の数
#include        "zhdim.F"                    !" 文字数
#endif
*
*    [ENTRY INPUT]
      REAL       GDATA  ( * )                 !" データ
      CHARACTER  HITEM *(*)                   !" 変数名
      CHARACTER  HTITL *(*)                   !" タイトル
      CHARACTER  HUNIT *(*)                   !" 単位
      CHARACTER  HCORD *(*)                   !" 座標系
      REAL       DMINX                        !" データレンジ
      REAL       DMAXX                        !" データレンジ
      REAL       DIVSX                        !" データ目盛
      REAL       DIVLX                        !" データ目盛
      INTEGER    ISTYPX                       !" スケールタイプ
*
      CHARACTER  FILEM       *(*)             !" ファイル名
      CHARACTER  TUNITM      *(*)             !" 時間単位
      INTEGER    INTOUM                       !" 出力間隔
      INTEGER    INTSMM                       !" 積算間隔
      CHARACTER  AVRTYM      *(*)             !" 積算間隔
      CHARACTER  DFORMM      *(*)             !" 出力フォーマット
*
*   [INTERNAL SAVE] 
      REAL       GOUT   ( NHDIM )            !" 積算領域
      INTEGER    ITOUT  ( NHIST )            !" 経過時間
      INTEGER    ITSUM  ( NHIST )            !" 積算時間
      INTEGER    INNUM  ( NHIST )            !" 積算回数
      INTEGER    ITPRV  ( NHIST )            !" 直前の足し込みの時刻
      INTEGER    ITEND  ( NHIST )            !" ENDFILE経過時間
*
      CHARACTER  HHEADH ( NDC,NHIST )*(NCC)  !" ヘッダー
      CHARACTER  HITEMH ( NHIST )*(NCC)      !" 変数名
      CHARACTER  HCORDH ( NHIST )*(NCC)      !" 座標系
      CHARACTER  HTYPEH ( NHIST )*(NCC)      !" 平均種類
      CHARACTER  HUTDSH ( NHIST )*(NCC)      !" 表示時間単位
      INTEGER    INDEXH ( NHIST )            !" 開始添字
      INTEGER    ISIZEH ( NHIST )            !" 大きさ
      INTEGER    JFILEH ( NHIST )            !" ファイル番号
      INTEGER    INTENH ( NHIST )            !" ENDFILEの間隔
      INTEGER    INTOUH ( NHIST )            !" 出力間隔
      INTEGER    INTSMH ( NHIST )            !" 積算時間
      INTEGER    IMEANH ( NHIST )            !" 平均か積算か
      INTEGER    IHMAX                       !" 登録済みの数
      DATA       IHMAX  / 0 /
*
*    [INTERNAL PARAM]
      INTEGER    IWFL, ISTDIO
      DATA       IWFL   / 50 /                !" 装置番号
      DATA       ISTDIO / 6  /                !" 書式付出力装置番号
      INTEGER    IOMODE                      !" 出力モード
      DATA       IOMODE / 0 /
*
      INTEGER    IFOUT ( 100 )
      DATA       IFOUT / 100*0 /
      INTEGER    IFNUM ( 100 )
      DATA       IFNUM / 100*1 /
*
      INTEGER    ITOLD
      DATA       ITOLD  / 0 /
      LOGICAL    OFIRST, OADDED
      DATA       OFIRST, OADDED / .TRUE., .FALSE. /
      SAVE
*
*    [INTERNAL WORK]
      INTEGER    ITA                         !" 通し時間(秒)
      INTEGER    ISTEP                       !" 通しステップ数
      INTEGER    IDATEA ( 6 )                !" 時刻年月日時分秒
      INTEGER    IDATEB ( 6 )
      LOGICAL    OADVNC
*
      CHARACTER  HMSG * 100
      CHARACTER  HHEAD  ( NDC )*(NCC)         !" ヘッダー
*
      CHARACTER  ITEM  *(NCC)                 !" 変数名
      CHARACTER  FILE  ( 2 ) *(NFILN)         !" ファイル名
      CHARACTER  TUNIT ( 2 ) *(NCC)           !" 時間単位
      INTEGER    INTOUT( 2 )                  !" 出力間隔
      INTEGER    INTSUM( 2 )                  !" 積算間隔
      CHARACTER  AVRTYP( 2 ) *(NCC)           !" 積算間隔
      CHARACTER  DFORM ( 2 ) *(NCC)           !" 出力フォーマット
      INTEGER    INTEND( 2 )                  !" ENDFILE処理間隔
      REAL       VMISS
      REAL       DMIN
      REAL       DMAX
      REAL       DIVS
      REAL       DIVL
      INTEGER    ISTYP
*
      NAMELIST  /NMHIST/ ITEM  ,
     O                   FILE  , TUNIT , INTOUT, INTSUM, AVRTYP,
     O                   DFORM , INTEND, VMISS ,
     &                   DMIN  , DMAX  , DIVS  , DIVL  , ISTYP
*
      INTEGER    ITB, IDELTH, IDELTI
      INTEGER    IH, ID, IND, IW, IMULT
      INTEGER    IFPAR, JFPAR, JFILE, ISIZE, IERR
      INTEGER    INTOUS, INTSUS, INTENS
      REAL       DELT
*
      CALL INQTIM
     O      ( ITA   , ITB   , IDATEA, IDATEB,
     O        ISTEP , DELT  , OADVNC          )
*
      IDELTH = ITA - ITOLD
      ITOLD  = ITA
*
      DO 4500 IH = 1, IHMAX
*
         ITOUT ( IH ) = ITOUT ( IH ) + IDELTH
*
         IF (      ( ITOUT( IH ) .GE. INTOUH( IH ) )
     &        .AND.( INNUM( IH ) .GT. 0 )             ) THEN
*
*"         < 1. 時間平均値の計算 >
*
            IF ( IMEANH( IH ) .GT. 0 ) THEN
               DO 1100 ID = INDEXH( IH ), INDEXH( IH )+ISIZEH( IH )-1
                  GOUT ( ID ) = GOUT ( ID ) / Real( ITSUM ( IH ) )
 1100          CONTINUE
            ENDIF
*
*"         < 2. ファイル出力 >
*
            CALL GHCOPY ( HHEADH(1,IH), HHEAD )
*
            IF ( INNUM( IH ) .GE. 2 ) THEN
               CALL HHEDIT
     I            ( HHEAD ,
     I              ITSUM (IH), IMEANH(IH), HUTDSH(IH)  )
            ENDIF
*
            IF ( JFILEH(IH) .NE. ISTDIO ) THEN
*
               CALL GHCGET ( HHEAD, 'DFMT', DFORM(1) )
               CALL GZDBWX
     I                 ( HHEAD , GOUT( INDEXH(IH) ),
     I                   ITA   , IDATEA, ISTEP , ITSUM(IH),
     I                   JFILEH(IH)    , IOMODE, 0   , DFORM(1)  )
*
               IF ( (1 .LE. JFILEH(IH)).AND.(JFILEH(IH) .LT. 100) ) THEN
                  IFOUT( JFILEH(IH) ) = IFOUT( JFILEH(IH) ) + 1
               ENDIF
            ELSE
               CALL HMONIT
     I            ( HHEAD , GOUT( INDEXH(IH) )    ,
     I              ITA   , IDATEA, ISTEP , ITSUM(IH)    )
            ENDIF
*
*"         < 3. 出力後時間平均作業領域リセット >
*
            CALL RESET( GOUT( INDEXH(IH) ),  ISIZEH(IH) )
            ITSUM ( IH ) = 0
            INNUM ( IH ) = 0
            IF ( INTOUH( IH ) .GT. 0 ) THEN
               ITOUT( IH ) = MOD( ITOUT( IH ), INTOUH( IH ) )
            ELSE
               ITOUT( IH ) = 0
            ENDIF
*
         ELSE IF ( ITSUM( IH ) .GE. INTSMH( IH ) ) THEN
*
*"         < 4. 時間平均を出力せずクリアー >
*
            CALL RESET( GOUT( INDEXH(IH) ),  ISIZEH(IH) )
            ITSUM ( IH ) = 0
            INNUM ( IH ) = 0
*
         ENDIF
*
 4500 CONTINUE
*
*"         < 4.1 ENDFILE 処理 >
*
      DO 4600 IH = 1, IHMAX
*
         ITEND( IH ) = ITEND( IH ) + IDELTH
         IF (  ( INTENH( IH ) .GT. 0 ) .AND.
     &         ( ITEND( IH ) .GE. INTENH( IH ) )  ) THEN
*
            IF ( ( JFILEH(IH) .NE. ISTDIO ) .AND.
     &           ( (1 .LE. JFILEH(IH)).AND.(JFILEH(IH) .LT. 100) ) )
     &           THEN
*
               IF ( IFOUT( JFILEH(IH) ) .GT. 0 ) THEN
                  ENDFILE( JFILEH(IH) )
                  WRITE (6,4660) JFILEH(IH), IFNUM( JFILEH(IH) )
 4660             FORMAT (' === END OF OUTPUT FILE FT',I2.2,'F',I3.3 )
                  IFOUT( JFILEH(IH) ) = 0
                  IFNUM( JFILEH(IH) ) = IFNUM( JFILEH(IH) ) + 1
               ENDIF
*
            ENDIF
*
            ITEND( IH ) = MOD( ITEND( IH ), INTENH( IH ) )
*
         ENDIF
*
 4600 CONTINUE
*
      RETURN
*======================================================================
      ENTRY      HISTIN      !"  時間平均ヒストリーの足し込み 
     I         ( GDATA ,
     C           HITEM  )
*
*"         < 5. HITEM を探し, そこに足し込む >
*
      CALL INQTIM
     O         ( ITA   , ITB   , IDATEA, IDATEB,
     O           ISTEP , DELT  , OADVNC          )
*
      DO 5100 IH = 1, IHMAX
         IF ( HITEM .EQ. HITEMH( IH ) ) THEN
*
            IDELTI      = ITA - ITPRV( IH )
            ITPRV( IH ) = ITA
*
            IF ( IMEANH( IH ) .GT. 0 ) THEN
               IMULT = IDELTI
            ELSE
               IMULT = 1
            ENDIF
*
            CALL HSTADD
     M         ( GOUT( INDEXH( IH ) )  ,
     I           GDATA     , IMULT     ,
     I           HCORDH(IH), HTYPEH(IH) )
*
            ITSUM ( IH ) = ITSUM ( IH ) + IDELTI
            INNUM ( IH ) = INNUM ( IH ) + 1
*
         ENDIF
 5100 CONTINUE
*
      RETURN
*======================================================================
      ENTRY      HISTRG      !"  時間平均ヒストリーの登録 
     I         ( HITEM , HTITL , HUNIT , HCORD ,
     I           DMINX , DMAXX , DIVSX , DIVLX , ISTYPX,
     I           FILEM , TUNITM, INTOUM, INTSMM, AVRTYM, DFORMM )
*
      CALL INQTIM
     O         ( ITA   , ITB   , IDATEA, IDATEB,
     O           ISTEP , DELT  , OADVNC          )
*
      IF ( OFIRST ) THEN
         OFIRST = .FALSE.
         ITOLD  = ITB
         DO 6000 IH = 1, NHIST
            ITOUT ( IH ) = 0
            ITEND ( IH ) = 0
 6000    CONTINUE
      ENDIF
*
*"         < 6. すでにあるか探す >
*
      IND = 1
      DO 6100 IH = 1, IHMAX
         IF ( HITEM .EQ. HITEMH( IH ) ) THEN
             HMSG = 'HISTORY '//HITEM//' IS ALREADY REGISTERED'
             CALL MSGDMP( 'W', 'HISTRG', HMSG )
             RETURN
         ENDIF
         IND = IND + ISIZEH( IH )
 6100 CONTINUE
*
*"         < 7. パラメータ読み込み >
*
      WRITE ( 6,* ) ' HISTORY CONTROL ', HITEM, ' :'
      CALL   REWNML ( IFPAR , JFPAR )
*
*..........loop
 7100 CONTINUE
         DMIN  = DMINX
         DMAX  = DMAXX
         DIVS  = DIVSX
         DIVL  = DIVLX
         ISTYP = ISTYPX
         CALL GZDBGT( 'MISS', VMISS )
         CALL HQDEFP
     O     ( FILE  , TUNIT , INTOUT, INTSUM, AVRTYP, DFORM , INTEND ,
     I       FILEM , TUNITM, INTOUM, INTSMM, AVRTYM, DFORMM          )
*
         ITEM = ' '
*
         READ   ( IFPAR, NMHIST, END=7190 )
*"                                         > END >-----> @@)
         IF ( ITEM .NE. HITEM ) THEN
      GOTO 7100
*..........loop
         ENDIF
*
 7190 CONTINUE
      WRITE  ( JFPAR, NMHIST )
*
      DO 9000 IW = 1, 2
*
         IF    ( FILE(IW) .NE. ' ' ) THEN
*
*"         < 8. ファイルのオープン >
*
            CALL IFLOPN
     O         ( JFILE , IERR  ,
     I           FILE(IW)      , IWFL  , 'WRITE', 'UNFORMATTED' )
*
            IF ( IERR .NE. 0 ) THEN
               HMSG = 'FILE OPEN ERROR :'//FILE(IW)
               CALL MSGDMP( 'E', 'HISTRG', HMSG )
               RETURN
            ENDIF
*
*"         < 9. 登録 >
*
            IF ( IHMAX .GE. NHIST ) THEN
               HMSG = 'NUMBER OF HISTRY IS OVER LIMIT.'
               CALL MSGDMP( 'E', 'HISTRG', HMSG )
               RETURN
            ENDIF
*
            CALL HSTHED
     O         ( HHEAD , ISIZE ,
     I           HCORD , AVRTYP(IW)    ,
     I           HITEM , HTITL , HUNIT ,
     I           DFORM(IW)     , VMISS ,
     I           DMIN  , DMAX  , DIVS  , DIVL  , ISTYP  )
*
            IF ( IND+ISIZE .GT. NHDIM+1 ) THEN
               HMSG  = 'HISTRY AREA IS FULL.'
               CALL MSGDMP( 'W', 'HISTRG', HMSG )
               IND = IND + ISIZE
               GOTO 9800
            ENDIF
*
            IHMAX = IHMAX + 1
*
            CALL ACTIME ( INTOUT(IW)     , TUNIT(IW), '#'   ,
     O                    INTOUS                              )
            CALL ACTIME ( ABS(INTSUM(IW)), TUNIT(IW), '#'   ,
     O                    INTSUS                              )
            CALL ACTIME ( INTEND(IW)     , TUNIT(IW), '#'   ,
     O                    INTENS                              )
*
            CALL GHCOPY ( HHEAD, HHEADH( 1,IHMAX ) )
            HITEMH( IHMAX ) = HITEM
            HUTDSH( IHMAX ) = TUNIT (IW)
            HCORDH( IHMAX ) = HCORD
            HTYPEH( IHMAX ) = AVRTYP(IW)
            INDEXH( IHMAX ) = IND
            ISIZEH( IHMAX ) = ISIZE
            JFILEH( IHMAX ) = JFILE
            INTENH( IHMAX ) = INTENS
            INTOUH( IHMAX ) = INTOUS
            INTSMH( IHMAX ) = INTSUS
            IF ( INTSUM(IW) .LT. 0 ) THEN
               IMEANH( IHMAX ) = 0
            ELSE
               IMEANH( IHMAX ) = 1
            ENDIF
*
            CALL RESET( GOUT( INDEXH(IHMAX) ), ISIZEH(IHMAX) )
            ITSUM ( IHMAX ) = 0
            INNUM ( IHMAX ) = 0
            ITPRV ( IHMAX ) = ITB
*
            IND = IND + ISIZE
            OADDED = .TRUE.
         ENDIF
 9000 CONTINUE
*
      RETURN
*======================================================================
      ENTRY      HISTRP      !"  時間平均ヒストリー登録状況表示 
*
 9800 CONTINUE
*
      IF ( OADDED ) THEN
         OADDED = .FALSE.
*
         WRITE ( 6,* ) ' ####### HISTORY USAGE REPORT ########'
*
         WRITE ( 6,9600 )     'ITEM',     'TYPE',     'FILE',
     &                        'SIZE',     'INDEX',
     &                        'INTOUT',   'INTSUM'
         DO 9500 IH = 1, IHMAX
            WRITE ( 6, 9610 ) HITEMH(IH), HTYPEH(IH), JFILEH(IH),
     &                        ISIZEH(IH), INDEXH(IH),
     &                        INTOUH(IH), INTSMH(IH)
 9500    CONTINUE
         WRITE ( 6,* )  '    TOTAL NUMBER = ', IHMAX,
     &                  '    TOTAL SIZE   = ', IND-1
      ENDIF
*
 9600 FORMAT(' ',A4,14X, A4, 2X,A4, 5X,A4, 6X,A5, 5X,A6, 5X,A6)
 9610 FORMAT(' ',A16,2X, A4, 2X,I4, 2X,I7, 2X,I9, 2X,I9, 2X,I9)
*
      IF ( IND .GT. NHDIM+1 ) THEN
         CALL MSGDMP( 'E', 'HISTRP', ' HISTORY AREA IS FULL' )
      ENDIF
*
      RETURN
      END
