*"表題 格子情報の取得  GTOOL3(GUQAXV)
*
*"履歴 90/09/14 沼口  敦
*      92/09/02 沼口  敦
*
*
*********************************************************************
*"         << 格子情報の取得 >>
*********************************************************************
      SUBROUTINE GUQAXL
     I         ( HHEAD , ID    , HKIND ,
     O           HHEADA, AXIS  , ACYCLE, IAMAX , IEOD  )
*
      CHARACTER  HHEAD ( * )*(*)             !" ヘッダー
      INTEGER    ID                          !" 何次元目の軸か
      CHARACTER  HKIND      *(*)             !" LOC/WGT
      CHARACTER  HHEADA( * )*(*)             !" ヘッダー
      REAL       AXIS  ( * )                 !" 位置/重み
      REAL       ACYCLE                      !" サイクリック値
      INTEGER    IAMAX                       !" 格子点数:非サイクリック
      INTEGER    IEOD                        !" データなしフラグ
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                    !" NCC, NDC
      INCLUDE    (GZIWRK)                    !" NW:格子ワーク大きさ
#else
#include         "gzsize.F"                  !" NCC, NDC
#include         "gziwrk.F"                  !" NW:格子ワーク大きさ
#endif
      CHARACTER  HHEADZ( NDC )*(NCC)         !" ヘッダー
      REAL       AXISZ ( NW  )               !" 位置/重み
      CHARACTER  HAXIS *(NCC)                !" 格子識別名称
      CHARACTER  HP    *(NCC)                !" パラメータ名称
      LOGICAL    OCYCL                       !" サイクリックか？
      LOGICAL    OSUBCK
*
      IF ( ( ID .LT. 1 ) .OR. ( ID .GT. 3 ) ) THEN
         CALL MSGDMP( 'W', 'GUQAXV', 'IRREGAL ID' )
         IEOD = 1
         RETURN
      ENDIF
*
*"         < 1. 軸名称, 大きさ >
*
      HP      = 'AITM'
      WRITE ( HP(5:5), '(I1)' ) ID
      CALL GHCGET ( HHEAD, HP  , HAXIS )
      HP(1:4) = 'ASTR'
      CALL GHPGET ( HHEAD, HP  , IZSTR )
      HP(1:4) = 'AEND'
      CALL GHPGET ( HHEAD, HP  , IZEND )
*
      CALL GUSZCK ( HHEADA, IZEND-IZSTR+1 )
*
*"         < 2. 格子情報ファイル読み込み >
*
      CALL GTPGET ( 'SUBCHK', OSUBCK )
      CALL GTSIZE ( HHEADZ  ,  NW     )
      CALL GUQAXC
     I            ( HAXIS , HKIND ,
     O              HHEADZ, AXISZ , ACYCLE, IAMAX , IEOD   )
      CALL GTPSET ( 'SUBCHK', OSUBCK )
*
      IF ( IEOD .NE. 0 ) RETURN
      IF ( IZSTR .EQ. 0 .AND. IZEND .EQ. 0 ) THEN
         IZSTR = 1
         IZEND = IAMAX
         CALL GUSZCK ( HHEADA, IZEND-IZSTR+1 )
      ENDIF
*
*"         < 3. 詰め替え >
*
      CALL GHPGET ( HHEADZ, 'MISS' , VMISS )
*
      DO 3100 IZ = IZSTR, IZEND
         IF ( ACYCLE .NE. 0. ) THEN
            IZI  = MOD( IZ-1, IAMAX ) + 1
            AOFS = (IZ-1)/IAMAX * ACYCLE
         ELSE
            IZI  = IZ
            AOFS = 0.
         ENDIF
*
         IF ( ( 1.LE.IZI ).AND.( IZI.LE.IAMAX ) ) THEN
            AXIS ( IZ-IZSTR+1 ) = AXISZ( IZI ) + AOFS
         ELSE
            AXIS ( IZ-IZSTR+1 ) = VMISS
         ENDIF
 3100 CONTINUE
*
*"         < 4. ヘッダー書換え >
*
      CALL GHCOPY ( HHEADZ, HHEADA )
      CALL GHPSET ( HHEADA, 'ASTR1', IZSTR )
      CALL GHPSET ( HHEADA, 'AEND1', IZEND )
