* PACKAGE IHIST !" ヒストリーパッケージ * * [SRC] $CCSR/model/agcm5/src/io/ihist.F * [DOC] $CCSR/model/agcm5/doc/io.tex * [VER] 92/06/18(numaguti) * [HIS] *********************************************************************** SUBROUTINE HISTOU !" 時間平均ヒストリー・ファイル出力 * * 内部にデータを格納し, 平均をとって出力する. * * #ifdef SYS_IBMS INCLUDE (ZCDIM) !" 格子点数，波数 INCLUDE (ZIDIM) !" 出力の数 INCLUDE (ZHDIM) !" 文字数 #else #include "zcdim.F" !" 格子点数，波数 #include "zidim.F" !" 出力の数 #include "zhdim.F" !" 文字数 #endif * * [ENTRY INPUT] REAL GDATA ( * ) !" データ CHARACTER HITEM *(*) !" 変数名 CHARACTER HTITL *(*) !" タイトル CHARACTER HUNIT *(*) !" 単位 CHARACTER HCORD *(*) !" 座標系 REAL DMINX !" データレンジ REAL DMAXX !" データレンジ REAL DIVSX !" データ目盛 REAL DIVLX !" データ目盛 INTEGER ISTYPX !" スケールタイプ * CHARACTER FILEM *(*) !" ファイル名 CHARACTER TUNITM *(*) !" 時間単位 INTEGER INTOUM !" 出力間隔 INTEGER INTSMM !" 積算間隔 CHARACTER AVRTYM *(*) !" 積算間隔 CHARACTER DFORMM *(*) !" 出力フォーマット * * [INTERNAL SAVE] REAL GOUT ( NHDIM ) !" 積算領域 INTEGER ITOUT ( NHIST ) !" 経過時間 INTEGER ITSUM ( NHIST ) !" 積算時間 INTEGER INNUM ( NHIST ) !" 積算回数 INTEGER ITPRV ( NHIST ) !" 直前の足し込みの時刻 INTEGER ITEND ( NHIST ) !" ENDFILE経過時間 * CHARACTER HHEADH ( NDC,NHIST )*(NCC) !" ヘッダー CHARACTER HITEMH ( NHIST )*(NCC) !" 変数名 CHARACTER HCORDH ( NHIST )*(NCC) !" 座標系 CHARACTER HTYPEH ( NHIST )*(NCC) !" 平均種類 CHARACTER HUTDSH ( NHIST )*(NCC) !" 表示時間単位 INTEGER INDEXH ( NHIST ) !" 開始添字 INTEGER ISIZEH ( NHIST ) !" 大きさ INTEGER JFILEH ( NHIST ) !" ファイル番号 INTEGER INTENH ( NHIST ) !" ENDFILEの間隔 INTEGER INTOUH ( NHIST ) !" 出力間隔 INTEGER INTSMH ( NHIST ) !" 積算時間 INTEGER IMEANH ( NHIST ) !" 平均か積算か INTEGER IHMAX !" 登録済みの数 DATA IHMAX / 0 / * * [INTERNAL PARAM] INTEGER IWFL, ISTDIO DATA IWFL / 50 / !" 装置番号 DATA ISTDIO / 6 / !" 書式付出力装置番号 INTEGER IOMODE !" 出力モード DATA IOMODE / 0 / * INTEGER IFOUT ( 100 ) DATA IFOUT / 100*0 / INTEGER IFNUM ( 100 ) DATA IFNUM / 100*1 / * INTEGER ITOLD DATA ITOLD / 0 / LOGICAL OFIRST, OADDED DATA OFIRST, OADDED / .TRUE., .FALSE. / SAVE * * [INTERNAL WORK] INTEGER ITA !" 通し時間(秒) INTEGER ISTEP !" 通しステップ数 INTEGER IDATEA ( 6 ) !" 時刻年月日時分秒 INTEGER IDATEB ( 6 ) LOGICAL OADVNC * CHARACTER HMSG * 100 CHARACTER HHEAD ( NDC )*(NCC) !" ヘッダー * CHARACTER ITEM *(NCC) !" 変数名 CHARACTER FILE ( 2 ) *(NFILN) !" ファイル名 CHARACTER TUNIT ( 2 ) *(NCC) !" 時間単位 INTEGER INTOUT( 2 ) !" 出力間隔 INTEGER INTSUM( 2 ) !" 積算間隔 CHARACTER AVRTYP( 2 ) *(NCC) !" 積算間隔 CHARACTER DFORM ( 2 ) *(NCC) !" 出力フォーマット INTEGER INTEND( 2 ) !" ENDFILE処理間隔 REAL VMISS REAL DMIN REAL DMAX REAL DIVS REAL DIVL INTEGER ISTYP * NAMELIST /NMHIST/ ITEM , O FILE , TUNIT , INTOUT, INTSUM, AVRTYP, O DFORM , INTEND, VMISS , & DMIN , DMAX , DIVS , DIVL , ISTYP * INTEGER ITB, IDELTH, IDELTI INTEGER IH, ID, IND, IW, IMULT INTEGER IFPAR, JFPAR, JFILE, ISIZE, IERR INTEGER INTOUS, INTSUS, INTENS REAL DELT * CALL INQTIM O ( ITA , ITB , IDATEA, IDATEB, O ISTEP , DELT , OADVNC ) * IDELTH = ITA - ITOLD ITOLD = ITA * DO 4500 IH = 1, IHMAX * ITOUT ( IH ) = ITOUT ( IH ) + IDELTH * IF ( ( ITOUT( IH ) .GE. INTOUH( IH ) ) & .AND.( INNUM( IH ) .GT. 0 ) ) THEN * *" < 1. 時間平均値の計算 > * IF ( IMEANH( IH ) .GT. 0 ) THEN DO 1100 ID = INDEXH( IH ), INDEXH( IH )+ISIZEH( IH )-1 GOUT ( ID ) = GOUT ( ID ) / REAL( ITSUM ( IH ) ) 1100 CONTINUE ENDIF * *" < 2. ファイル出力 > * CALL GHCOPY ( HHEADH(1,IH), HHEAD ) * IF ( INNUM( IH ) .GE. 2 ) THEN CALL HHEDIT I ( HHEAD , I ITSUM (IH), IMEANH(IH), HUTDSH(IH) ) ENDIF * IF ( JFILEH(IH) .NE. ISTDIO ) THEN * CALL GHCGET ( HHEAD, 'DFMT', DFORM(1) ) CALL GZDBWX I ( HHEAD , GOUT( INDEXH(IH) ), I ITA , IDATEA, ISTEP , ITSUM(IH), I JFILEH(IH) , IOMODE, 0 , DFORM(1) ) * IF ( (1 .LE. JFILEH(IH)).AND.(JFILEH(IH) .LT. 100) ) THEN IFOUT( JFILEH(IH) ) = IFOUT( JFILEH(IH) ) + 1 ENDIF ELSE CALL HMONIT I ( HHEAD , GOUT( INDEXH(IH) ) , I ITA , IDATEA, ISTEP , ITSUM(IH) ) ENDIF * *" < 3. 出力後時間平均作業領域リセット > * CALL RESET( GOUT( INDEXH(IH) ), ISIZEH(IH) ) ITSUM ( IH ) = 0 INNUM ( IH ) = 0 IF ( INTOUH( IH ) .GT. 0 ) THEN ITOUT( IH ) = MOD( ITOUT( IH ), INTOUH( IH ) ) ELSE ITOUT( IH ) = 0 ENDIF * ELSE IF ( ITSUM( IH ) .GE. INTSMH( IH ) ) THEN * *" < 4. 時間平均を出力せずクリアー > * CALL RESET( GOUT( INDEXH(IH) ), ISIZEH(IH) ) ITSUM ( IH ) = 0 INNUM ( IH ) = 0 * ENDIF * 4500 CONTINUE * *" < 4.1 ENDFILE 処理 > * DO 4600 IH = 1, IHMAX * ITEND( IH ) = ITEND( IH ) + IDELTH IF ( ( INTENH( IH ) .GT. 0 ) .AND. & ( ITEND( IH ) .GE. INTENH( IH ) ) ) THEN * IF ( ( JFILEH(IH) .NE. ISTDIO ) .AND. & ( (1 .LE. JFILEH(IH)).AND.(JFILEH(IH) .LT. 100) ) ) & THEN * IF ( IFOUT( JFILEH(IH) ) .GT. 0 ) THEN ENDFILE( JFILEH(IH) ) WRITE (6,4660) JFILEH(IH), IFNUM( JFILEH(IH) ) 4660 FORMAT (' === END OF OUTPUT FILE FT',I2.2,'F',I3.3 ) IFOUT( JFILEH(IH) ) = 0 IFNUM( JFILEH(IH) ) = IFNUM( JFILEH(IH) ) + 1 ENDIF * ENDIF * ITEND( IH ) = MOD( ITEND( IH ), INTENH( IH ) ) * ENDIF * 4600 CONTINUE * RETURN *====================================================================== ENTRY HISTIN !" 時間平均ヒストリーの足し込み I ( GDATA , C HITEM ) * *" < 5. HITEM を探し, そこに足し込む > * CALL INQTIM O ( ITA , ITB , IDATEA, IDATEB, O ISTEP , DELT , OADVNC ) * DO 5100 IH = 1, IHMAX IF ( HITEM .EQ. HITEMH( IH ) ) THEN * IDELTI = ITA - ITPRV( IH ) ITPRV( IH ) = ITA * IF ( IMEANH( IH ) .GT. 0 ) THEN IMULT = IDELTI ELSE IMULT = 1 ENDIF * CALL HSTADD M ( GOUT( INDEXH( IH ) ) , I GDATA , IMULT , I HCORDH(IH), HTYPEH(IH) ) * ITSUM ( IH ) = ITSUM ( IH ) + IDELTI INNUM ( IH ) = INNUM ( IH ) + 1 * ENDIF 5100 CONTINUE * RETURN *====================================================================== ENTRY HISTRG !" 時間平均ヒストリーの登録 I ( HITEM , HTITL , HUNIT , HCORD , I DMINX , DMAXX , DIVSX , DIVLX , ISTYPX, I FILEM , TUNITM, INTOUM, INTSMM, AVRTYM, DFORMM ) * CALL INQTIM O ( ITA , ITB , IDATEA, IDATEB, O ISTEP , DELT , OADVNC ) * IF ( OFIRST ) THEN OFIRST = .FALSE. ITOLD = ITB DO 6000 IH = 1, NHIST ITOUT ( IH ) = 0 ITEND ( IH ) = 0 6000 CONTINUE ENDIF * *" < 6. すでにあるか探す > * IND = 1 DO 6100 IH = 1, IHMAX IF ( HITEM .EQ. HITEMH( IH ) ) THEN HMSG = 'HISTORY '//HITEM//' IS ALREADY REGISTERED' CALL MSGDMP( 'W', 'HISTRG', HMSG ) RETURN ENDIF IND = IND + ISIZEH( IH ) 6100 CONTINUE * *" < 7. パラメータ読み込み > * WRITE ( 6,* ) ' HISTORY CONTROL ', HITEM, ' :' CALL REWNML ( IFPAR , JFPAR ) * *..........loop 7100 CONTINUE DMIN = DMINX DMAX = DMAXX DIVS = DIVSX DIVL = DIVLX ISTYP = ISTYPX CALL GZDBGT( 'MISS', VMISS ) CALL HQDEFP O ( FILE , TUNIT , INTOUT, INTSUM, AVRTYP, DFORM , INTEND , I FILEM , TUNITM, INTOUM, INTSMM, AVRTYM, DFORMM ) * ITEM = ' ' * READ ( IFPAR, NMHIST, END=7190 ) *" > END >-----> @@) IF ( ITEM .NE. HITEM ) THEN GOTO 7100 *..........loop ENDIF * 7190 CONTINUE WRITE ( JFPAR, NMHIST ) * DO 9000 IW = 1, 2 * IF ( FILE(IW) .NE. ' ' ) THEN * *" < 8. ファイルのオープン > * CALL IFLOPN O ( JFILE , IERR , I FILE(IW) , IWFL , 'WRITE', 'UNFORMATTED' ) * IF ( IERR .NE. 0 ) THEN HMSG = 'FILE OPEN ERROR :'//FILE(IW) CALL MSGDMP( 'E', 'HISTRG', HMSG ) RETURN ENDIF * *" < 9. 登録 > * IF ( IHMAX .GE. NHIST ) THEN HMSG = 'NUMBER OF HISTRY IS OVER LIMIT.' CALL MSGDMP( 'E', 'HISTRG', HMSG ) RETURN ENDIF * CALL HSTHED O ( HHEAD , ISIZE , I HCORD , AVRTYP(IW) , I HITEM , HTITL , HUNIT , I DFORM(IW) , VMISS , I DMIN , DMAX , DIVS , DIVL , ISTYP ) * IF ( IND+ISIZE .GT. NHDIM+1 ) THEN HMSG = 'HISTRY AREA IS FULL.' CALL MSGDMP( 'W', 'HISTRG', HMSG ) IND = IND + ISIZE GOTO 9800 ENDIF * IHMAX = IHMAX + 1 * CALL ACTIME ( INTOUT(IW) , TUNIT(IW), '#' , O INTOUS ) CALL ACTIME ( ABS(INTSUM(IW)), TUNIT(IW), '#' , O INTSUS ) CALL ACTIME ( INTEND(IW) , TUNIT(IW), '#' , O INTENS ) * CALL GHCOPY ( HHEAD, HHEADH( 1,IHMAX ) ) HITEMH( IHMAX ) = HITEM HUTDSH( IHMAX ) = TUNIT (IW) HCORDH( IHMAX ) = HCORD HTYPEH( IHMAX ) = AVRTYP(IW) INDEXH( IHMAX ) = IND ISIZEH( IHMAX ) = ISIZE JFILEH( IHMAX ) = JFILE INTENH( IHMAX ) = INTENS INTOUH( IHMAX ) = INTOUS INTSMH( IHMAX ) = INTSUS IF ( INTSUM(IW) .LT. 0 ) THEN IMEANH( IHMAX ) = 0 ELSE IMEANH( IHMAX ) = 1 ENDIF * CALL RESET( GOUT( INDEXH(IHMAX) ), ISIZEH(IHMAX) ) ITSUM ( IHMAX ) = 0 INNUM ( IHMAX ) = 0 ITPRV ( IHMAX ) = ITB * IND = IND + ISIZE OADDED = .TRUE. ENDIF 9000 CONTINUE * RETURN *====================================================================== ENTRY HISTRP !" 時間平均ヒストリー登録状況表示 * 9800 CONTINUE * IF ( OADDED ) THEN OADDED = .FALSE. * WRITE ( 6,* ) ' ####### HISTORY USAGE REPORT ########' * WRITE ( 6,9600 ) 'ITEM', 'TYPE', 'FILE', & 'SIZE', 'INDEX', & 'INTOUT', 'INTSUM' DO 9500 IH = 1, IHMAX WRITE ( 6, 9610 ) HITEMH(IH), HTYPEH(IH), JFILEH(IH), & ISIZEH(IH), INDEXH(IH), & INTOUH(IH), INTSMH(IH) 9500 CONTINUE WRITE ( 6,* ) ' TOTAL NUMBER = ', IHMAX, & ' TOTAL SIZE = ', IND-1 ENDIF * 9600 FORMAT(' ',A4,14X, A4, 2X,A4, 5X,A4, 6X,A5, 5X,A6, 5X,A6) 9610 FORMAT(' ',A16,2X, A4, 2X,I4, 2X,I7, 2X,I9, 2X,I9, 2X,I9) * IF ( IND .GT. NHDIM+1 ) THEN CALL MSGDMP( 'E', 'HISTRP', ' HISTORY AREA IS FULL' ) ENDIF * RETURN END