*"表題 第２次元の部分切出し GTOOL3(GPYRDC)
*
*"履歴 90/08/18 沼口  敦
*
*
*********************************************************************
*"         << 第２次元の部分切出し >>
*********************************************************************
      SUBROUTINE GPYRDC
     I         ( HHEAD , GDATA , IYSEL1, IYSEL2,
     I           HEDIT , HETTL ,
     O           HHEADO, GDATAO                  )
*
      CHARACTER  HHEAD  ( * )*(*)        !" ヘッダー(入力)
      REAL       GDATA  ( * )            !" データ(入力)
      INTEGER    IYSEL1                  !" 切り出す第2次元の格子
      INTEGER    IYSEL2                  !" 切り出す第2次元の格子
      CHARACTER  HEDIT       *(*)        !" 編集略記号
      CHARACTER  HETTL       *(*)        !" 編集タイトル
      CHARACTER  HHEADO ( * )*(*)        !" ヘッダー(出力)
      REAL       GDATAO ( * )            !" データ(出力)
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HAXIS       *(NCC)
      CHARACTER  HEDITD      *(NCC)      !" 編集略記号
      CHARACTER  HETTLD      *(NCC)      !" 編集タイトル
      LOGICAL    OCYCL                   !" サイクリックか？
*
*"         < 1. 大きさの取得 >
*
      CALL GUSMIS ( HHEAD )
*
      CALL GUQSIZ
     I         ( HHEAD ,
     O           IXSTR , IXEND , IXDIM ,
     O           IYSTR , IYEND , IYDIM ,
     O           IZSTR , IZEND , IZDIM  )
*
      IYDIMC = IYSEL2-IYSEL1+1
      CALL GUSZCK ( HHEADO, IXDIM*IYDIMC*IZDIM )
*
      CALL GHCGET( HHEAD, 'AITM2', HAXIS )
      CALL GUQAXD
     I         ( HAXIS ,
     O           IADIM , OCYCL  )
*
*"         < 2. データ詰め替え >
*
      CALL GHPGET ( HHEAD, 'MISS', VMISS )
*
      DO 2100 IY = IYSEL1, IYSEL2
         IF ( OCYCL ) THEN
            IYI = MOD( IY-IYSTR, IADIM ) + 1
         ELSE
            IYI = IY-IYSTR+1
         ENDIF
*
         IF ( ( 1.LE.IYI ).AND.( IYI.LE.IYDIM ) ) THEN
            DO 2110 IZ = 1, IZDIM
               CALL VRSET
     I            ( GDATA ( IXDIM*IYDIM*(IZ-1) + IXDIM*(IYI-1) +1 ),
     O              GDATAO( IXDIM*IYDIMC*(IZ-1)
     &                      + IXDIM*(IY-IYSEL1)+1 ),
     I              IXDIM , 1     , 1                               )
 2110       CONTINUE
         ELSE
            DO 2120 IZ = 1, IZDIM
               CALL RSET
     O            ( GDATAO( IXDIM*(IY-IYSEL1)+1 ),
     I              IXDIM , 1    , VMISS          )
 2120       CONTINUE
         ENDIF
*
 2100 CONTINUE
*
*"         < 3. ヘッダー変更 >
*
      CALL GHCOPY ( HHEAD, HHEADO )
      CALL GHPSET ( HHEADO, 'ASTR2', IYSEL1 )
      CALL GHPSET ( HHEADO, 'AEND2', IYSEL2 )
*
      IF ( ( IYSTR .EQ. IYSEL1 ).AND.( IYEND .EQ. IYSEL2 ) ) RETURN
*
      IF      ( HEDIT .EQ. ' ' ) THEN
         CALL GUEAXN
     I               ( HAXIS , 'YR'   , '-reduce',
     I                 IYSEL1, IYSEL2 ,
     O                 HEDITD, HETTLD          )
         CALL GHEADD ( HHEADO, HEDITD, HETTLD )
      ELSE IF ( HEDIT .NE. 'NUL' ) THEN
         CALL GHEADD ( HHEADO, HEDIT  , HETTL   )
      ENDIF
*
      RETURN
      END
*********************************************************************
*"         << 第２次元の部分切出し >>
*********************************************************************
      SUBROUTINE GMYRDC
     M         ( HHEAD , GDATA ,
     I           IYSEL1, IYSEL2,
     I           HEDIT , HETTL  )
*
      CHARACTER  HHEAD  ( * )*(*)        !" ヘッダー(入力)
      REAL       GDATA  ( * )            !" データ(入力)
      INTEGER    IYSEL1                  !" 切り出す第2次元の格子
      INTEGER    IYSEL2                  !" 切り出す第2次元の格子
      CHARACTER  HEDIT       *(*)        !" 編集略記号
      CHARACTER  HETTL       *(*)        !" 編集タイトル
*
      COMMON     /GMWORK/ GDATAW
      REAL       GDATAW ( 1 )            !" データ(ワーク)
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
      CHARACTER  HHEADW ( NDC )*(NCC)    !" ヘッダー(ワーク)
*
      CALL       GMCSIZ ( HHEADW )
      CALL       GPYRDC
     I         ( HHEAD , GDATA , IYSEL1, IYSEL2,
     I           HEDIT , HETTL ,
     O           HHEADW, GDATAW                  )
*
      CALL       GPFSET
     I         ( HHEADW, GDATAW,
     I           ' '   , ' '   ,
     O           HHEAD , GDATA   )
*
      RETURN
      END