* PACKAGE IRWSTR !" SHALO 初期値入出力 * *" [HIS] 90/08/31(numaguti) *" 92/04/03(takepiro) *" 96/11/14(takepiro) * ********************************************************************** SUBROUTINE IRSTRT !" 初期値の読み込み O ( GAU , GAV , GAPHI , O GBU , GBV , GBPHI , O ITA , ITB , IDATEA, IDATEB, ISTEP , C ITSTRT ) * #if SYS_IBMS INCLUDE (ZCDIM) !" 格子点数, 波数 INCLUDE (ZHDIM) !" 文字列文字数 #else #include "zcdim.F" !" 格子点数, 波数 #include "zhdim.F" !" 文字列文字数 #endif * REAL GAU ( IDIM, JDIM, KMAX ) !" 西風 ｕ(t) REAL GBU ( IDIM, JDIM, KMAX ) !" 西風 ｕ(t-Δt) REAL GAV ( IDIM, JDIM, KMAX ) !" 南風 ｖ(t) REAL GBV ( IDIM, JDIM, KMAX ) !" 南風 ｖ(t-Δt) REAL GAPHI ( IDIM, JDIM, KMAX ) !" 層厚 φ(t) REAL GBPHI ( IDIM, JDIM, KMAX ) !" 層厚 φ(t-Δt) * INTEGER ISTEP !" 通しステップ数 INTEGER ITA !" 通し時間(t) INTEGER ITB !" 通し時間(t-Δt) INTEGER IDATEA( * ) !" 時刻：年月日時分秒 INTEGER IDATEB( * ) !" 時刻：年月日時分秒 * INTEGER ITSTRT !" 計算開始時刻 * * [INTERNAL WORK] INTEGER ITINIT !" 初期データ時刻 INTEGER IFILED , IOMODE INTEGER IFPAR , JFPAR INTEGER IFLSTR , IERR, ITDUR, ISTEPA INTEGER IEODU, IEODV, IEODP, IEOD INTEGER II * * [INTERNAL PARAM] CHARACTER FILE *(NFILN) !" 入力ファイル：初期値 CHARACTER TUNIT *4 !" 時刻単位 INTEGER TINIT !" 初期データ時刻 * NAMELIST /NMINIT/ FILE, TUNIT, TINIT * DATA FILE / ' ' / DATA TUNIT / 'DAY ' / DATA TINIT / -999 / * DATA IFILED / 95 / DATA IOMODE / 0 / * *" < 0. 初期値データの設定 > * CALL REWNML ( IFPAR , JFPAR ) READ ( IFPAR, NMINIT, END=190 ) 190 WRITE ( JFPAR, NMINIT ) * IF ( TINIT .NE. -999 ) THEN CALL ACTIME ( TINIT, TUNIT, '#', ITINIT ) ELSE ITINIT = ITSTRT ENDIF * CALL IFLOPN O ( IFLSTR, IERR , I FILE , IFILED, 'READ', 'UNFORMATTED' ) * *" < 1. 初期値の読み込み (GB) > * WRITE ( 6,* ) ' TRY TO READ HIST AT T = ', ITSTRT * 1100 CONTINUE * CALL GDREAD O ( GBU , IEODU , O ITB , IDATEB, ISTEP , ITDUR , I IFLSTR, 'GBU' , IOMODE, 'ALEV' ) * IF ( IEODU .EQ. 0 ) THEN WRITE ( 6,* ) ' READ HIST AT T = ', ITB ENDIF IF ( ( ITB .LT. ITSTRT ) .AND. ( IEODU .EQ. 0 ) ) THEN GOTO 1100 *" ------> 次のデータ -----> ENDIF * CALL GDREAD O ( GBV , IEODV , O ITB , IDATEB, ISTEP , ITDUR , I IFLSTR, 'GBV' , IOMODE, 'ALEV' ) * CALL GDREAD O ( GBPHI , IEODP , O ITB , IDATEB , ISTEP , ITDUR , I IFLSTR, 'GBPHI', IOMODE, 'ALEV' ) * * *" < 2. なければストップ > * IEOD = IEODU + IEODV + IEODP IF ( IEOD .GE. 1 ) THEN WRITE (6,*) ' 初期値がありません. ', & IEODU, IEODV, IEODP STOP 2000 ENDIF * *" < 3. 初期値の読み込み (GA) > * CALL GDREAD O ( GAU , IEODU , O ITA , IDATEA, ISTEPA, ITDUR , I IFLSTR, 'GAU' , IOMODE, 'ALEV' ) * IF ( ISTEPA .NE. ISTEP ) THEN IEODU = 1 ENDIF * CALL GDREAD O ( GAV , IEODV , O ITA , IDATEA, ISTEPA, ITDUR , I IFLSTR, 'GAV' , IOMODE, 'ALEV' ) * CALL GDREAD O ( GAPHI , IEODV , O ITA , IDATEA , ISTEPA, ITDUR , I IFLSTR, 'GAPHI', IOMODE, 'ALEV' ) * *" < 4. GA なし → GA = GB > * IEOD = IEODU + IEODV + IEODP IF ( IEOD .GE. 1 ) THEN * WRITE (6,*) ' 初期値ＧＡがありません.', & ' ＧＡ＝ＧＢを仮定します.', & IEODU, IEODV, IEODP * CALL COPY ( GAU , GBU , IDIM*JDIM*KMAX ) CALL COPY ( GAV , GBV , IDIM*JDIM*KMAX ) CALL COPY ( GAPHI , GBPHI , IDIM*JDIM*KMAX ) * ITA = ITB DO 4100 II = 1,5 IDATEA( II ) = IDATEB( II ) 4100 CONTINUE * ENDIF * CLOSE ( IFLSTR ) * RETURN END *********************************************************************** SUBROUTINE IWRSTR !" リスタート・ファイルの書き込み I ( GAU , GAV , GAPHI , I GBU , GBV , GBPHI , I ITA , ITB , IDATEA, IDATEB, ISTEP ) * #if SYS_IBMS INCLUDE (ZCDIM) !" 格子点数，波数 INCLUDE (ZHDIM) !" 文字列文字数 #else #include "zcdim.F" !" 格子点数，波数 #include "zhdim.F" !" 文字列文字数 #endif * REAL GAU ( IDIM, JDIM, KMAX ) !" 西風 ｕ(t) REAL GBU ( IDIM, JDIM, KMAX ) !" 西風 ｕ(t-Δt) REAL GAV ( IDIM, JDIM, KMAX ) !" 南風 ｖ(t) REAL GBV ( IDIM, JDIM, KMAX ) !" 南風 ｖ(t-Δt) REAL GAPHI ( IDIM, JDIM, KMAX ) !" 層厚 φ(t) REAL GBPHI ( IDIM, JDIM, KMAX ) !" 層厚 φ(t-Δt) * INTEGER ISTEP !" 通しステップ数 INTEGER ITA !" 通し時間(t) INTEGER ITB !" 通し時間(t-Δt) INTEGER IDATEA( * ) !" 時刻：年月日時分秒 INTEGER IDATEB( * ) !" 時刻：年月日時分秒 * * [INTERNAL PARAM] CHARACTER FILE * (NFILN) !" 出力ファイル：再出発 CHARACTER DFMT * (NCC) !" 出力フォーマット DATA FILE / 'shallow.rst' / DATA DFMT / 'UR8' / * INTEGER IFPAR , JFPAR INTEGER JFLRST , IERR * INTEGER JFILED, IOMODE, NOEND, ITDUR DATA JFILED / 97 / DATA IOMODE / 0 / DATA NOEND / 0 / DATA ITDUR / 1 / LOGICAL OFIRST DATA OFIRST / .TRUE. / SAVE IOMODE, OFIRST, JFLRST, FILE, DFMT * NAMELIST /NMRSTR/ FILE, DFMT * IF ( OFIRST ) THEN OFIRST = .FALSE. * CALL REWNML ( IFPAR , JFPAR ) READ ( IFPAR, NMRSTR, END=1090 ) 1090 WRITE ( JFPAR, NMRSTR ) * CALL IFLOPN O ( JFLRST, IERR , I FILE , JFILED, 'WRITE', 'UNFORMATTED' ) ENDIF * *" < 1. ファイル出力 (GB) > * CALL GDWRIT I ( GBU , I 'GBU' , 'u-velocity @ t ','1/s' , I ITB , IDATEB, ISTEP , ITDUR , I JFLRST, IOMODE, NOEND , 'ALEV', DFMT ) * CALL GDWRIT I ( GBV , I 'GBV' , 'v-velocity @ t ','1/s' , I ITB , IDATEB, ISTEP , ITDUR , I JFLRST, IOMODE, NOEND , 'ALEV', DFMT ) * CALL GDWRIT I ( GBPHI , I 'GBPHI', 'geopotential @ t ','(m/s)**2' , I ITB , IDATEB, ISTEP , ITDUR , I JFLRST, IOMODE, NOEND , 'ALEV', DFMT ) * *" < 2. ファイル出力 (GA) > * CALL GDWRIT I ( GAU , I 'GAU' , 'u-velocity @ t+dt ','1/s' , I ITA , IDATEA, ISTEP , ITDUR , I JFLRST, IOMODE, NOEND , 'ALEV', DFMT ) * CALL GDWRIT I ( GAV , I 'GAV' , 'v-velocity @ t+dt ','1/s' , I ITA , IDATEA, ISTEP , ITDUR , I JFLRST, IOMODE, NOEND , 'ALEV', DFMT ) * CALL GDWRIT I ( GAPHI , I 'GAPHI', 'geopotential @ t +dt ','(m/s)**2' , I ITA , IDATEA, ISTEP , ITDUR , I JFLRST, IOMODE, NOEND , 'ALEV', DFMT ) * RETURN END