* PACKAGE ICORD 
*
***********************************************************************
      SUBROUTINE HQCORN    
     I         ( HCORD ,
     O           HALON , HALAT , HASIG ,
     O           KLEVS                   )
*
*   [PARAM] 





* PACKAGE  ZXT10L32 !" 格子点数，波数 X-Z
*
      INTEGER     IMAX           !" 経度格子数
      INTEGER     JMAX           !" 緯度格子数
      INTEGER     IDIM           !" 経度配列サイズ
      INTEGER     JDIM           !" 緯度配列サイズ
      INTEGER     MMAX           !" 最大東西波数
      INTEGER     LMAX           !" 最大南北波数
      INTEGER     NMAX           !" 最大全波数
      INTEGER     MINT           !" 東西波数間隔
      INTEGER     KMAX           !" 鉛直層数
      INTEGER     KDIM           !" 鉛直配列サイズ
      INTEGER     NMDIM          !" 水平波数成分数
      INTEGER     JMXHF          !" JMAX/2+1
      INTEGER     NWORK          !" ワーク領域大きさ
*
      PARAMETER ( IMAX  = 32,     JMAX =  1,
     &            IDIM  = IMAX+1, JDIM = JMAX,
     &            MMAX  = 10,     LMAX =  0,    NMAX = MMAX, MINT = 1,
     &            KMAX  = 32,     KDIM = KMAX,
     &            NMDIM = (MMAX/MINT+1)*(2*(NMAX+1)-MMAX)
     &                  - (NMAX-LMAX)/MINT*(NMAX-LMAX+1),
     &            JMXHF = JMAX/2+1,
     &            NWORK = IDIM*JDIM*KMAX*12                       )

* PACKAGE ZHDIM  !" 文字列文字数 
*
*"  [HIS]  90/08/31(numaguti)
*
      INTEGER     NCC
      INTEGER     NDC
      INTEGER     NFILN
*
      PARAMETER ( NCC   = 16, NDC   = 64 ,
     &            NFILN = 38              )

*
*   [INPUT] 
      CHARACTER  HCORD  *(*)                 
*
*   [OUTPUT] 
      CHARACTER  HALON  *(*)                 
      CHARACTER  HALAT  *(*)                 
      CHARACTER  HASIG  *(*)                 
*
*   [ENTRY INPUT] 
      CHARACTER  HASIGM *(*)                 
      ReaL*8       ALON   ( * )                
      ReaL*8       ALAT   ( * )                
      ReaL*8       ASIG   ( * )                
      ReaL*8       ASIGM  ( * )                
      ReaL*8       DLON   ( * )                
      ReaL*8       DLAT   ( * )                
      ReaL*8       DSIG   ( * )                
      ReaL*8       DSIGM  ( * )                
*
*   [INTERNAL SAVE] 
      CHARACTER  HALONZ *(NCC)               
      CHARACTER  HALATZ *(NCC)               
      CHARACTER  HASIGZ *(NCC)               
      CHARACTER  HASIMZ *(NCC)               
      ReaL*8       ALONZ  ( IMAX )             
      ReaL*8       ALATZ  ( JMAX )             
      ReaL*8       ASIGZ  ( KMAX )             
      ReaL*8       ASIGMZ ( KMAX+1 )           
      ReaL*8       DLONZ  ( IMAX )             
      ReaL*8       DLATZ  ( JMAX )             
      ReaL*8       DSIGZ  ( KMAX )             
      ReaL*8       DSIGMZ ( KMAX+1 )           
      SAVE
*
*   [INTERNAL WORK] 
      INTEGER    KLEVS
*
      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 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 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
*=====================================================================
      ENTRY      HSCORD      
     I         ( HALON , HALAT , HASIG , HASIGM,
     I           ALON  , ALAT  , ASIG  , ASIGM ,
     I           DLON  , DLAT  , DSIG  , DSIGM  )
*
      HALONZ = HALON
      HALATZ = HALAT
      HASIGZ = HASIG
      HASIMZ = HASIGM
*
      CALL COPY ( ALONZ , ALON  , IMAX   )
      CALL COPY ( ALATZ , ALAT  , JMAX   )
      CALL COPY ( ASIGZ , ASIG  , KMAX   )
      CALL COPY ( ASIGMZ, ASIGM , KMAX+1 )
*
      CALL COPY ( DLONZ , DLON  , IMAX   )
      CALL COPY ( DLATZ , DLAT  , JMAX   )
      CALL COPY ( DSIGZ , DSIG  , KMAX   )
      CALL COPY ( DSIGMZ, DSIGM , KMAX+1 )
*
      RETURN
*=====================================================================
      ENTRY      HSCORN      
     I         ( HALON , HALAT , HASIG , HASIGM )
*
      HALONZ = HALON
      HALATZ = HALAT
      HASIGZ = HASIG
      HASIMZ = HASIGM
*
      RETURN
      END
