* PACKAGE IPARM !" $B%R%9%H%j!<(B $B%Q%i%a%?!<@_Dj(B
*
*"  [HIS] 93/06/16(takepiro)
*
***********************************************************************
      SUBROUTINE HQPARM    !" $B%Q%i%a%?!<$N;2>H(B
     I         ( HP ,
     O           RP  )
*
*   [PARAM] 
#ifdef SYS_IBMS
      INCLUDE   (ZHDIM)                      !" $BJ8;zNsJ8;z?t(B
#else
#include        "zhdim.F"                    !" $BJ8;zNsJ8;z?t(B
#endif
*
*   [INPUT] 
      CHARACTER  HP  *(*)                    !" $B%Q%i%a%?!<L>(B
*
*   [OUTPUT] 
      REAL       RP                          !" $B%Q%i%a%?!<CM(B
*     
*   [ENTRY MODIFY] 
      CHARACTER  HHEAD ( * )*(*)             !" $B%X%C%@!<(B
*
*   [INTERNAL SAVE] 
      INTEGER    NPARA                       !" $B3JG<%Q%i%a%?!<:GBg?t(B
      PARAMETER (NPARA=6)
*
      CHARACTER  HPARA(NPARA) * (NCC)        !" $B3JG<%Q%i%a%?!<L>(B
*
      REAL       RX(NPARA)                   !" $BCM3JG<JQ?t(B($B<B?t(B)
      CHARACTER  HFMT(NPARA) * (NCC)         !" $B=q<0(B
      LOGICAL    LD(NPARA)                   !" $BL$Dj5A%9%$%C%A(B
*
      SAVE
*
*   [INTERNAL WORK] 
      CHARACTER  CMSG * 64                   !" $B%(%i!<%a%C%;!<%8(B
      CHARACTER  HMEM * (NCC)                !" $B%X%C%@!<5-=R;RL>(B
      CHARACTER  HN   * (NCC)                !" $B:n6HJQ?t(B
      CHARACTER  HX   * (NCC)                !" $B:n6HJQ?t(B
*
      INTEGER    LENC                        !" $B30It4X?t(B
      LOGICAL    LCHREQ                      !" $B30It4X?t(B
      EXTERNAL   LCHREQ, LENC
*
      INTEGER    N, NHP, NC, MEMN            !" $B:n6HJQ?t(B
*
      DATA HPARA( 1)/'RAYLEIGH NUMBER '/, HFMT( 1)/'(E15.7)'/
      DATA HPARA( 2)/'TAYLOR NUMBER   '/, HFMT( 2)/'(E15.7)'/
      DATA HPARA( 3)/'PRANDTL NUMBER  '/, HFMT( 3)/'(E15.7)'/
      DATA HPARA( 4)/'GROWTH RATE     '/, HFMT( 4)/'(E15.7)'/
      DATA HPARA( 5)/'FREQENCY        '/, HFMT( 5)/'(E15.7)'/
      DATA HPARA( 6)/'WAVE NUMBER     '/, HFMT( 6)/'(F10.0)'/
*
      DATA LD / NPARA * .FALSE. /
*
      DO 10 N = 1, NPARA
        IF ( LCHREQ(HP,HPARA(N)) ) THEN
           IF ( LD(N) ) THEN
              RP = RX(N)
              RETURN
           ENDIF
        ENDIF
   10 CONTINUE
*
      NHP=LENC(HP)
      CMSG='PARAMETER '''//HP(1:NHP)//''' IS NOT DEFINED.'
      CALL MSGDMP('E','HQPARM',CMSG)
      STOP
*-----------------------------------------------------------------------
      ENTRY HSPARM     !" $B%Q%i%a%?!<$N@_Dj(B
     I         (  HP ,  RP  )
*
      DO 15 N = 1, NPARA
         IF ( LCHREQ(HP,HPARA(N)) ) THEN
            RX(N) = RP
            LD(N) = .TRUE.
            RETURN
         END IF
   15 CONTINUE
*
      NHP=LENC(HP)
      CMSG='PARAMETER '''//HP(1:NHP)//''' IS NOT DEFINED.'
      CALL MSGDMP('E','HSPARM',CMSG)
*
      STOP
*-----------------------------------------------------------------------
      ENTRY HHPARM     !" $B%Q%i%a%?!<$N%X%C%@!<EPO?(B
     M        ( HHEAD )
*
      MEMN = 0
      DO 20 N = 1, NPARA
         IF ( LD(N) ) THEN
*
            MEMN = MEMN + 1
            WRITE ( HN , '(I3)' ) MEMN
            CALL CLADJ(HN)
            HMEM = 'MEMO'//HN(1:2)
*
            WRITE ( HN, HFMT(N) ) RX(N)
            CALL CLADJ(HN)
            NC = LENC(HN)
            HX = HPARA(N)(1:1) // ':' // HN(1:NC)
*
            CALL GHCSET
     M               ( HHEAD ,
     I                 HMEM  , HX  )
         ENDIF
 20   CONTINUE 
*
      END
