* PACKAGE LPARM  !" 線形力学固有値解析 : パラメター設定
*
*"  [HIS]  93/01/05(takepiro)
*"         93/07/05(takepiro)出力モード番号追加
*"         93/07/29(takepiro)
*
**********************************************************************
      SUBROUTINE SETLPR
     O             ( NMODE  ,
     O               MFIX   , MEND   ,
     O               RAYL   , TAYL   , TAU    , PRND   ,
     O               REND   , TEND   , PEND               )
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZLDIM)                      !" パラメター数, 係数行列
      INCLUDE   (ZHDIM)                      !" 文字列文字数
      INCLUDE   (ZCCOM)                      !" 標準物理定数
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zldim.F"                    !" パラメター数, 係数行列
#include        "zhdim.F"                    !" 文字列文字数
#include        "zccom.F"                    !" 標準物理定数
#endif
*
*"  [OUTPUT]
      INTEGER    NMODE                       !" 出力固有関数のモード番号
*                                            !" ( 1 で最大成長率モード )
      INTEGER    MFIX( MDIM )                !" 東西波数
*
      REAL       RAYL( RDIM )                !" レイリー数
      REAL       TAYL( TDIM )                !" テイラー数
      REAL       TAU ( TDIM )                !" √テイラー数
      REAL       PRND( PDIM )                !" プランドル数
*
      INTEGER    MEND                        !" 東西波数の計算数
      INTEGER    REND                        !" レイリー数の計算数
      INTEGER    TEND                        !" テイラー数の計算数
      INTEGER    PEND                        !" プランドル数の計算数
*
*   [INTERNAL PARM]       
      INTEGER    MODE                        !" 出力固有関数のモード番号
      INTEGER    RTYPE                       !" スケーリングタイプ
      INTEGER    TTYPE                       !" スケーリングタイプ
      INTEGER    PTYPE                       !" スケーリングタイプ
*
      CHARACTER  RUN  *(NCC)                 !" 実験名
      CHARACTER  SIGN *(NCC)                 !" 実験者名
*
      NAMELIST    /NMRUN/   RUN   , SIGN
      NAMELIST    /NMMODE/  MODE  
*
      INTEGER    IFPAR, JFPAR
*
*"         < 1. 実験名 >
*
      RUN  = 'TEST001'
      SIGN = 'GAMRAS'
*
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMRUN , END=1190 )
 1190 WRITE  ( JFPAR, NMRUN  )
*
      CALL GTCSET( 'DDSET' , RUN    )
      CALL GTCSET( 'MYSIGN', SIGN   )
*
*"         < 2. 対象モード >
*
      MODE  = 1
*
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMMODE , END=2190 )
 2190 WRITE  ( JFPAR, NMMODE  )
*
      IF( MODE .NE. 1 )THEN
         CALL MSGDMP( 'W', 'SETLPR', 'GROWTH RATE NOT MAXIMUM' )
      ENDIF
*
      NMODE = MODE
*
*"         < 2. 無次元数, 波数 >
*
      CALL STMRTP            !"   パラメター範囲 の読み込み
     O         ( MFIX   , MEND   ,
     O           RAYL   , TAYL   , TAU    , PRND   ,
     O           REND   , TEND   , PEND   ,           
     O           RTYPE  , TTYPE  , PTYPE             )
*
      CALL PARAXS
     I         ( RAYL   , TAYL   , PRND   ,
     I           REND   , TEND   , PEND   ,
     I           RTYPE  , TTYPE  , PTYPE    )
*
*"     < 5. 物理定数 >
*
      CALL PCONST
*
      RETURN
      END
**********************************************************************
      SUBROUTINE STMRTP          !"   パラメター範囲 の読み込み
     O             ( MFIX   , MEND   ,
     O               RAYL   , TAYL   , TAU    , PRND   ,
     O               REND   , TEND   , PEND   ,
     O               RTYPE  , TTYPE  , PTYPE             )
*
*   [PARAM]
#ifdef SYS_IBMS
      INCLUDE   (ZCDIM)                      !" 格子点数，波数
      INCLUDE   (ZLDIM)                      !" パラメター数, 係数行列
