* PACKAGE ICORD !" ヒストリー 座標設定
*
*"履歴   original from AGCM5 (numaguti)
*"       96/09/09 (takepiro)
***********************************************************************
      SUBROUTINE HQCORN    !" 座標系名の参照
     I         ( HCORD ,
     O           HALON , HALAT , HASIG ,
     O           KLEVS                   )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZHDIM)                      !" 文字列文字数
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zhdim.F"                    !" 文字列文字数
#endif
*
*   [INPUT] 
      CHARACTER  HCORD  *(*)                 !" 座標系
*
*   [OUTPUT] 
      CHARACTER  HALON  *(*)                 !" 第1軸名称
      CHARACTER  HALAT  *(*)                 !" 第2軸名称
      CHARACTER  HASIG  *(*)                 !" 第3軸名称
*
*   [ENTRY INPUT] 
      REAL       ALON   ( * )                !" 第1軸点
      REAL       ALAT   ( * )                !" 第2軸点
      REAL       ASIG   ( * )                !" 第3軸点
      REAL       DLON   ( * )                !" 第1軸Δ
      REAL       DLAT   ( * )                !" 第2軸Δ
      REAL       DSIG   ( * )                !" 第3軸Δ
*
*   [INTERNAL SAVE] 
      CHARACTER  HALONZ *(NCC)               !" 第1軸名称
      CHARACTER  HALATZ *(NCC)               !" 第2軸名称
      CHARACTER  HASIGZ *(NCC)               !" 第3軸名称
      CHARACTER  HASIMZ *(NCC)               !" 第3軸名称
      REAL       ALONZ  ( IMAX )             !" 第1軸点
      REAL       ALATZ  ( JMAX )             !" 第2軸点
      REAL       ASIGZ  ( KMAX )             !" 第3軸点
      REAL       ASIGMZ ( KMAX+1 )           !" 第3軸点
      REAL       DLONZ  ( IMAX )             !" 第1軸Δ
      REAL       DLATZ  ( JMAX )             !" 第2軸Δ
      REAL       DSIGZ  ( KMAX )             !" 第3軸Δ
      REAL       DSIGMZ ( KMAX+1 )           !" 第3軸Δ
*
      LOGICAL    OSTCNM 
      DATA       OSTCNM  /.FALSE./
      SAVE
*
*    [INTERNAL PARAM]
      CHARACTER  HNUM   *(NCC)
      CHARACTER  HALAT0 *(NCC)               !" 緯度軸名称
      CHARACTER  HALON0 *(NCC)               !" 経度軸名称
      DATA       HALAT0 / 'GGLA' /
      DATA       HALON0 / 'GLON' /
*
*   [INTERNAL WORK] 
      INTEGER    KLEVS
      INTEGER    IAY,  INUM
*
*    [EXTERNAL FUNC]
      INTEGER    LENC
*
      IF ( .NOT. OSTCNM ) THEN
         OSTCNM = .TRUE.
*
*"         < 1. 経度軸の名称 >
*
          CALL GULCHR
     I        ( '(I4)', IMAX  ,
     O          HNUM  , INUM   )
          IAY  = LENC( HALON0 )
          HALONZ  = HALON0(1:IAY)//HNUM(1:INUM)
*
*"         < 2. 緯度軸の名称 >
*
          CALL GULCHR
     I         ( '(I4)', JMAX  ,
     O           HNUM  , INUM   )
          IAY  = LENC( HALAT0 )
          HALATZ  = HALAT0(1:IAY)//HNUM(1:INUM)
*
*"         < 3. 鉛直軸の名称 >
*
          IF ( KMAX .NE. 1 ) THEN
             CALL MSGDMP( 'E', 'HQCORN',
     &            'THIS ROUTINE USABLE ONLY FOR BAROTROPIC MODEL' )
          ENDIF
*
          HASIGZ=' '
          HASIMZ=' '
      ENDIF
*
      HALON  = HALONZ
      HALAT  = HALATZ
*
      IF      ( HCORD .EQ. 'ALEV'  ) THEN
         HASIG  = HASIGZ
         KLEVS  = KMAX
      ELSE IF ( HCORD .EQ. 'AMLEV' ) THEN
         HASIG  = HASIMZ
         KLEVS  = KMAX+1
      ELSE IF ( HCORD .EQ. 'ASFC'  ) THEN
         HASIG  = ' '
         KLEVS  = 1
      ELSE
         CALL MSGDMP( 'W', 'HQCORN', 'UNKNOWN COORDINATE' )
      ENDIF
*
      RETURN
*=====================================================================
      ENTRY      HQCORL      !"  座標レベル数の参照 
     I         ( HCORD ,
     O           KLEVS  )
*
      IF      ( HCORD .EQ. 'ALEV'  ) THEN
         KLEVS  = KMAX
      ELSE IF ( HCORD .EQ. 'AMLEV' ) THEN
         KLEVS  = KMAX+1
      ELSE IF ( HCORD .EQ. 'ASFC'  ) THEN
         KLEVS  = 1
      ELSE
         CALL MSGDMP( 'W', 'HQCORL', 'UNKNOWN COORDINATE' )
      ENDIF
*
      RETURN
*=====================================================================
      ENTRY      HQCORD      !"  座標Δの参照 
     I         ( HCORD ,
     O           DLON  , DLAT  , DSIG  ,
     O           KLEVS                   )
*
      CALL SETCOR
     O         ( ALONZ  , DLONZ  ,
     O           ALATZ  , DLATZ  ,
     O           ASIGZ  , DSIGZ  , 
     O           ASIGMZ , DSIGMZ   ) 
*
      CALL COPY ( DLON, DLONZ, IMAX )
      CALL COPY ( DLAT, DLATZ, JMAX )
*
      IF      ( HCORD .EQ. 'ALEV'  ) THEN
         CALL COPY ( DSIG, DSIGZ,  KMAX )
         KLEVS  = KMAX
      ELSE IF ( HCORD .EQ. 'AMLEV' ) THEN
         CALL COPY ( DSIG, DSIGMZ, KMAX )
         KLEVS  = KMAX+1
      ELSE IF ( HCORD .EQ. 'ASFC'  ) THEN
         DSIG( 1 ) = 1.0
         KLEVS  = 1
      ELSE
         CALL MSGDMP( 'W', 'HQCORD', 'UNKNOWN COORDINATE' )
      ENDIF
*
      RETURN
*=====================================================================
      ENTRY      HQCORP      !"  座標点の参照 
     I         ( HCORD ,
     O           ALON  , ALAT  , ASIG  ,
     O           KLEVS                   )
*
      CALL SETCOR
     O         ( ALONZ  , DLONZ  ,
     O           ALATZ  , DLATZ  ,
     O           ASIGZ  , DSIGZ  , 
     O           ASIGMZ , DSIGMZ   ) 
*
      CALL COPY ( ALON, ALONZ, IMAX )
      CALL COPY ( ALAT, ALATZ, JMAX )
*
      IF      ( HCORD .EQ. 'ALEV'  ) THEN
         CALL COPY ( ASIG, ASIGZ,  KMAX )
         KLEVS  = KMAX
      ELSE IF ( HCORD .EQ. 'AMLEV' ) THEN
         CALL COPY ( ASIG, ASIGMZ, KMAX )
         KLEVS  = KMAX+1
      ELSE IF ( HCORD .EQ. 'ASFC'  ) THEN
         ASIG( 1 ) = 1.0
         KLEVS  = 1
      ELSE
         CALL MSGDMP( 'W', 'HQCORP', 'UNKNOWN COORDINATE' )
      ENDIF
*
      RETURN
      END