| 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 ( TempName /= '' ) 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: $’ // ’$Id: set_1d_profile.f90,v 1.6 2015/01/29 12:05:42 yot Exp $’ : | character(*), parameter
|