#else
#include        "zcdim.F"                    !" 格子点数，波数
#include        "zldim.F"                    !" パラメター数, 係数行列
#endif
*
*"  [OUTPUT]
      INTEGER    MFIX( MDIM )                !" 東西波数
*
      REAL       RAYL( RDIM )                !" レイリー数
      REAL       TAYL( TDIM )                !" テイラー数
      REAL       TAU ( TDIM )                !" √テイラー数
      REAL       PRND( PDIM )                !" プランドル数
*
      INTEGER    MEND                        !" 東西波数の計算数
      INTEGER    REND                        !" レイリー数の計算数
      INTEGER    TEND                        !" テイラー数の計算数
      INTEGER    PEND                        !" プランドル数の計算数
*
      INTEGER    RTYPE                       !" スケーリングタイプ
      INTEGER    TTYPE                       !" スケーリングタイプ
      INTEGER    PTYPE                       !" スケーリングタイプ
*
*"  [INTERNAL ONCE]
      INTEGER    MFMIN  , MFMAX  , MFDIV   !" 東西波数(最大, 最小, 間隔)
*
      REAL       RAYMIN , RAYMAX           !" レイリー数(最大, 最小)
      INTEGER    RAYDIM , RSTYPE           !" レイリー数(測点数, 軸のタイプ)
      REAL       TAYMIN , TAYMAX           !" テイラー数(最大, 最小)
      INTEGER    TAYDIM , TSTYPE           !" テイラー数(測点数, 軸のタイプ)
      REAL       PRNMIN , PRNMAX           !" プランドル数(最大, 最小)
      INTEGER    PRNDIM , PSTYPE           !" プランドル数(測点数, 軸のタイプ)
*
      NAMELIST   /NMMF/    MFMIN  , MFMAX  , MFDIV 
      NAMELIST   /NMRAY/   RAYMIN , RAYMAX , RAYDIM , RSTYPE
      NAMELIST   /NMTAY/   TAYMIN , TAYMAX , TAYDIM , TSTYPE 
      NAMELIST   /NMPRN/   PRNMIN , PRNMAX , PRNDIM , PSTYPE 
*
*   [INTERNAL WORK]
      INTEGER    IFPAR, JFPAR
      INTEGER    J
*
*"  < 1. パラメターの設定 > 
*
*"     < 1. 東西波数範囲 >
*
      MFMIN = 0
      MFMAX = 0 
      MFDIV = 0
*
C      WRITE  ( JFPAR, NMMF )
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMMF , END=1090 )
 1090 WRITE  ( JFPAR, NMMF )
*
      IF(  MFDIV .LT. 0  )THEN
         CALL MSGDMP( 'E', 'STLPAR', 'PARAMETER IS INVALID' )
      ELSE IF(  ( MFMIN .LT. 0 ) .OR. ( MFMAX .GT. MMAX )  )THEN 
         CALL MSGDMP( 'E', 'STLPAR', 'MFMIN/MAX ARE BEYOND THE RANGE' )
      ELSE IF( ( MFMIN .GE. MFMAX ) .OR. ( MFDIV .EQ. 0 )  )THEN
         MEND = 1
      ELSE
         MEND = INT( ( MFMAX - MFMIN ) / MFDIV ) + 1 
      ENDIF
*
      IF( MEND .GT. MDIM )THEN
         CALL MSGDMP( 'E', 'STLPAR', 'MEND ARE BEYOND THE RANGE' )
      ENDIF
*
      DO 1100 J = 1, MEND
         MFIX( J ) = MFMIN  + MFDIV  * ( J - 1 )
 1100 CONTINUE
*
*"     < 2. レイリー数範囲 >
*
      RAYMIN = 0.
      RAYMAX = 0. 
      RAYDIM = 1
      RSTYPE = 1
*
C      WRITE  ( JFPAR, NMRAY )
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMRAY , END=1190 )
 1190 WRITE  ( JFPAR, NMRAY  )
*
      CALL PARARY
     O       ( RAYL   , REND   , RTYPE  , 
     I         RAYMIN , RAYMAX , RAYDIM , RSTYPE ,
     D         RDIM                                 )
