*"表題 時系列の作成 GTOOL3(GPTSEQ)
*
*"履歴 90/09/14 沼口  敦
*"     92/06/14 沼口  敦
*"     99/12/16 竹広真一 無次元時間 (NDT) に対応
*
*********************************************************************
*"         << (時)系列の作成 X-T >>
*********************************************************************
      SUBROUTINE  GPTSEQ
     I          ( HHEAD , GDATA ,
     I            HEDIT , HETTL ,
     O            HHEADT, GDATAT )
*
      CHARACTER  HHEAD  ( * )*(*)        !" ヘッダー(入力)
      REAL       GDATA  ( * )            !" データ(入力)
      CHARACTER  HEDIT       *(*)        !" 編集略記号
      CHARACTER  HETTL       *(*)        !" 編集タイトル
      CHARACTER  HHEADT ( * )*(*)        !" ヘッダー(出力)
      REAL       GDATAT ( * )            !" データ(出力)
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HAITM         *(NCC)
      CHARACTER  HHEADA ( NDC )*(NCC)
      CHARACTER  HUTIM         *(NCC)
      CHARACTER  HTIME         *(NCC)
      CHARACTER  HAXIS         *(NCC)
      CHARACTER  HEDITD        *(NCC)
      CHARACTER  HETTLD        *(NCC)
      CHARACTER  HRSMRK        *(NCC)
      CHARACTER  HITEM         *(NCC)
      CHARACTER  HNUM          *(NCC)
      CHARACTER  HAXIS0        *(NCC)
      CHARACTER  HITMSQ        *(NCC)
      CHARACTER  HAXNM         *(NCC)
      REAL       AXLOC( 1 )
      REAL       AXWGT( 1 )
*
      DATA       HRSMRK / '%%RESET:GPTSEQ%%' /
      DATA       AXLOC  / 0. /
      DATA       AXWGT  / 1. /
      DATA       IANUM  / 0 /
      SAVE       HRSMRK, AXLOC, AXWGT, IANUM
*
*"         < 1. 初期設定 >
*
      CALL GHCGET ( HHEADT, 'ITEM', HITEM )
      IF ( HITEM .EQ. HRSMRK ) THEN
*
         IANUM = IANUM + 1
         WRITE ( HNUM, '(I2.2)' ) IANUM
         CALL GTCGET ( 'AXISSEQ', HAXIS0 )
         NH    = LENC( HAXIS0 )
         HAXIS = HAXIS0(1:NH)//HNUM
         CALL GTCGET ( 'ITEMSEQ', HITMSQ )
*
         IF ( HEDIT .EQ. ' ' ) THEN
            HEDITD = 'TSEQ'
            NH     = LENC( HITMSQ )
            HETTLD = HITMSQ(1:NH)//'sequence'
         ELSE
            HEDITD = HEDIT
            HETTLD = HETTL
         ENDIF
*
         CALL GHCGET( HHEAD , 'AITM1', HAITM )
         IF  ( HAITM .EQ. ' ' ) THEN
            CALL GPXCMI
     I         ( HHEAD , HAXIS , 1     , 0     ,
     I           HEDITD, HETTLD,
     O           HHEADT, GDATAT  )
         ELSE
            CALL GHCGET( HHEAD , 'AITM2', HAITM )
            IF  ( HAITM .EQ. ' ' ) THEN
               CALL GPYCMI
     I         ( HHEAD , HAXIS , 1     , 0     ,
     I           HEDITD, HETTLD,
     O           HHEADT, GDATAT  )
            ELSE
               CALL GPZCMI
     I         ( HHEAD , HAXIS , 1     , 0     ,
     I           HEDITD, HETTLD,
     O           HHEADT, GDATAT  )
            ENDIF
         ENDIF
*
         CALL    GHPGET ( HHEAD , 'MISS', VMISS )
         CALL    GTCGET ( 'UTIM'  , HUTIM )
         CALL    GTPGET ( 'STYTSQ', ISTSQ )
*
         IF ( HITMSQ .EQ. 'TIME' ) THEN
            CALL GUQTIM( HHEAD , AXLOC(1), HUTIM )   !" 追加 99/12/15 竹広
            HAXNM = HUTIM
         ELSE
            CALL GHCGET( HHEAD, 'COPTN', HAXNM )
         ENDIF
