*"表題 第１次元の結合 GTOOL3(GPXCOM)
*
*"履歴 90/08/19 沼口  敦
*
*
*********************************************************************
*"         << 第１次元の結合 >>
*********************************************************************
      SUBROUTINE GPXCOM
     I         ( HHEAD , GDATA , IX    ,
     M           HHEADO, GDATAO         )
*
      CHARACTER  HHEAD  ( * )*(*)        !" ヘッダー(入力)
      REAL       GDATA  ( * )            !" データ(入力)
      INTEGER    IX                      !" 入れるべき第1次元の格
      CHARACTER  HHEADO ( * )*(*)        !" ヘッダー(出力)
      REAL       GDATAO ( * )            !" データ(出力)
*
*"         < 1. 大きさの取得 >
*
      CALL GUSMIS ( HHEADO )
*
      CALL GUQSIZ
     I         ( HHEADO,
     O           IXSTR , IXEND , IXDIM ,
     O           IYSTR , IYEND , IYDIM ,
     O           IZSTR , IZEND , IZDIM  )
*
      CALL GUSZCK ( HHEADO, IXDIM*IYDIM*IZDIM )
*
      IF ( ( IX .LT. IXSTR ) .OR. ( IX .GT. IXEND ) ) THEN
         CALL MSGDMP( 'E', 'GPXCOM', 'IX IS OUT OF RANGE.' )
      ENDIF
*
*"         < 2. データ詰め替え >
*
      CALL VRSET
     I      ( GDATA,
     O        GDATAO( IX-IXSTR+1 ),
     I        IYDIM*IZDIM, 1, IXDIM  )
*
      RETURN
      END
*********************************************************************
*"         << 第１次元の結合の準備 >>
*********************************************************************
      SUBROUTINE GPXCMI
     I         ( HHEAD , HAITMX, IXSTR , IXEND ,
     I           HEDIT , HETTL ,
     O           HHEADO, GDATAO )
*
      CHARACTER  HHEAD  ( * )*(*)        !" ヘッダー(入力)
      CHARACTER  HAITMX      *(*)        !" 結合する第1次元の軸
      INTEGER    IXSTR                   !" 第1次元の軸の格子始め
      INTEGER    IXEND                   !" 第1次元の軸の格子終り
      CHARACTER  HEDIT       *(*)        !" 編集略記号
      CHARACTER  HETTL       *(*)        !" 編集タイトル
      CHARACTER  HHEADO ( * )*(*)        !" ヘッダー(出力)
      REAL       GDATAO ( * )            !" データ(出力)
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      LOGICAL    OCYCL                   !" サイクリックか？
      CHARACTER  HAITM       *(NCC)
      CHARACTER  HEDITD      *(NCC)      !" 編集略記号
      CHARACTER  HETTLD      *(NCC)      !" 編集タイトル
*
*"         < 1. 大きさの取得 >
*
      CALL GHCGET ( HHEAD , 'AITM1', HAITM  )
      IF ( HAITM .NE. ' ' ) THEN
         CALL GUQSIZ
     I         ( HHEAD ,
     O           IYSTR , IYEND , IYDIM ,
     O           IZSTR , IZEND , IZDIM ,
     O           IDUMY1, IDUMY2, IDUMY3 )
      ELSE
         CALL GUQSIZ
     I         ( HHEAD ,
     O           IDUMY1, IDUMY2, IDUMY3,
     O           IYSTR , IYEND , IYDIM ,
     O           IZSTR , IZEND , IZDIM   )
      ENDIF
*
      IF ( ( IXSTR .EQ. 0 ) .AND. ( IXEND .EQ. 0 ) ) THEN
         CALL GUQAXD
     I         ( HAITMX,
     O           IADIM , OCYCL  )
         IXSTRZ = 1
         IXENDZ = IADIM
      ELSE
         IXSTRZ = IXSTR
         IXENDZ = IXEND
      ENDIF
*
      IXDIM = IXENDZ - IXSTRZ + 1
      CALL GUSZCK ( HHEADO, IXDIM*IYDIM*IZDIM )
*
*"         < 2. 欠損値を詰める >
*
      CALL GHPGET ( HHEAD, 'MISS', VMISS )
      CALL RSET   ( GDATAO, IXDIM*IYDIM*IZDIM, 1 , VMISS )
*
*"         < 3. ヘッダー変更 >
*
      CALL GHCOPY ( HHEAD, HHEADO )
*
      CALL GHCGET ( HHEAD , 'AITM1', HAITM  )
      IF ( HAITM .NE. ' ' ) THEN
         CALL GHCGET ( HHEAD , 'AITM2', HAITM  )
         CALL GHCSET ( HHEADO, 'AITM3', HAITM  )
         CALL GHPSET ( HHEADO, 'ASTR3', IZSTR  )
         CALL GHPSET ( HHEADO, 'AEND3', IZEND  )
*
         CALL GHCGET ( HHEAD , 'AITM1', HAITM  )
         CALL GHCSET ( HHEADO, 'AITM2', HAITM  )
         CALL GHPSET ( HHEADO, 'ASTR2', IYSTR  )
         CALL GHPSET ( HHEADO, 'AEND2', IYEND  )
      ENDIF
*
      CALL GHCSET ( HHEADO, 'AITM1', HAITMX )
      CALL GHPSET ( HHEADO, 'ASTR1', IXSTRZ )
      CALL GHPSET ( HHEADO, 'AEND1', IXENDZ )
*
      IF ( HEDIT .EQ. ' ' ) THEN
         CALL GUEAXN
     I               ( HAITMX, 'XC'   , '-combine',
     I                 IXSTRZ, IXENDZ ,
     O                 HEDITD, HETTLD          )
         CALL GHEADD ( HHEADO, HEDITD, HETTLD )
      ELSE IF ( HEDIT .NE. 'NUL' ) THEN
         CALL GHEADD ( HHEADO, HEDIT  , HETTL   )
      ENDIF
*
      RETURN
      END