*
      IF ( IZSTR .NE. 1 ) THEN
         IF ( AXISZ( 1 ) .LT. AXISZ( IAMAX ) ) THEN
            CALL GHPSET ( HHEADA, 'DMIN' , VMISS )
         ELSE
            CALL GHPSET ( HHEADA, 'DMAX' , VMISS )
         ENDIF
      ENDIF
*
      IF ( .NOT. ( ( IZEND .EQ. IAMAX                ) .OR.
     &             ( OCYCL .AND.( IZEND.EQ.IAMAX+1 ) )
     &    )      )                                          THEN
*
         IF ( AXISZ( 1 ) .LT. AXISZ( IAMAX ) ) THEN
            CALL GHPSET ( HHEADA, 'DMAX' , VMISS )
         ELSE
            CALL GHPSET ( HHEADA, 'DMIN' , VMISS )
         ENDIF
      ENDIF
*
      RETURN
      END
*********************************************************************
*"         << 格子情報の取得 >>
*********************************************************************
      SUBROUTINE GUQAXQ
     I         ( HHEAD , ID    , HKIND ,
     O           AXIS  , ACYCLE, IAMAX , IEOD  ,
     D           IZDIM                           )
*
      CHARACTER  HHEAD ( * )*(*)             !" ヘッダー
      INTEGER    ID                          !" 何次元目の軸か
      CHARACTER  HKIND      *(*)             !" LOC/WGT
      REAL       AXIS  ( IZDIM )             !" 位置/重み
      REAL       ACYCLE                      !" サイクリック値
      INTEGER    IAMAX                       !" 格子点数:非サイクリック
      INTEGER    IEOD                        !" データなしフラグ
*"    INTEGER    IZDIM                       ! AXIS領域の大きさ
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                    !" NCC, NDC
#else
#include         "gzsize.F"                  !" NCC, NDC
#endif
      CHARACTER  HHEADA ( NDC )*(NCC)
      LOGICAL    OSUBCK
*
      CALL       GTPGET( 'SUBCHK', OSUBCK )
      CALL       GTSIZE(  HHEADA , IZDIM  )
*
      CALL       GUQAXL
     I         ( HHEAD , ID    , HKIND ,
     O           HHEADA, AXIS  , ACYCLE, IAMAX , IEOD   )
*
      CALL       GTPSET( 'SUBCHK', OSUBCK )
*
      RETURN
      END
*********************************************************************
*"         << 格子情報の取得 >>
*********************************************************************
      SUBROUTINE GUQAXV
     I         ( HHEAD , ID    , HKIND ,
     O           HHEADA, AXIS  , IEOD  )
*
      CHARACTER  HHEAD ( * )*(*)             !" ヘッダー
      INTEGER    ID                          !" 何次元目の軸か
      CHARACTER  HKIND      *(*)             !" LOC/WGT
      CHARACTER  HHEADA( * )*(*)             !" ヘッダー
      REAL       AXIS  ( * )                 !" 位置/重み
      INTEGER    IEOD                        !" データなしフラグ
*
      CALL       GUQAXL
     I         ( HHEAD , ID    , HKIND ,
     O           HHEADA, AXIS  , ACYCLE, IAMAX , IEOD  )
*
      RETURN
      END
*********************************************************************
*"         << 格子情報の取得 >>
*********************************************************************
      SUBROUTINE GUQAXP
     I         ( HHEAD , ID    , HKIND ,
     O           AXIS  , IEOD  ,
     D           IZDIM                  )
*
      CHARACTER  HHEAD ( * )*(*)             !" ヘッダー
      INTEGER    ID                          !" 何次元目の軸か
      CHARACTER  HKIND      *(*)             !" LOC/WGT
      REAL       AXIS  ( IZDIM )             !" 位置/重み
      INTEGER    IEOD                        !" データなしフラグ
*"    INTEGER    IAMAX                       ! AXIS領域の大きさ
*
      CALL       GUQAXQ
     I         ( HHEAD , ID    , HKIND ,
     O           AXIS  , ACYCLE, IAMAX , IEOD  ,
     D           IZDIM                           )
*
      RETURN
      END