*
         CALL    GHPACA
     O         ( HHEADA,
     I           'IAXLOC', HAXIS,
     I           HAXNM   , HAXNM,
     I           0     ,
     I           'UR4' , VMISS ,
     I           VMISS , VMISS , VMISS , VMISS , ISTSQ )
*
         CALL    GUSIAX
     I         ( HHEADA , AXLOC , AXWGT ,
     I           IANUM                    )
      ENDIF
*
*"         < 2. 時系列のセット >
*
      CALL GUQSIZ
     I         ( HHEADT,
     O           IXSTR , IXEND , IXDIM ,
     O           IYSTR , IYEND , IYDIM ,
     O           IZSTR , IZEND , IZDIM  )
*
      CALL GHCGET( HHEAD , 'AITM1', HAITM )
      IF ( HAITM .EQ. ' ' ) THEN
         CALL GHCGET( HHEADT, 'AITM1', HAXIS )
         CALL GHPGET( HHEADT, 'AEND1', IIT   )
         CALL GHPSET( HHEADT, 'AEND1', IIT+1 )
         DO 2100 IYZ = IYDIM*IZDIM, 2, -1
            DO 2100 IX = IXDIM, 1, -1
               GDATAT( (IYZ-1)*(IXDIM+1)+IX ) 
     &       = GDATAT( (IYZ-1)*IXDIM+IX )
 2100    CONTINUE 
         CALL GPXCOM
     I           ( HHEAD , GDATA , IIT+1 ,
     M             HHEADT, GDATAT         )
      ELSE
         CALL GHCGET( HHEAD , 'AITM2', HAITM )
         IF ( HAITM .EQ. ' ' ) THEN
            CALL GHCGET( HHEADT, 'AITM2', HAXIS )
            CALL GHPGET( HHEADT, 'AEND2', IIT   )
            CALL GHPSET( HHEADT, 'AEND2', IIT+1 )
            DO 2200 IZ = IZDIM, 2, -1
               DO 2200 IXY = IXDIM*IYDIM, 1, -1
                  GDATAT( (IZ-1)*IXDIM*(IYDIM+1)+IXY ) 
     &          = GDATAT( (IZ-1)*IXDIM*IYDIM+IXY )
 2200       CONTINUE 
            CALL GPYCOM
     I           ( HHEAD , GDATA , IIT+1 ,
     M             HHEADT, GDATAT         )
         ELSE
            CALL GHCGET( HHEADT, 'AITM3', HAXIS )
            CALL GHPGET( HHEADT, 'AEND3', IIT   )
            CALL GHPSET( HHEADT, 'AEND3', IIT+1 )
            CALL GPZCOM
     I           ( HHEAD , GDATA , IIT+1 ,
     M             HHEADT, GDATAT          )
         ENDIF
      ENDIF
*
      CALL GHPGET( HHEAD , 'TIME' , ITIME )
      CALL GHPSET( HHEADT, 'TIME' , ITIME )
      CALL GHCGET( HHEAD , 'DATE' , HTIME )
      CALL GHCSET( HHEADT, 'DATE' , HTIME )
*
*"         < 3. 軸のセット >
*
      CALL GTCSET ( 'ITEMSEQ', HITMSQ )
      IF ( HITMSQ .EQ. 'TIME' ) THEN
         CALL GUQTIM( HHEAD , AXLOC(1), HUTIM )
         CALL GHPGET( HHEAD , 'TDUR', ITDUR )
         AXWGT(1) = REAL(ITDUR)
      ELSE
         CALL GHPGET( HHEAD, HITMSQ, AXLOC(1) )
         AXWGT(1) = 1.0
      ENDIF
*
      CALL       GUAIAX
     I         ( HAXIS , AXLOC(1), AXWGT(1),
     I           IIT+1                        )
*
      RETURN
*====================================================================
*"         << 時系列のリセット >>
*====================================================================
      ENTRY       GPTSQR
     O          ( HHEADT )
*
      CALL GHCSET( HHEADT, 'ITEM' , HRSMRK )
*
      RETURN
*====================================================================
*"         << 時系列番号のセット >>
*====================================================================
      ENTRY       GPTSQN
     I          ( ISEQ   )
*
      IANUM = ISEQ - 1
*
      RETURN
      END
