Class | set_1d_profile |
In: |
prepare_data/set_1d_profile.f90
|
Subroutine : | |
xyz_Press(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in ) |
xyz_Temp(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(out) |
xyz_QVap(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(out) |
subroutine Set1DProfileAtm( xyz_Press, xyz_Temp, xyz_QVap ) real(DP), intent(in ) :: xyz_Press(0:imax-1,1:jmax,1:kmax) real(DP), intent(out) :: xyz_Temp (0:imax-1,1:jmax,1:kmax) real(DP), intent(out) :: xyz_QVap (0:imax-1,1:jmax,1:kmax) ! ! local variables ! real(DP), allocatable :: a_InLogQH2O(:) ! 初期化確認 ! Initialization check ! if ( .not. set_1d_profile_inited ) then call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) end if call Set1DProfileInterpolate( Inkmax, a_InPress, a_InTemp, xyz_Press, xyz_Temp ) if ( any( a_InQH2O <= 0.0_DP ) ) then call MessageNotify( 'E', module_name, 'QH2O contains values <= 0.' ) end if allocate( a_InLogQH2O( Inkmax ) ) a_InLogQH2O = log( a_InQH2O ) call Set1DProfileInterpolate( Inkmax, a_InPress, a_InLogQH2O, xyz_Press, xyz_QVap ) xyz_QVap(:,:,:) = exp( xyz_QVap(:,:,:) ) deallocate( a_InLogQH2O ) end subroutine Set1DProfileAtm
Subroutine : |
This procedure input/output NAMELIST#set_1d_profile_nml .
subroutine Set1DProfileInit ! 文字列操作 ! Character handling ! use dc_string, only: toChar ! ファイル入出力補助 ! File I/O support ! use dc_iounit, only: FileOpen ! gtool データ入力 ! Gtool data input ! use gtool_history, only: HistoryGet, HistoryGetAttr ! NetCDF のラッパープログラム ! NetCDF wrapper ! use netcdf_wrapper, only : NWInqDimLen ! NAMELIST ファイル入力に関するユーティリティ ! Utilities for NAMELIST file input ! use namelist_util, only: namelist_filename, NmlutilMsg, NmlutilAryValid ! 宣言文 ; Declaration statements ! integer :: TimeIndex logical :: flag_mpi_init integer:: unit_nml ! NAMELIST ファイルオープン用装置番号. ! Unit number for NAMELIST file open integer:: iostat_nml ! NAMELIST 読み込み時の IOSTAT. ! IOSTAT of NAMELIST read ! NAMELIST 変数群 ! NAMELIST group name ! namelist /set_1d_profile_nml/ InFileName, PressName, TempName, H2OVapName, O3Name, TimeIndex ! ! デフォルト値については初期化手続 "set_1d_profile#Set1DProfileInit" ! のソースコードを参照のこと. ! ! Refer to source codes in the initialization procedure ! "set_1d_profile#Set1DProfileInit" for the default values. ! if ( set_1d_profile_inited ) return ! デフォルト値の設定 ! Default values settings ! !!$ InFileName = 'data.nc' InFileName = '' PressName = 'plev' TempName = 'Temp' H2OVapName = 'H2OVap' O3Name = '' TimeIndex = -1 ! NAMELIST の読み込み ! NAMELIST is input ! if ( trim(namelist_filename) /= '' ) then call FileOpen( unit_nml, namelist_filename, mode = 'r' ) ! (in) rewind( unit_nml ) read( unit_nml, nml = set_1d_profile_nml, iostat = iostat_nml ) ! (out) close( unit_nml ) call NmlutilMsg( iostat_nml, module_name ) ! (in) end if if ( InFileName /= '' ) then call NWInqDimLen( InFileName, PressName, Inkmax ) allocate( a_InPress( Inkmax ) ) allocate( a_InTemp ( Inkmax ) ) allocate( a_InQH2O ( Inkmax ) ) allocate( a_InQO3 ( Inkmax ) ) flag_mpi_init = .true. if ( TimeIndex <= 0 ) then call HistoryGet( InFileName, PressName, a_InPress, flag_mpi_split = flag_mpi_init ) else call HistoryGet( InFileName, PressName, a_InPress, range = 'time=^'//toChar(TimeIndex), flag_mpi_split = flag_mpi_init ) end if if ( H2OVapName /= '' ) then if ( TimeIndex <= 0 ) then call HistoryGet( InFileName, TempName, a_InTemp, flag_mpi_split = flag_mpi_init ) else call HistoryGet( InFileName, TempName, a_InTemp, range = 'time=^'//toChar(TimeIndex), flag_mpi_split = flag_mpi_init ) end if else a_InTemp = 0.0_DP end if if ( H2OVapName /= '' ) then if ( TimeIndex <= 0 ) then call HistoryGet( InFileName, H2OVapName, a_InQH2O, flag_mpi_split = flag_mpi_init ) else call HistoryGet( InFileName, H2OVapName, a_InQH2O, range = 'time=^'//toChar(TimeIndex), flag_mpi_split = flag_mpi_init ) end if else a_InQH2O = 0.0_DP end if if ( O3Name /= '' ) then if ( TimeIndex <= 0 ) then call HistoryGet( InFileName, O3Name, a_InQO3, flag_mpi_split = flag_mpi_init ) else call HistoryGet( InFileName, O3Name, a_InQO3, range = 'time=^'//toChar(TimeIndex), flag_mpi_split = flag_mpi_init ) end if else a_InQO3 = 0.0_DP end if end if ! 印字 ; Print ! call MessageNotify( 'M', module_name, '----- Initialization Messages -----' ) call MessageNotify( 'M', module_name, 'InFileName = %c', c1 = trim(InFileName) ) call MessageNotify( 'M', module_name, 'PressName = %c', c1 = trim(PressName) ) call MessageNotify( 'M', module_name, 'TempName = %c', c1 = trim(TempName) ) call MessageNotify( 'M', module_name, 'H2OVapName = %c', c1 = trim(H2OVapName) ) call MessageNotify( 'M', module_name, 'O3Name = %c', c1 = trim(O3Name) ) call MessageNotify( 'M', module_name, 'TimeIndex = %d', i = (/TimeIndex/) ) call MessageNotify( 'M', module_name, '-- version = %c', c1 = trim(version) ) set_1d_profile_inited = .true. end subroutine Set1DProfileInit
Subroutine : | |
xyz_Press(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in ) |
xyz_QO3(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(out) |
subroutine Set1DProfileO3( xyz_Press, xyz_QO3 ) real(DP), intent(in ) :: xyz_Press(0:imax-1,1:jmax,1:kmax) real(DP), intent(out) :: xyz_QO3 (0:imax-1,1:jmax,1:kmax) ! ! local variables ! real(DP), allocatable :: a_InLogQO3(:) ! 初期化確認 ! Initialization check ! if ( .not. set_1d_profile_inited ) then call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) end if if ( any( a_InQO3 <= 0.0_DP ) ) then call MessageNotify( 'E', module_name, 'QO3 contains values <= 0.' ) end if allocate( a_InLogQO3( Inkmax ) ) a_InLogQO3 = log( a_InQO3 ) call Set1DProfileInterpolate( Inkmax, a_InPress, a_InLogQO3, xyz_Press, xyz_QO3 ) xyz_QO3(:,:,:) = exp( xyz_QO3(:,:,:) ) deallocate( a_InLogQO3 ) end subroutine Set1DProfileO3
Subroutine : | |
xy_Ps(0:imax-1,1:jmax) : | real(DP), intent(out) |
subroutine Set1DProfilePs( xy_Ps ) real(DP), intent(out) :: xy_Ps(0:imax-1,1:jmax) ! ! local variables ! ! 初期化確認 ! Initialization check ! if ( .not. set_1d_profile_inited ) then call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) end if xy_Ps = a_InPress(1) end subroutine Set1DProfilePs
Subroutine : | |
xy_SurfTemp(0:imax-1,1:jmax) : | real(DP), intent(out) |
subroutine Set1DProfileSurfTemp( xy_SurfTemp ) real(DP), intent(out) :: xy_SurfTemp(0:imax-1,1:jmax) ! ! local variables ! ! 初期化確認 ! Initialization check ! if ( .not. set_1d_profile_inited ) then call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) end if xy_SurfTemp = a_InTemp(1) end subroutine Set1DProfileSurfTemp
Subroutine : | |
NLev : | integer , intent(in ) |
a_Press(1:NLev) : | real(DP), intent(in ) |
a_Array(1:NLev) : | real(DP), intent(in ) |
xyz_Press(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(in ) |
xyz_Array(0:imax-1,1:jmax,1:kmax) : | real(DP), intent(out) |
subroutine Set1DProfileInterpolate( NLev, a_Press, a_Array, xyz_Press, xyz_Array ) integer , intent(in ) :: NLev real(DP), intent(in ) :: a_Press (1:NLev) real(DP), intent(in ) :: a_Array (1:NLev) real(DP), intent(in ) :: xyz_Press(0:imax-1,1:jmax,1:kmax) real(DP), intent(out) :: xyz_Array(0:imax-1,1:jmax,1:kmax) ! ! local variables ! integer :: i integer :: j integer :: k integer :: kk ! 初期化確認 ! Initialization check ! if ( .not. set_1d_profile_inited ) then call MessageNotify( 'E', module_name, 'This module has not been initialized.' ) end if ! Old code to be deleted !!$ do k = 1, kmax !!$ if( xyz_Press(0,1,k) <= a_Press(NLev) ) then !!$ xyz_Array(0,1,k) = a_Array(NLev) !!$ else !!$ search_loop : do kk = 2, Inkmax !!$ if( a_Press( kk ) < xyz_Press(0,1,k) ) exit search_loop !!$ end do search_loop !!$ if( kk > NLev ) & !!$ stop 'Unexpected error in setting temperature profile' !!$ xyz_Array(0,1,k) = & !!$ & ( a_Array( kk ) - a_Array( kk-1 ) ) & !!$ & / ( log( a_Press( kk ) / a_Press( kk-1 ) ) ) & !!$ & * ( log( xyz_Press(0,1,k) / a_Press( kk-1 ) ) ) & !!$ & + a_Array( kk-1 ) !!$ end if !!$ end do !!$ !!$ do k = 1, kmax !!$ xyz_Array(:,:,k) = xyz_Array(0,1,k) !!$ end do do k = 1, kmax do j = 1, jmax do i = 0, imax-1 if( xyz_Press(i,j,k) <= a_Press(NLev) ) then xyz_Array(i,j,k) = a_Array(NLev) else search_loop : do kk = 2, Inkmax if( a_Press( kk ) < xyz_Press(i,j,k) ) exit search_loop end do search_loop if( kk > NLev ) stop 'Unexpected error in setting temperature profile' xyz_Array(i,j,k) = ( a_Array( kk ) - a_Array( kk-1 ) ) / ( log( a_Press( kk ) / a_Press( kk-1 ) ) ) * ( log( xyz_Press(i,j,k) / a_Press( kk-1 ) ) ) + a_Array( kk-1 ) end if end do end do end do end subroutine Set1DProfileInterpolate
Constant : | |||
module_name = ‘set_1d_profile‘ : | character(*), parameter
|
Variable : | |||
set_1d_profile_inited = .false. : | logical, save
|
Constant : | |||
version = ’$Name: dcpam5-20150213 $’ // ’$Id: set_1d_profile.f90,v 1.6 2015/01/29 12:05:42 yot Exp $’ : | character(*), parameter
|