* PACKAGE LEIGWR !" 固有値ファイル書きこみ * *" [HIS] 93/01/20(takepiro) * ******************************************************************* SUBROUTINE EIGWRT !" パラメター空間への成長率, 振動数出力 I ( GROWTH , FRQENC , I MFIX , I REND , TEND , PEND ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数, 波数 INCLUDE (ZHDIM) !" 文字数 INCLUDE (ZLDIM) !" パラメター数, 係数行列 #else #include "zcdim.F" !" 格子点数, 波数 #include "zhdim.F" !" 文字数 #include "zldim.F" !" パラメター数, 係数行列 #endif * * [INPUT] REAL GROWTH( RDIM*TDIM*PDIM ) !" 成長率 REAL FRQENC( RDIM*TDIM*PDIM ) !" 振動数 * INTEGER MFIX !" 東西波数 INTEGER REND !" レイリー数の計算数 INTEGER TEND !" テイラー数の計算数 INTEGER PEND !" プランドル数の計算数 * * [INTERNAL PARM] INTEGER JFGRW , JFFRQ INTEGER JFGRWD, JFFRQD DATA JFGRWD, JFFRQD / 50 , 51 / * INTEGER IDATE ( 6 ) !" 日付( ダミー ) INTEGER ISTEP INTEGER ITDUR DATA IDATE / 1990, 1, 1, 0, 0, 0 / DATA ISTEP / 0 / DATA ITDUR / 1 / * CHARACTER HDFMT *(NCC) !" データフォーマット DATA HDFMT / 'UR4' / REAL VMISS !" 欠損値の値 * * [INTERNAL WORK] CHARACTER HHGROW( NDC )*(NCC) !" 成長率ヘッダー CHARACTER HHFREQ( NDC )*(NCC) !" 振動数ヘッダー * INTEGER IFPAR , JFPAR !" NAMELIST 読み書き * CHARACTER FNGROW * (NFILN) !" 成長率出力ファイル名 CHARACTER FNFREQ * (NFILN) !" 振動数出力ファイル名 * NAMELIST / NMEIGN / FNGROW, FNFREQ * INTEGER IERR !" ファイルオープンエラー記述子 * LOGICAL OFIRST DATA OFIRST / .TRUE. / * SAVE * IF( OFIRST )THEN OFIRST = .FALSE. * *" < 1.ファイル名 > * CALL REWNML ( IFPAR , JFPAR ) READ ( IFPAR, NMEIGN , END=1190 ) 1190 WRITE ( JFPAR, NMEIGN ) * CALL IFLOPN O ( JFGRW , IERR , I FNGROW, JFGRWD, 'WRITE', 'UNFORMATTED' ) * IF( IERR .GT. 0 )THEN CALL MSGDMP( 'E', 'EIGWRT', 'CANNOT OPEN FILE' ) ENDIF * CALL IFLOPN O ( JFFRQ , IERR , I FNFREQ, JFFRQD, 'WRITE', 'UNFORMATTED' ) * IF( IERR .GT. 0 )THEN CALL MSGDMP( 'E', 'EIGWRT', 'CANNOT OPEN FILE' ) ENDIF * ENDIF * *" < 2. ヘッダー作成 > * CALL GZDBGT( 'MISS' , VMISS ) * CALL EIGHED O ( HHGROW , HHFREQ , I MFIX , I REND , TEND , PEND , I HDFMT , VMISS , I VMISS , VMISS , VMISS , VMISS , 1 ) * *" < 4. ファイル書き込み > * CALL GZDBWX !" 精度変換書き込み ; 東西波数を時間(day)として書きこむ I ( HHGROW , GROWTH , I MFIX , IDATE , ISTEP , ITDUR , I JFGRW , 1 , 0 , HDFMT ) * CALL GZDBWX !" 精度変換書き込み ; 東西波数を時間(day)として書きこむ I ( HHFREQ , FRQENC , I MFIX , IDATE , ISTEP , ITDUR , I JFFRQ , 1 , 0 , HDFMT ) * RETURN END ******************************************************************* SUBROUTINE EIGHED !" パラメター空間ヘッダー作成 O ( HHGROW , HHFREQ , I MFIX , I REND , TEND , PEND , I HDFMT , VMISS , I DMIN , DMAX , DIVS , DIVL , ISTYP ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数, 波数 INCLUDE (ZHDIM) !" 文字数 INCLUDE (ZLDIM) !" パラメター数, 係数行列 #else #include "zcdim.F" !" 格子点数, 波数 #include "zhdim.F" !" 文字数 #include "zldim.F" !" パラメター数, 係数行列 #endif * * * [OUTPUT] CHARACTER HHGROW ( * ) * ( * ) !" 成長率ヘッダー CHARACTER HHFREQ ( * ) * ( * ) !" 振動数ヘッダー * * [INPUT] INTEGER MFIX !" 東西波数 INTEGER REND !" レイリー数の計算数 INTEGER TEND !" テイラー数の計算数 INTEGER PEND !" プランドル数の計算数 * CHARACTER HDFMT *(*) !" データフォーマット REAL VMISS !" 欠損値の値 REAL DMIN !" レンジ(最小) REAL DMAX !" レンジ(最大) REAL DIVS !" 間隔(小) REAL DIVL !" 間隔(大) INTEGER ISTYP !" スケーリングタイプ * * [INTERNAL WORK] INTEGER GRDIM !" 配列の大きさ * CHARACTER HUNIT*(NCC) !" 単位 DATA HUNIT / '1/s' / CHARACTER HUTIM*(NCC) !" 時刻単位 DATA HUTIM / 'DAY' / * CHARACTER HAITM1*(NCC) !" 軸1の格子名称 CHARACTER HAITM2*(NCC) !" 軸2の格子名称 CHARACTER HAITM3*(NCC) !" 軸3の格子名称 CHARACTER HAITMR*(NCC) !" 軸1の格子名称 CHARACTER HAITMT*(NCC) !" 軸2の格子名称 CHARACTER HAITMP*(NCC) !" 軸3の格子名称 DATA HAITMR , HAITMT , HAITMP & / '.RAYL' , '.TAYL' , '.PRND' / * CHARACTER HRUN *(NCC) !" 実験名 INTEGER NHR LOGICAL OFIRST DATA OFIRST / .TRUE. / * * [EXTERNAL FUNC] INTEGER LENC * SAVE * *" < 0. 軸名称設定 > * IF ( OFIRST ) THEN OFIRST = .FALSE. CALL GTCGET( 'DDSET' , HRUN ) NHR = LENC( HRUN ) HAITM1 = HRUN(1:NHR) // HAITMR HAITM2 = HRUN(1:NHR) // HAITMT HAITM3 = HRUN(1:NHR) // HAITMP ENDIF * *" < 1. パラメター設定 > * GRDIM = REND * TEND * PEND CALL GTOPEN CALL GTSIZE ( HHGROW , GRDIM ) CALL GTSIZE ( HHFREQ , GRDIM ) * *" < 3. ヘッダー設定 > * CALL GZDBHP !" 識別記述子のパック O ( HHGROW , I ' ' , 'GROWTH' , 1 , 1 , I 'growth rate' , HUNIT , I MFIX , ' ' , HUTIM , 1 , I HAITM1, 1 , REND , I HAITM2, 1 , TEND , I HAITM3, 1 , PEND , I HDFMT , VMISS , I DMIN , DMAX , DIVS , DIVL , I ISTYP , I ' ' , ' ' ) * CALL GZDBHP !" 識別記述子のパック O ( HHFREQ , I ' ' , 'FRQENC' , 1 , 1 , I 'frequency' , HUNIT , I MFIX , ' ' , HUTIM , 1 , I HAITM1, 1 , REND , I HAITM2, 1 , TEND , I HAITM3, 1 , PEND , I HDFMT , VMISS , I DMIN , DMAX , DIVS , DIVL , I ISTYP , I ' ' , ' ' ) * RETURN END ******************************************************************* SUBROUTINE EIALWR !" 成長率, 振動数全モード出力 I ( GROWTH , FRQENC , I NUMEIG , I FNGROW , FNFREQ ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数, 波数 INCLUDE (ZHDIM) !" 文字数 INCLUDE (ZLDIM) !" パラメター数, 係数行列 #else #include "zcdim.F" !" 格子点数, 波数 #include "zhdim.F" !" 文字数 #include "zldim.F" !" パラメター数, 係数行列 #endif * * [INPUT] REAL GROWTH( NUMEIG ) !" 成長率 REAL FRQENC( NUMEIG ) !" 振動数 * INTEGER NUMEIG !" 固有値の数 CHARACTER FNGROW * (NFILN) !" 成長率出力ファイル名 CHARACTER FNFREQ * (NFILN) !" 振動数出力ファイル名 * * * [INTERNAL PARM] INTEGER JFGRW , JFFRQ INTEGER JFGRWD, JFFRQD DATA JFGRWD, JFFRQD / 52 , 53 / * INTEGER ITA !" 通し時間(t), 標準時間単位 INTEGER ITB !" 通し時間(t-Δt), 標準時間 INTEGER IDATEA ( 6 ) !" 日付( ダミー ) INTEGER IDATEB ( 6 ) !" 日付( ダミー ) INTEGER ISTEP REAL DELT LOGICAL OADVNC INTEGER ITDUR DATA ITDUR / 1 / * CHARACTER HDFMT *(NCC) !" データフォーマット DATA HDFMT / 'UR4' / REAL VMISS !" 欠損値の値 * * [INTERNAL WORK] CHARACTER HHGROW( NDC )*(NCC) !" 成長率ヘッダー CHARACTER HHFREQ( NDC )*(NCC) !" 振動数ヘッダー * INTEGER IERR !" ファイルオープンエラー記述子 * LOGICAL OFIRST DATA OFIRST / .TRUE. / * SAVE * IF( OFIRST )THEN OFIRST = .FALSE. * *" < 1.ファイルオープン > * CALL IFLOPN O ( JFGRW , IERR , I FNGROW, JFGRWD, 'WRITE', 'UNFORMATTED' ) * IF( IERR .GT. 0 )THEN CALL MSGDMP( 'E', 'EIALWR', 'CANNOT OPEN FILE' ) ENDIF * CALL IFLOPN O ( JFFRQ , IERR , I FNFREQ, JFFRQD, 'WRITE', 'UNFORMATTED' ) * IF( IERR .GT. 0 )THEN CALL MSGDMP( 'E', 'EIALWR', 'CANNOT OPEN FILE' ) ENDIF * ENDIF * *" < 2. ヘッダー作成 > * CALL GZDBGT( 'MISS' , VMISS ) * CALL EIALHD O ( HHGROW , HHFREQ , I NUMEIG , I HDFMT , VMISS , I VMISS , VMISS , VMISS , VMISS , 1 ) * *" < 4. ファイル書き込み > * CALL INQTIM O ( ITA , ITB , IDATEA, IDATEB, O ISTEP , DELT , OADVNC ) * CALL GZDBWX !" 精度変換書き込み ; パラメターを時間として書きこむ I ( HHGROW , GROWTH , I ITA , IDATEA , ISTEP , ITDUR , I JFGRW , 1 , 0 , HDFMT ) * CALL GZDBWX !" 精度変換書き込み ; パラメターを時間として書きこむ I ( HHFREQ , FRQENC , I ITA , IDATEA , ISTEP , ITDUR , I JFFRQ , 1 , 0 , HDFMT ) * RETURN END ******************************************************************* SUBROUTINE EIALHD !" パラメター空間ヘッダー作成 O ( HHGROW , HHFREQ , I NUMEIG , I HDFMT , VMISS , I DMIN , DMAX , DIVS , DIVL , ISTYP ) * * [PARAM] #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数, 波数 INCLUDE (ZHDIM) !" 文字数 INCLUDE (ZLDIM) !" パラメター数, 係数行列 #else #include "zcdim.F" !" 格子点数, 波数 #include "zhdim.F" !" 文字数 #include "zldim.F" !" パラメター数, 係数行列 #endif * * * [OUTPUT] CHARACTER HHGROW ( * ) * ( * ) !" 成長率ヘッダー CHARACTER HHFREQ ( * ) * ( * ) !" 振動数ヘッダー * * [INPUT] INTEGER NUMEIG !" 固有値の数 * CHARACTER HDFMT *(*) !" データフォーマット REAL VMISS !" 欠損値の値 REAL DMIN !" レンジ(最小) REAL DMAX !" レンジ(最大) REAL DIVS !" 間隔(小) REAL DIVL !" 間隔(大) INTEGER ISTYP !" スケーリングタイプ * * [INTERNAL WORK] * CHARACTER HUNIT*(NCC) !" 単位 DATA HUNIT / '1/s' / CHARACTER HUTIM*(NCC) !" 時刻単位 DATA HUTIM / 'DAY' / * CHARACTER HAITM1*(NCC) !" 軸1の格子名称 c$$$ CHARACTER HAITM2*(NCC) !" 軸2の格子名称 c$$$ CHARACTER HAITM3*(NCC) !" 軸3の格子名称 * CHARACTER HAITMM*(NCC) !" 軸1の格子名称 DATA HAITMM / '.MODE' / * CHARACTER HRUN *(NCC) !" 実験名 INTEGER NHR LOGICAL OFIRST DATA OFIRST / .TRUE. / * * [EXTERNAL FUNC] INTEGER LENC * SAVE * *" < 0. 軸名称設定 > * IF ( OFIRST ) THEN OFIRST = .FALSE. CALL GTCGET( 'DDSET' , HRUN ) NHR = LENC( HRUN ) HAITM1 = HRUN(1:NHR) // HAITMM ENDIF * *" < 1. パラメター設定 > * CALL GTOPEN CALL GTSIZE ( HHGROW , NUMEIG ) CALL GTSIZE ( HHFREQ , NUMEIG ) * *" < 3. ヘッダー設定 > * CALL GZDBHP !" 識別記述子のパック O ( HHGROW , I ' ' , 'GROWTH' , 1 , 1 , I 'growth rate' , HUNIT , I 0 , ' ' , HUTIM , 1 , I HAITM1, 1 , NUMEIG, I ' ' , 1 , 1 , I ' ' , 1 , 1 , I HDFMT , VMISS , I DMIN , DMAX , DIVS , DIVL , I ISTYP , I ' ' , ' ' ) * CALL GZDBHP !" 識別記述子のパック O ( HHFREQ , I ' ' , 'FRQENC' , 1 , 1 , I 'frequency' , HUNIT , I 0 , ' ' , HUTIM , 1 , I HAITM1, 1 , NUMEIG, I ' ' , 1 , 1 , I ' ' , 1 , 1 , I HDFMT , VMISS , I DMIN , DMAX , DIVS , DIVL , I ISTYP , I ' ' , ' ' ) * RETURN END