*
*"     < 3. テイラー数範囲 >
*
      TAYMIN = 0.
      TAYMAX = 0. 
      TAYDIM = 1
      TSTYPE = 1
*
C      WRITE  ( JFPAR, NMTAY )
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMTAY , END=1290 )
 1290 WRITE  ( JFPAR, NMTAY  )
*
      CALL PARARY
     O       ( TAYL   , TEND   , TTYPE  , 
     I         TAYMIN , TAYMAX , TAYDIM , TSTYPE ,
     D         TDIM                                 )
*
      DO 1200 J = 1, TEND
         TAU( J ) = SQRT( TAYL(J) )
 1200 CONTINUE 
*
*"     < 4. プランドル数範囲 >
*
      PRNMIN = 1.
      PRNMAX = 1. 
      PRNDIM = 1
      PSTYPE = 1
*
C      WRITE  ( JFPAR, NMPRN )
      CALL   REWNML ( IFPAR , JFPAR )
      READ   ( IFPAR, NMPRN , END=1390 )
 1390 WRITE  ( JFPAR, NMPRN  )
*
      CALL PARARY
     O       ( PRND   , PEND   , PTYPE  , 
     I         PRNMIN , PRNMAX , PRNDIM , PSTYPE ,
     D         PDIM                                 )
*
      RETURN
      END
**********************************************************************
      SUBROUTINE PARARY         !" パラメター配列の設定
     O            ( PARRY  , PAREND , STYPE  , 
     I              PARMIN , PARMAX , PARDIM , ISTYPE , 
     D              PDIM                                )
*
*  [OUTPUT]
      REAL       PARRY  ( PDIM )           !" パラメター配列
      INTEGER    PAREND                    !" パラメター計算数
      INTEGER    STYPE                     !" 軸の種類( 1:線型 2:Log )
*
*  [INPUT]
      REAL       PARMIN                    !" 最大値
      REAL       PARMAX                    !" 最小値
      INTEGER    PARDIM                    !" 測点数
      INTEGER    ISTYPE                    !" 軸の種類( 2:Log )
*
      INTEGER    PDIM                      !" 配列の次元
*
*  [WORK]
      INTEGER    J
*
*"  < 1. パラメターのチェック >
*
      IF(  ( PARDIM .LE. 0 )  )THEN
         CALL MSGDMP( 'E', 'PARARY', 'PARAMETER PARDIM IS INVALID' )
      ELSE IF( PARMIN .GE. PARMAX  )THEN
         PAREND = 1
      ELSE
         PAREND = PARDIM
      ENDIF
*
      IF( PAREND .GT. PDIM )THEN
         CALL MSGDMP( 'E', 'PARARY', 'PAREND IS BEYOND THE RANGE' )
      ENDIF
*
      IF( ( ISTYPE .GT. 2 ) .OR. ( ISTYPE.LT.1 ) )THEN
         CALL MSGDMP( 'W', 'PARARY', 'PARAMETER ISTYPE WAS MODIFIED' )
         STYPE = 1
      ELSE
         STYPE = ISTYPE
      ENDIF
*
*"  < 2. 配列要素の計算 >
*
      IF ( PAREND .EQ. 1 )THEN            !" 次元数 1 の場合
         PARRY( 1 ) = PARMIN
         STYPE      = 1
      ELSE IF ( STYPE .EQ. 1 )THEN        !" 線型スケール
         DO 1200 J = 1, PAREND
            PARRY( J ) = PARMIN 
     &                + ( PARMAX-PARMIN ) / (PAREND-1) * ( J-1 )
 1200    CONTINUE
*
      ELSE IF ( STYPE .EQ. 2 )THEN        !" Log スケール
         IF( PARMIN .LE. 0 )THEN
            CALL MSGDMP( 'E', 'PARARY', 'PARAMETER PARMIN IS INVALID' )
         ENDIF
         DO 1300 J = 1, PAREND
            PARRY( J ) = PARMIN 
     &                * ( PARMAX / PARMIN ) ** ( REAL(J-1)/(PAREND-1) )
 1300    CONTINUE 
*
      ENDIF
*
      RETURN
      END

