!--------------------------------------------------------------------- ! Copyright (C) GFD Dennou Club, 2005. All rights reserved. !--------------------------------------------------------------------- !=begin != Module dycore_in_mod ! ! * Developers: Morikawa Yasuhiro ! * Version: $Id: dycore_in.f90,v 1.2 2007/06/08 02:18:13 morikawa Exp $ ! * Tag Name: $Name: $ ! * Change History: ! !== Overview ! !gtool4 netCDF data Input module directly called by GCM run program. ! !== Error Handling ! !== Known Bugs ! !== Note ! !== Future Plans ! !まだテストケースが少なく、上部モジュールと下部モジュールで切り分ける !べきかも知れない部分が多く残っている。 !その切り分けを将来的にはすべきである。 ! !=end module dycore_in_mod !=begin !== Dependency use dycore_type_mod, only : STRING, DBKIND use dycore_grid_mod, only : im, jm, km !=end implicit none !=begin !== Public Interface private public :: dycore_in_init, dycore_in_dims ! subroutines public :: dycore_in_vars, dycore_in_end ! subroutines !=end !------------------------------------------------------------------- ! dycore_in_init において値を設定するもの !------------------------------------------------------------------- character(STRING), save :: & & input_file_save , & ! 初期値ファイル & vlonname_save , & ! 速度経度成分の変数名 & vlatname_save , & ! 速度緯度成分の変数名 & vorname_save , & ! 渦度の変数名 & divname_save , & ! 発散の変数名 & psname_save , & ! 地表面気圧の変数名 & tempname_save , & ! 温度の変数名 & qvapname_save ! 比湿の変数名 real(DBKIND), save :: input_time_save(2) ! 入力データの時刻 logical, save :: dycore_in_initialized = .false. character(STRING),parameter:: version = & & '$Id: dycore_in.f90,v 1.2 2007/06/08 02:18:13 morikawa Exp $' character(STRING),parameter:: tagname = '$Name: $' contains !=begin !== Procedure Interface ! !=== Initialize module and acquire NAMELIST ! !モジュールを初期化し、NAMELIST から値を取得する。 !NAMELIST から値が取得できないものに関しては上記のデフォルト値が !用いられる。 ! !NAMELIST ファイルは、メインプログラムにて ((< nmlfile_mod >)) の !((< nmlfile_init >)) で指定されることが想定されているが、 !もしもこの初期化ルーチンより以前に指定されていなければ、 !((< nmlfile_init >)) のデフォルトで指定される NAMELIST ファイルを !読む。 ! subroutine dycore_in_init !==== Dependency use dycore_type_mod, only : STRING, DBKIND, INTKIND use nmlfile_mod, only : nmlfile_init, nmlfile_open, nmlfile_close use axis_x_mod, only: axis_x_init use axis_y_mod, only: axis_y_init use axis_z_mod, only: axis_z_init use dc_trace, only: BeginSub, EndSub, DbgMessage use dc_message,only: MessageNotify use dc_string, only: toChar !=end implicit none !=begin ! !==== NAMELIST ! character(STRING) :: & & input_file = 'init.nc' , & ! 初期値ファイル & vlonname = 'vlon' , & ! 速度経度成分の変数名 & vlatname = 'vlat' , & ! 速度緯度成分の変数名 & vorname = 'vor' , & ! 渦度の変数名 & divname = 'div' , & ! 発散の変数名 & psname = 'ps' , & ! 地表面気圧の変数名 & tempname = 'temp' , & ! 温度の変数名 & qvapname = 'qvap' ! 比湿の変数名 real(DBKIND) :: input_time(2) = (/0,0/) ! 入力データの時刻 namelist /dycore_in_nml/ & & input_file , & ! 初期値ファイル & input_time , & ! 入力データの時刻 (t-Δt, t) & vlonname , & ! 速度経度成分の変数名 & vlatname , & ! 速度緯度成分の変数名 & vorname , & ! 渦度の変数名 & divname , & ! 発散の変数名 & psname , & ! 地表面気圧の変数名 & tempname , & ! 温度の変数名 & qvapname ! 比湿の変数名 !=end integer(INTKIND) :: nmlstat, nmlunit logical :: nmlreadable character(STRING), parameter:: subname = "dycore_in_init" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if (dycore_in_initialized) then call EndSub( subname, '%c is already called', c1=trim(subname) ) return else dycore_in_initialized = .true. endif !---------------------------------------------------------------- ! Version identifier !---------------------------------------------------------------- call DbgMessage('%c :: %c', c1=trim(version), c2=trim(tagname)) !---------------------------------------------------------------- ! axis_x_mod, axis_y_mod, axis_z_mod の初期化 !---------------------------------------------------------------- call axis_x_init call axis_y_init call axis_z_init !---------------------------------------------------------------- ! read dycore_in_nml !---------------------------------------------------------------- ! Initialization input_file = 'init.nc' ! 初期値ファイル vlonname = 'vlon' ! 速度経度成分の変数名 vlatname = 'vlat' ! 速度緯度成分の変数名 vorname = 'vor' ! 渦度の変数名 divname = 'div' ! 発散の変数名 psname = 'ps' ! 地表面気圧の変数名 tempname = 'temp' ! 温度の変数名 qvapname = 'qvap' ! 比湿の変数名 input_time(:) = 0.0d0 ! 入力データの時刻 call nmlfile_init call nmlfile_open(nmlunit, nmlreadable) if (nmlreadable) then read(nmlunit, nml=dycore_in_nml, iostat=nmlstat) call DbgMessage('Stat of NAMELIST dycore_in_nml Input is <%d>', & & i=(/nmlstat/)) write(0, nml=dycore_in_nml) else call DbgMessage('Not Read NAMELIST dycore_in_nml') call MessageNotify('W', subname, & & 'Can not Read NAMELIST dycore_in_nml. Force Use Default Value.') end if call nmlfile_close !---------------------------------------------------------------- ! receive NAMELIST information !---------------------------------------------------------------- input_file_save = input_file vlonname_save = vlonname vlatname_save = vlatname vorname_save = vorname divname_save = divname psname_save = psname tempname_save = tempname qvapname_save = qvapname input_time_save = input_time !---------------------------------------------------------------- ! 例外処理 !---------------------------------------------------------------- if (input_file == '') then call MessageNotify('E', subname, & & message='Input File Name is Vacancy.') endif !!$ if (vloname == '' .or. vlatname == '' .or. vorname == '' & !!$ & divname == '' .or. psname == '' .or. tempname == '' & !!$ & qvapname == '') then !!$ ! 変数名の入力が無かったらデフォルトの値を入れるようにする。 !!$ !call MessageNotify('E', subname, 'Variable Name is Vacancy.') !!$ endif call EndSub( subname, '[%c], [%c]', & & c1='input_file=<' // trim(input_file) // '>, ' // & & 'input_time=<' // trim(toChar(input_time)) // '>, ', & & c2='vlonname=<' // trim(vlonname) // '>, ' // & & 'vlatname=<' // trim(vlatname) // '>, ' // & & 'vorname=<' // trim(vorname) // '>, ' // & & 'divname=<' // trim(divname) // '>, ' // & & 'psname=<' // trim(psname) // '>, ' // & & 'tempname=<' // trim(tempname) // '>, ' // & & 'qvapname=<' // trim(qvapname) // '>, ' ) end subroutine dycore_in_init !=begin !=== Return Data and Information of Dimensions ! !((< axis_x_mod >)), ((< axis_y_mod >)), ((< axis_z_mod >)) !から座標情報を取得し、Dims に格納して返す。 ! subroutine dycore_in_dims(Dims) !==== Dependency use dycore_type_mod, only: DYCORE_DIMS use dycore_grid_mod, only: im, jm, km use axis_x_mod, only: axis_x_spectral, axis_x_manual, axis_x_netcdf use axis_y_mod, only: axis_y_spectral, axis_y_manual, axis_y_netcdf use axis_z_mod, only: axis_z_manual, axis_z_netcdf, & & axis_z_sigmahalf_manual, axis_z_sigmahalf_netcdf use gt4_history,only: HistoryGetPointer use dc_trace, only: BeginSub, EndSub, DbgMessage use dc_string, only: toChar !=end implicit none !=begin !==== Output ! type(DYCORE_DIMS), intent(out):: Dims ! 次元データ全種 !=end !----- 作業用内部変数 ----- character(len = *), parameter:: subname = "dycore_in_dims" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if (.not. dycore_in_initialized) then call EndSub( subname, 'Call dycocre_in_init before call %c', & & c1=trim(subname) ) return endif !---------------------------------------------------------------- ! 軸データ生成 !---------------------------------------------------------------- call axis_x_spectral(Dims%x_Lon) ! 経度座標データ取得 call axis_x_manual(Dims%x_Lon) ! 経度座標データ取得 call axis_x_netcdf(Dims%x_Lon) ! 経度座標データ取得 call axis_y_spectral(Dims%y_Lat) ! 緯度座標データ取得 call axis_y_manual(Dims%y_Lat) ! 緯度座標データ取得 call axis_y_netcdf(Dims%y_Lat) ! 緯度座標データ取得 call axis_z_sigmahalf_manual & & ( Dims%z_Sigma , & ! 整数σレベル座標データ取得 & Dims%r_Sigma ) ! 半整数σレベル座標データ取得 call axis_z_sigmahalf_netcdf & & ( Dims%z_Sigma , & ! 整数σレベル座標データ取得 & Dims%r_Sigma ) ! 半整数σレベル座標データ取得 call axis_z_manual & & ( Dims%z_Sigma ) ! 整数σレベル座標データ取得 call axis_z_netcdf & & ( Dims%z_Sigma ) ! 整数σレベル座標データ取得 call EndSub(subname) end subroutine dycore_in_dims !=begin !=== Return Data and Information of Dimensions ! !((< dycore_in_init >)) の NAMELIST ((< dycore_in_nml >)) !の情報に従い、変数データのデータを入力して、 !Vars_B および Vars に返す。 ! subroutine dycore_in_vars(Vars_B, Vars) !==== Dependency use dycore_type_mod, only: DYCORE_VARS use dycore_grid_mod, only: im, jm, km use gt4_history, only: HistoryGetPointer use dc_trace, only: BeginSub, EndSub, DbgMessage use dc_string, only: toChar !=end implicit none !=begin !==== Output ! type(DYCORE_VARS), intent(out):: Vars_B ! 格子点データ全種 (t-Δt) type(DYCORE_VARS), intent(out):: Vars ! 格子点データ全種 (t) !=end !----- 作業用内部変数 ----- character(len = *), parameter:: subname = "dycore_in_vars" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if (.not. dycore_in_initialized) then call EndSub( subname, 'Call dycocre_in_init before call %c', & & c1=trim(subname) ) return endif !--------------------------------------------------------------------- ! HistoryGetPointer [in gt4f90io] による入力 (Vars_B へ) !--------------------------------------------------------------------- !----- 格子点データ(速度経度成分) ----- if (.not. trim(vlonname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(vlonname_save) , & & array=Vars_B%xyz_VelLon , & & time=input_time_save(1) ) call DbgMessage('Input VelLon_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(vlonname_save) , & & c3=toChar( input_time_save(1) ) ) else call DbgMessage('Not Input VelLon_B data') endif !----- 格子点データ(速度緯度成分) ----- if (.not. trim(vlatname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(vlatname_save) , & & array=Vars_B%xyz_VelLat , & & time=input_time_save(1) ) call DbgMessage('Input VelLat_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(vlatname_save) , & & c3=toChar( input_time_save(1) ) ) else call DbgMessage('Not Input VelLat_B data') endif !----- 格子点データ(渦度成分) ----- if (.not. trim(vorname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(vorname_save) , & & array=Vars_B%xyz_Vor , & & time=input_time_save(1) ) call DbgMessage('Input Vor_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(vorname_save) , & & c3=toChar( input_time_save(1) ) ) else call DbgMessage('Not Input Vor_B data') endif !----- 格子点データ(発散成分) ----- if (.not. trim(divname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(divname_save) , & & array=Vars_B%xyz_Div , & & time=input_time_save(1) ) call DbgMessage('Input Div_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(divname_save) , & & c3=toChar( input_time_save(1) ) ) else call DbgMessage('Not Input Div_B data') endif !----- 格子点データ(温度成分) ----- if (.not. trim(tempname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(tempname_save) , & & array=Vars_B%xyz_Temp , & & time=input_time_save(1) ) call DbgMessage('Input Temp_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(tempname_save) , & & c3=toChar( input_time_save(1) ) ) else call DbgMessage('Not Input Temp_B data') endif !----- 格子点データ(比湿成分) ----- if (.not. trim(qvapname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(qvapname_save) , & & array=Vars_B%xyz_QVap , & & time=input_time_save(1) ) call DbgMessage('Input QVap_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(qvapname_save) , & & c3=toChar( input_time_save(1) ) ) else call DbgMessage('Not Input QVap_B data') endif !----- 格子点データ(地表面気圧成分) ----- if (.not. trim(psname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(psname_save) , & & array=Vars_B%xy_Ps , & & time=input_time_save(1) ) call DbgMessage('Input Ps_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(psname_save) , & & c3=toChar( input_time_save(1) ) ) else call DbgMessage('Not Input Ps_B data') endif !--------------------------------------------------------------------- ! HistoryGetPointer [in gt4f90io] による入力 (Vars へ) !--------------------------------------------------------------------- !----- 格子点データ(速度経度成分) ----- if (.not. trim(vlonname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(vlonname_save) , & & array=Vars%xyz_VelLon , & & time=input_time_save(2) ) call DbgMessage('Input VelLon_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(vlonname_save) , & & c3=toChar( input_time_save(2) ) ) else call DbgMessage('Not Input VelLon_B data') endif !----- 格子点データ(速度緯度成分) ----- if (.not. trim(vlatname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(vlatname_save) , & & array=Vars%xyz_VelLat , & & time=input_time_save(2) ) call DbgMessage('Input VelLat_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(vlatname_save) , & & c3=toChar( input_time_save(2) ) ) else call DbgMessage('Not Input VelLat_B data') endif !----- 格子点データ(渦度成分) ----- if (.not. trim(vorname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(vorname_save) , & & array=Vars%xyz_Vor , & & time=input_time_save(2) ) call DbgMessage('Input Vor_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(vorname_save) , & & c3=toChar( input_time_save(2) ) ) else call DbgMessage('Not Input Vor_B data') endif !----- 格子点データ(発散成分) ----- if (.not. trim(divname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(divname_save) , & & array=Vars%xyz_Div , & & time=input_time_save(2) ) call DbgMessage('Input Div_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(divname_save) , & & c3=toChar( input_time_save(2) ) ) else call DbgMessage('Not Input Div_B data') endif !----- 格子点データ(温度成分) ----- if (.not. trim(tempname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(tempname_save) , & & array=Vars%xyz_Temp , & & time=input_time_save(2) ) call DbgMessage('Input Temp_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(tempname_save) , & & c3=toChar( input_time_save(2) ) ) else call DbgMessage('Not Input Temp_B data') endif !----- 格子点データ(比湿成分) ----- if (.not. trim(qvapname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(qvapname_save) , & & array=Vars%xyz_QVap , & & time=input_time_save(2) ) call DbgMessage('Input QVap_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(qvapname_save) , & & c3=toChar( input_time_save(2) ) ) else call DbgMessage('Not Input QVap_B data') endif !----- 格子点データ(地表面気圧成分) ----- if (.not. trim(psname_save) == '') then call HistoryGetPointer( & & file=trim(input_file_save) , & & varname=trim(psname_save) , & & array=Vars%xy_Ps , & & time=input_time_save(2) ) call DbgMessage('Input Ps_B data from %c@%c,time=%c' , & & c1=trim(input_file_save), c2=trim(psname_save) , & & c3=toChar( input_time_save(2) ) ) else call DbgMessage('Not Input Ps_B data') endif call EndSub(subname) end subroutine dycore_in_vars !=begin !=== Terminate module ! !((< dycore_in_init>)) で設定された値を破棄し、 !デフォルトの値に戻します。 ! subroutine dycore_in_end !==== Dependency use dc_trace, only: BeginSub, EndSub, DbgMessage use dc_error, only: StoreError, USR_ERRNO use dc_string, only: toChar !=end implicit none character(STRING), parameter:: subname = "dycore_in_end" continue !---------------------------------------------------------------- ! Check Initialization !---------------------------------------------------------------- call BeginSub(subname) if ( .not. dycore_in_initialized) then call EndSub( subname, 'dycore_in_init was not called', & & c1=trim(subname) ) return else dycore_in_initialized = .false. endif !----------------------------------------------------------------- ! Initialize information for data input !----------------------------------------------------------------- input_file_save = 'init.nc' vlonname_save = 'vlon' vlatname_save = 'vlat' vorname_save = 'vor' divname_save = 'div' psname_save = 'ps' tempname_save = 'temp' qvapname_save = 'qvap' input_time_save = 0.0d0 call EndSub(subname) end subroutine dycore_in_end !!$ !---------------------------------------------------------------- !!$ ! 取得したデータのサイズチェック !!$ !---------------------------------------------------------------- !!$ subroutine arraysize_check !!$ !!$ end subroutine arraysize_check end module dycore_in_mod