!= Module HistoryFileIOMPI ! ! Authors:: SUGIYAMA Ko-ichiro ! Version:: $Id: historyfileiompi.f90,v 1.9 2011-03-30 13:53:07 sugiyama Exp $ ! Tag Name:: $Name: arare4-20120911 $ ! Copyright:: Copyright (C) GFD Dennou Club, 2006. All rights reserved. ! License:: See COPYRIGHT[link:../../COPYRIGHT] ! !== Overview ! !ファイル出力. 長い時間ステップの値を出力. ! !== Error Handling ! !== Known Bugs ! !== Note ! !== Future Plans ! module HistoryFileIOMPI ! !ファイル出力. 長い時間ステップの値を出力. ! !モジュール読み込み use gt4_history, only: HistoryCreate, HistoryPut, HistoryAddVariable, & & HistoryClose, gt_history use gridset, only: s_X, &!X 座標軸(スカラー格子点) & s_Z, &!Z 座標軸(スカラー格子点) & FileNX, &!X 方向の格子点(ファイル出力) & FileNZ, &!Z 方向の格子点(ファイル出力) & FileXMin, &!X 方向の配列の下限(ファイル出力) & FileXMax, &!X 方向の配列の上限(ファイル出力) & FileZMin, &!Z 方向の配列の下限(ファイル出力) & FileZMax, &!Z 方向の配列の上限(ファイル出力) & DimXMin, &!X 方向の配列の下限 & DimXMax, &!X 方向の配列の上限 & DimZMin, &!Z 方向の配列の下限 & DimZMax, &!Z 方向の配列の上限 & XMin, &!X 方向の始点 & XMax, &!X 方向の終点 & SpcNum !凝縮成分の数 use basicset, only: xz_ExnerBasicZ, &!基本場のエクスナー関数 & xz_DensBasicZ, &!基本場の密度 & xz_PotTempBasicZ, &!基本場の温位 & xz_VelSoundBasicZ, &!基本場の音速 & xz_PressBasicZ, &!基本場の圧力 & xz_TempBasicZ, &!基本場の温度 & xza_MixRtBasicZ, &!基本場の混合比 & xz_EffMolWtBasicZ, &!基本場の分子量効果 & SpcWetSymbol !湿潤成分の化学種名 use fileset, only:HistoryFile, &!ヒストリファイル名 & exptitle, &!データの表題 & expsrc, &!データを作成する手順 & expinst, &!最終変更者・組織 & FileNum, &!ヒストリファイルの数 & gt_hist !gt_history 型構造体変数 use StorePotTemp, only: StorePotTempMeanX, z_Adv, z_Turb, z_Disp, z_Diff, z_Rad, z_Cond, z_Flux,z_Damp, za_Cond2, z_Cond3 use StoreMixRt, only: StoreMixRtMeanX, za_Adv, za_Turb, za_Diff, za_Flux, za_Rain, za_Fill1, za_Fill2, za_Cond use mpi_wrapper, only : myrank !暗黙の型宣言禁止 implicit none !属性の指定 private !関数を public に指定 public HistoryFile_Open public HistoryFile_OutPut public HistoryFile_Close contains !!!------------------------------------------------------------------------ subroutine HistoryFile_Open( ) ! !ヒストリファイルの定義 ! !暗黙の型宣言禁止 implicit none !変数定義 integer :: s ! ループ添字 real(8) :: spc(1:SpcNum) do s = 1, SpcNum spc(s) = real(s, 8) end do !----------------------------------------------------------- ! ヒストリー作成 !----------------------------------------------------------- do s = 1, FileNum call HistoryCreate( & & file = HistoryFile(s), & & title = exptitle, & & source = expsrc, & & institution = expinst, & ! & dims=(/'x','z','t'/), & & dims=(/'x','z','s','t'/), & ! & dimsizes=(/FileNX, FileNZ, 0/), & & dimsizes=(/FileNX, FileNZ, SpcNum, 0/), & & longnames=(/'X-coordinate', & & 'Z-coordinate', & & 'Species ', & & 'Time '/), & ! & units=(/'m','m','s'/), origin=0.0, & & units=(/'m ','m ','1 ','sec'/), origin=0.0, & & interval=0.0, & & history=gt_hist(s), quiet=.true. ) call HistoryPut('x', s_X( FileXMin: FileXMax ) + myrank * (XMax - XMin), gt_hist(s) ) call HistoryPut('z', s_Z( FileZMin: FileZMax ), gt_hist(s) ) call HistoryPut('s', spc(1:SpcNum), gt_hist(s) ) ! call HistoryPut('z', xz_PressBasicZ( 1, FileZMin: FileZMax ), gt_hist(s) ) end do !----------------------------------------------------------- ! 予報変数の出力 !----------------------------------------------------------- !無次元圧力の擾乱 call HistoryAddVariable( & & varname='Exner', & & dims=(/'x','z','t'/), & & longname='disturbunce of nondimensional pressure', & & units=' ', & & xtype='double', & & history=gt_hist(1) ) !温位の擾乱 call HistoryAddVariable( & & varname='PotTemp', & & dims=(/'x','z','t'/), & & longname='disturbunce of potential temperature', & & units='K', & & xtype='double', & & history=gt_hist(2) ) !水平速度 call HistoryAddVariable( & & varname='VelX', & & dims=(/'x','z','t'/), & & longname='zonal velocity', & & units='m s|-1"', & & xtype='double', & & history=gt_hist(3) ) !鉛直速度 call HistoryAddVariable( & & varname='VelZ', & & dims=(/'x','z','t'/), & & longname='vertical velocity', & & units='m s|-1"', & & xtype='double', & & history=gt_hist(4) ) !渦粘性係数(運動量) call HistoryAddVariable( & & varname='Km', & & dims=(/'x','z','t'/), & & longname='turbulet diffusion coefficient', & & units='1', & & xtype='double', & & history=gt_hist(5) ) !渦粘性係数(熱) call HistoryAddVariable( & & varname='Kh', & & dims=(/'x','z','t'/), & & longname='turbulet diffusion coefficient for heat', & & units='1', & & xtype='double', & & history=gt_hist(6) ) !混合比 do s = 1, SpcNum call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s)), & & dims=(/'x','z','t'/), & & longname=trim(SpcWetSymbol(s))//' Mixing Ratio', & & units='kg kg|-1"', & & xtype='double', & & history=gt_hist(8+s)) end do !---------------------------------------------------------------- ! 温位の時間変化 !---------------------------------------------------------------- call HistoryAddVariable( & & varname='PotTempAdv', & & dims=(/'z','t'/), & & longname='Advection term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempTurb',& & dims=(/'z','t'/), & & longname='Turbulence term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempDisp',& & dims=(/'z','t'/), & & longname='Dissipation term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempRad', & & dims=(/'z','t'/), & & longname='Radiation term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempDiff',& & dims=(/'z','t'/), & & longname='Numerical diffusion term of potential temperature',& & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempCond',& & dims=(/'z','t'/), & & longname='Latent heat term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempCond2',& & dims=(/'z','s','t'/), & & longname='Latent heat term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempCond3',& & dims=(/'z','t'/), & & longname='Latent heat term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempFlux',& & dims=(/'z','t'/), & & longname='Surface Flux term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname='PotTempDamp',& & dims=(/'z','t'/), & & longname='Newtonian Cooling term of potential temperature', & & units='K day|-1"', & & xtype='double', & & history=gt_hist(8) ) !---------------------------------------------------------------- ! Mixing Ratio time change !---------------------------------------------------------------- do s = 1, SpcNum call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'_Adv', & & dims=(/'z','t'/), & & longname='Advection term of ' & & //trim(SpcWetSymbol(s))//' mixing ratio', & & units='kg kg|-1" s|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'_Turb', & & dims=(/'z','t'/), & & longname='Turbulence term of ' & & //trim(SpcWetSymbol(s))//' mixing ratio', & & units='kg kg|-1" s|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'_Diff', & & dims=(/'z','t'/), & & longname='Diffusion term of ' & & //trim(SpcWetSymbol(s))//' mixing ratio', & & units='kg kg|-1" s|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'_Flux', & & dims=(/'z','t'/), & & longname='Surface Flux term of ' & & //trim(SpcWetSymbol(s))//' mixing ratio', & & units='kg kg|-1" s|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'_Rain', & & dims=(/'z','t'/), & & longname='Fall Rain term of ' & & //trim(SpcWetSymbol(s))//' mixing ratio', & & units='kg kg|-1" s|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'_Fill1', & & dims=(/'z','t'/), & & longname='Filling Negative term 1 of ' & & //trim(SpcWetSymbol(s))//' mixing ratio', & & units='kg kg|-1" s|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'_Fill2', & & dims=(/'z','t'/), & & longname='Filling Negative term 2 of ' & & //trim(SpcWetSymbol(s))//' mixing ratio', & & units='kg kg|-1" s|-1"', & & xtype='double', & & history=gt_hist(8) ) call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'_Cond', & & dims=(/'z','t'/), & & longname='Condensation term of ' & & //trim(SpcWetSymbol(s))//' mixing ratio', & & units='kg kg|-1" s|-1"', & & xtype='double', & & history=gt_hist(8) ) ! call HistoryAddVariable( & ! & varname=trim(SpcWetSymbol(s))//'_Asln', & ! & dims=(/'z','t'/), & ! & longname='Asselin time filter term of ' & ! & //trim(SpcWetSymbol(s))//' mixing ratio', & ! & units='kg kg|-1" s|-1"', & ! & xtype='double', & ! & history=gt_hist(8) ) end do !----------------------------------------------------------- ! 基本場の出力 !----------------------------------------------------------- !無次元圧力の基本場 call HistoryAddVariable( & & varname='ExnerBasicZ',& & dims=(/'x','z'/), & & longname='nondimensional pressure', units='1',& & xtype='double', & & history=gt_hist(7) ) !温位の基本場 call HistoryAddVariable( & & varname='PotTempBasicZ',& & dims=(/'x','z'/), & & longname='potential temperature', & & units='K', & & xtype='double', & & history=gt_hist(7) ) !仮温位の基本場 call HistoryAddVariable( & & varname='VPotTempBasicZ',& & dims=(/'x','z'/), & & longname='vertial potential temperature', & & units='K', & & xtype='double', & & history=gt_hist(7) ) !密度の基本場 call HistoryAddVariable( & & varname='DensBasicZ', & & dims=(/'x','z'/), & & longname='density', & & units='Kg/m^3', & & xtype='double', & & history=gt_hist(7) ) !音波速度の基本場 call HistoryAddVariable( & & varname='VelSoundBasicZ',& & dims=(/'x','z'/), & & longname='sound velocity',& & units='m/s|2', & & xtype='double', & & history=gt_hist(7) ) !温度の基本場 call HistoryAddVariable( & & varname='TempBasicZ', & & dims=(/'x','z'/), & & longname='Temperature of basic state', & & units='K', & & xtype='double', & & history=gt_hist(7) ) !圧力の基本場 call HistoryAddVariable( & & varname='PressBasicZ',& & dims=(/'x','z'/), & & longname='Pressure of basic state', & & units='Pa', & & xtype='double', & & history=gt_hist(7) ) !混合比の基本場 do s = 1, SpcNum call HistoryAddVariable( & & varname=trim(SpcWetSymbol(s))//'BasicZ',& & dims=(/'x','z'/), & & longname=trim(SpcWetSymbol(s))//' Mixing Ratio of basic state', & & units='kg/kg', & & xtype='double', & & history=gt_hist(7) ) end do !分子量効果 call HistoryAddVariable( & & varname='EffMolWtBasicZ', & & dims=(/'x','z'/), & & longname='Effect of Mole Weight', & & units='1', & & xtype='double', & & history=gt_hist(7) ) !------------------------------------------------------------- ! 基本場のファイル出力 !------------------------------------------------------------- call HistoryPut( & & 'DensBasicZ', & & xz_DensBasicZ(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(7) ) call HistoryPut( & & 'ExnerBasicZ', & & xz_ExnerBasicZ(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(7) ) call HistoryPut( & & 'PotTempBasicZ',& & xz_PotTempBasicZ(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(7) ) call HistoryPut( & & 'VPotTempBasicZ',& & xz_PotTempBasicZ(FileXMin:FileXMax, FileZMin:FileZMax) & & / xz_EffMolWtBasicZ(FileXMin:FileXMax, FileZMin:FileZMax),& & gt_hist(7) ) call HistoryPut( & & 'VelSoundBasicZ', & & xz_VelSoundBasicZ(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(7) ) call HistoryPut( & & 'TempBasicZ', & & xz_TempBasicZ(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(7) ) call HistoryPut( & & 'PressBasicZ', & & xz_PressBasicZ(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(7) ) do s = 1, SpcNum call HistoryPut( & & trim(SpcWetSymbol(s))//'BasicZ', & & xza_MixRtBasicZ(FileXMin:FileXMax, FileZMin:FileZMax, s), & & gt_hist(7) ) end do call HistoryPut( & & 'EffMolWtBasicZ', & & xz_EffMolWtBasicZ(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(7) ) end subroutine HistoryFile_Open !!!--------------------------------------------------------------------------- subroutine HistoryFile_OutPut( & & Time, & & xz_PotTemp, & & xz_Exner, & & pz_VelX, & & xr_VelZ, & & xza_MixRt, & & xz_Km, & & xz_Kh & ) ! !予報変数のヒストリファイルへの出力. 出力時には半格子点の位置でプロット. ! !モジュール読み込み use average, only: xz_avr_pz, xz_avr_xr !暗黙の型宣言禁止 implicit none !変数定義 real(8), intent(in) :: Time real(8), intent(in) :: pz_VelX(DimXMin:DimXMax, DimZMin:DimZMax) real(8), intent(in) :: xr_VelZ(DimXMin:DimXMax, DimZMin:DimZMax) real(8), intent(in) :: xz_Exner(DimXMin:DimXMax, DimZMin:DimZMax) real(8), intent(in) :: xz_PotTemp(DimXMin:DimXMax, DimZMin:DimZMax) real(8), intent(in) :: xz_Km(DimXMin:DimXMax, DimZMin:DimZMax) real(8), intent(in) :: xz_Kh(DimXMin:DimXMax, DimZMin:DimZMax) real(8), intent(in) :: xza_MixRt(DimXMin:DimXMax, DimZMin:DimZMax, SpcNum) real(8) :: xz_VelX(DimXMin:DimXMax, DimZMin:DimZMax) real(8) :: xz_VelZ(DimXMin:DimXMax, DimZMin:DimZMax) integer :: s !---------------------------------------------------------------- ! 格子点位置を変換 !---------------------------------------------------------------- xz_VelX = xz_avr_pz( pz_VelX ) xz_VelZ = xz_avr_xr( xr_VelZ ) !---------------------------------------------------------------- ! 値を出力 !---------------------------------------------------------------- do s = 1, 8 + SpcNum call HistoryPut( 't', Time, gt_hist(s) ) end do call HistoryPut( & & 'Exner', & & xz_Exner(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(1) ) call HistoryPut( & & 'PotTemp', & & xz_PotTemp(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(2) ) call HistoryPut( & & 'VelX', & & xz_VelX(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(3) ) call HistoryPut( & & 'VelZ', & & xz_VelZ(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(4) ) call HistoryPut( & & 'Km', & & xz_Km(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(5) ) call HistoryPut( & & 'Kh', & & xz_Kh(FileXMin:FileXMax, FileZMin:FileZMax), & & gt_hist(6) ) do s = 1, SpcNum call HistoryPut( & & trim(SpcWetSymbol(s)), & & xza_MixRt(FileXMin:FileXMax, FileZMin:FileZMax, s), & & gt_hist(8+s) ) end do !---------------------------------------------------------------- ! 解析値を出力 !---------------------------------------------------------------- call StorePotTempMeanX() call StoreMixRtMeanX() call HistoryPut( & & 'PotTempAdv', & & z_Adv(FileZMin:FileZMax), & & gt_hist(8) ) call HistoryPut( & & 'PotTempTurb', & & z_Turb(FileZMin:FileZMax), & & gt_hist(8) ) call HistoryPut( & & 'PotTempDisp', & & z_Disp(FileZMin:FileZMax), & & gt_hist(8) ) call HistoryPut( & & 'PotTempDiff', & & z_Diff(FileZMin:FileZMax),& & gt_hist(8) ) call HistoryPut( & & 'PotTempRad', & & z_Rad(FileZMin:FileZMax), & & gt_hist(8) ) call HistoryPut( & & 'PotTempCond', & & z_Cond(FileZMin:FileZMax), & & gt_hist(8) ) call HistoryPut( & & 'PotTempCond2', & & za_Cond2(FileZMin:FileZMax,1:SpcNum), & & gt_hist(8) ) call HistoryPut( & & 'PotTempCond3', & & z_Cond3(FileZMin:FileZMax), & & gt_hist(8) ) call HistoryPut( & & 'PotTempFlux', & & z_Flux(FileZMin:FileZMax), & & gt_hist(8) ) call HistoryPut( & & 'PotTempDamp', & & z_Damp(FileZMin:FileZMax), & & gt_hist(8) ) do s = 1, SpcNum call HistoryPut( & & trim(SpcWetSymbol(s))//'_Adv', & & za_Adv(FileZMin:FileZMax, s), & & gt_hist(8) ) call HistoryPut( & & trim(SpcWetSymbol(s))//'_Turb', & & za_Turb(FileZMin:FileZMax, s), & & gt_hist(8) ) call HistoryPut( & & trim(SpcWetSymbol(s))//'_Diff', & & za_Diff(FileZMin:FileZMax, s), & & gt_hist(8) ) call HistoryPut( & & trim(SpcWetSymbol(s))//'_Flux', & & za_Flux(FileZMin:FileZMax, s), & & gt_hist(8) ) call HistoryPut( & & trim(SpcWetSymbol(s))//'_Rain', & & za_Rain(FileZMin:FileZMax, s), & & gt_hist(8) ) call HistoryPut( & & trim(SpcWetSymbol(s))//'_Fill1', & & za_Fill1(FileZMin:FileZMax, s), & & gt_hist(8) ) call HistoryPut( & & trim(SpcWetSymbol(s))//'_Fill2', & & za_Fill2(FileZMin:FileZMax, s), & & gt_hist(8) ) call HistoryPut( & & trim(SpcWetSymbol(s))//'_Cond', & & za_cond(FileZMin:FileZMax, s), & & gt_hist(8) ) ! call HistoryPut( & ! & trim(SpcWetSymbol(s))//'_Asln', & ! & za_Asln(FileZMin:FileZMax, s), & ! & gt_hist(8) ) end do end subroutine HistoryFile_OutPut !!!-------------------------------------------------------------------------- subroutine HistoryFile_Close ! !ヒストリファイルのクローズ ! !暗黙の型宣言禁止 implicit none !変数定義 integer :: s ! ループ添字 !ファイルを閉じる do s = 1, FileNum call HistoryClose(gt_hist(s),quiet=.true.) end do end subroutine HistoryFile_Close end module HistoryFileIOMPI