* PACKAGE IHSUB     
*
*"   [HIS] 90/11/02(numaguti) Original
************************************************************************
      SUBROUTINE HSTADD    
     M         ( GOUT  ,
     I           GDATA , IMULT ,
     I           HCORD , HTYPE  )
*
*   [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                       )

*   [MODIFY] 
      ReaL*8       GOUT   ( * )
*
*   [INPUT] 
      ReaL*8       GDATA  ( IDIM, JDIM, *  )
      INTEGER    IMULT
      CHARACTER  HCORD *(*)
      CHARACTER  HTYPE *(*)
*
*   [INTERNAL WORK] 
      ReaL*8       GDATAW ( IDIM, JDIM, KMAX+1 )
      INTEGER    IMAXD, JMAXD, KMAXD
      INTEGER    II, I, J, K
*
      IF      ( HTYPE .EQ. 'X' ) THEN
         CALL XAVR
     I      ( GDATA , HCORD ,
     O        GDATAW, IMAXD , JMAXD , KMAXD  )
*
      ELSE IF ( HTYPE .EQ. 'Z' ) THEN
         CALL ZAVR
     I      ( GDATA , HCORD ,
     O        GDATAW, IMAXD , JMAXD , KMAXD  )
*
      ELSE IF ( HTYPE .EQ. 'XZ' ) THEN
         CALL XZAVR
     I      ( GDATA , HCORD ,
     O        GDATAW, IMAXD , JMAXD , KMAXD  )
*
      ELSE IF ( HTYPE .EQ. 'XY' ) THEN
         CALL XYAVR
     I      ( GDATA , HCORD ,
     O        GDATAW, IMAXD , JMAXD , KMAXD  )
*
      ELSE IF ( HTYPE .EQ. 'XYZ' ) THEN
         CALL XYZAVR
     I      ( GDATA , HCORD ,
     O        GDATAW, IMAXD , JMAXD , KMAXD  )
*
      ELSE
         CALL NOAVR
     I      ( GDATA , HCORD ,
     O        GDATAW, IMAXD , JMAXD , KMAXD  )
      ENDIF
*
      II = 0
      DO 1100 K = 1, KMAXD
         DO 1110 J = 1, JMAXD
            DO 1120 I = 1, IMAXD
               II = II + 1
               GOUT ( II ) = GOUT ( II ) + GDATAW( I,J,K )*IMULT
 1120       CONTINUE
 1110    CONTINUE
 1100 CONTINUE
*
      RETURN
      END
************************************************************************
      SUBROUTINE HHEDIT       
     M         ( HHEAD ,
     I           ITSUM , IMEAN , HUTIMO  )
*
*   [MODIFY] 
      CHARACTER  HHEAD ( * )*(*)             
*
*   [INPUT] 
      INTEGER    ITSUM                       
      INTEGER    IMEAN                       
      CHARACTER  HUTIMO     *(*)             
*
*   [INTERNAL WORK] 




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

      CHARACTER  HEDIT      *(NCC)           
      CHARACTER  HETTL      *(NCC)           
      CHARACTER  HNUM       *(NCC)           
      INTEGER    NNUM, NE
      ReaL*8       RT
*
*   [EXTERNAL FUNC] 
      INTEGER    LENC
*
      CALL ACTIMR
     I         ( ITSUM , '#'   , HUTIMO,
     O           RT                        )
*
      CALL GZDBCR ( 'D', RT, HNUM, NNUM   )
      HETTL = HNUM(1:NNUM)//HUTIMO
      NE = LENC( HETTL )
*
      IF ( IMEAN .GT. 0 ) THEN
         HEDIT = 'TMEAN'
         HETTL(NE+1:NE+5) = ' Mean'
      ELSE
         HEDIT = 'TINTG'
         HETTL(NE+1:NE+5) = ' Intg'
      ENDIF
*
      CALL GHEADD( HHEAD , HEDIT  , HETTL )
*
      RETURN
      END
