module ATMOSPHERE / Reference state More...

Functions/Subroutines
subroutine, public	atmos_refstate_setup
	Setup. More...

subroutine, public	atmos_refstate_resume (DENS, RHOT, QTRC)
	Resume. More...

subroutine, public	atmos_refstate_read
	Read reference state profile. More...

subroutine, public	atmos_refstate_write
	Write reference state profile. More...

subroutine, public	atmos_refstate_update (DENS, RHOT, QTRC)
	Update reference state profile (Horizontal average) More...

subroutine	atmos_refstate_calc3d
	apply 1D reference to 3D (terrain-following) with re-calc hydrostatic balance More...

subroutine	smoothing (phi)

Variables
logical, public	atmos_refstate_update_flag = .false.

real(rp), dimension(:,:,:), allocatable, public	atmos_refstate_pres
	refernce pressure [Pa] More...

real(rp), dimension(:,:,:), allocatable, public	atmos_refstate_temp
	refernce temperature [K] More...

real(rp), dimension(:,:,:), allocatable, public	atmos_refstate_dens
	refernce density [kg/m3] More...

real(rp), dimension(:,:,:), allocatable, public	atmos_refstate_pott
	refernce potential temperature [K] More...

real(rp), dimension(:,:,:), allocatable, public	atmos_refstate_qv
	refernce vapor [kg/kg] More...

Detailed Description

module ATMOSPHERE / Reference state

Description: Reference state of Atmosphere

Author: Team SCALE

History

2011-12-11 (H.Yashiro) [new]
2012-03-23 (H.Yashiro) [mod] Explicit index parameter inclusion
2013-02-25 (H.Yashiro) [mod] Separate ISA profile to scale_atmos_sub_profile

NAMELIST

PARAM_ATMOS_REFSTATE

name	type	default value	comment
ATMOS_REFSTATE_IN_BASENAME	character(len=H_LONG)	''	basename of the input file
ATMOS_REFSTATE_OUT_BASENAME	character(len=H_LONG)	''	basename of the output file
ATMOS_REFSTATE_OUT_TITLE	character(len=H_MID)	'SCALE-RM RefState'	title of the output file
ATMOS_REFSTATE_OUT_DTYPE	character(len=H_SHORT)	'DEFAULT'	REAL4 or REAL8
ATMOS_REFSTATE_TYPE	character(len=H_SHORT)	'UNIFORM'	profile type
ATMOS_REFSTATE_TEMP_SFC	real(RP)	300.0_RP	surface temperature [K]
ATMOS_REFSTATE_RH	real(RP)	0.0_RP	surface & environment RH [%]
ATMOS_REFSTATE_POTT_UNIFORM	real(RP)	300.0_RP	uniform potential temperature [K]
ATMOS_REFSTATE_UPDATE_FLAG	logical	.false.
ATMOS_REFSTATE_UPDATE_DT	real(DP)	0.0_DP

History Output: No history output

Function/Subroutine Documentation

◆ atmos_refstate_setup()

subroutine, public scale_atmos_refstate::atmos_refstate_setup ( )

Setup.

Definition at line 89 of file scale_atmos_sub_refstate.F90.

References atmos_refstate_dens, atmos_refstate_pott, atmos_refstate_pres, atmos_refstate_qv, atmos_refstate_read(), atmos_refstate_temp, atmos_refstate_update_flag, scale_grid_index::ia, scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_fid_nml, scale_stdio::io_l, scale_stdio::io_nml, scale_grid_index::ja, scale_grid_index::ka, and scale_process::prc_mpistop().

Referenced by mod_atmos_driver::atmos_driver_setup().

     use scale_process, only: &
        prc_mpistop
     implicit none
 
     namelist / param_atmos_refstate / &
        atmos_refstate_in_basename,  &
        atmos_refstate_out_basename, &
        atmos_refstate_out_title,    &
        atmos_refstate_out_dtype,    &
        atmos_refstate_type,         &
        atmos_refstate_temp_sfc,     &
        atmos_refstate_rh,           &
        atmos_refstate_pott_uniform, &
        atmos_refstate_update_flag,  &
        atmos_refstate_update_dt
 
     integer :: ierr
     !---------------------------------------------------------------------------
 
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '++++++ Module[REFSTATE] / Categ[ATMOS SHARE] / Origin[SCALElib]'
 
     allocate( atmos_refstate_pres(ka,ia,ja) )
     allocate( atmos_refstate_temp(ka,ia,ja) )
     allocate( atmos_refstate_dens(ka,ia,ja) )
     allocate( atmos_refstate_pott(ka,ia,ja) )
     allocate( atmos_refstate_qv(ka,ia,ja) )
 
     allocate( atmos_refstate1d_pres(ka) )
     allocate( atmos_refstate1d_temp(ka) )
     allocate( atmos_refstate1d_dens(ka) )
     allocate( atmos_refstate1d_pott(ka) )
     allocate( atmos_refstate1d_qv(ka) )
 
     !--- read namelist
     rewind(io_fid_conf)
     read(io_fid_conf,nml=param_atmos_refstate,iostat=ierr)
     if( ierr < 0 ) then !--- missing
        if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
     elseif( ierr > 0 ) then !--- fatal error
        write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_REFSTATE. Check!'
        call prc_mpistop
     endif
     if( io_nml ) write(io_fid_nml,nml=param_atmos_refstate)
 
     if( io_l ) write(io_fid_log,*)
     if ( atmos_refstate_in_basename /= '' ) then
        if( io_l ) write(io_fid_log,*) '*** Input file of reference state : ', trim(atmos_refstate_in_basename)
     else
        if( io_l ) write(io_fid_log,*) '*** Input file of reference state : Nothing, generate internally'
     endif
 
     ! input or generate reference profile
     if ( atmos_refstate_in_basename /= '' ) then
        call atmos_refstate_read
     else
        if ( atmos_refstate_type == 'ISA' ) then
 
           if( io_l ) write(io_fid_log,*) '*** Reference type                : ISA'
           if( io_l ) write(io_fid_log,*) '*** Surface temperature      [K]  : ', atmos_refstate_temp_sfc
           if( io_l ) write(io_fid_log,*) '*** Surface & environment RH [%]  : ', atmos_refstate_rh
           call atmos_refstate_generate_isa
           atmos_refstate_update_flag = .false.
 
        elseif ( atmos_refstate_type == 'UNIFORM' ) then
 
           if( io_l ) write(io_fid_log,*) '*** Reference type                : UNIFORM POTT'
           if( io_l ) write(io_fid_log,*) '*** Potential temperature         : ', atmos_refstate_pott_uniform
           call atmos_refstate_generate_uniform
           atmos_refstate_update_flag = .false.
 
        elseif ( atmos_refstate_type == 'ZERO' ) then
 
           if( io_l ) write(io_fid_log,*) '*** Reference type                : ZERO'
           call atmos_refstate_generate_zero
           atmos_refstate_update_flag = .false.
 
        elseif ( atmos_refstate_type == 'INIT' ) then
 
           if( io_l ) write(io_fid_log,*) '*** Reference type                : Generate from initial data'
           if( io_l ) write(io_fid_log,*) '*** Update state?                 : ', atmos_refstate_update_flag
           if( io_l ) write(io_fid_log,*) '*** Update interval [sec]         : ', atmos_refstate_update_dt
 
        else
           write(*,*) 'xxx ATMOS_REFSTATE_TYPE must be "ISA" or "UNIFORM". Check! : ', trim(atmos_refstate_type)
           call prc_mpistop
        endif
 
     endif
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_refstate_resume()

subroutine, public scale_atmos_refstate::atmos_refstate_resume	(	real(rp), dimension(ka,ia,ja), intent(in)	DENS,
		real(rp), dimension(ka,ia,ja), intent(in)	RHOT,
		real(rp), dimension(ka,ia,ja,qa), intent(in)	QTRC
	)

Resume.

Definition at line 186 of file scale_atmos_sub_refstate.F90.

References atmos_refstate_update_flag, atmos_refstate_write(), scale_grid::grid_cz, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::ke, scale_grid_index::ks, and scale_process::prc_mpistop().

Referenced by mod_atmos_driver::atmos_driver_resume1().

     use scale_process, only: &
        prc_mpistop
     use scale_grid, only: &
        cz => grid_cz
     implicit none
 
     real(RP), intent(in) :: DENS(KA,IA,JA)
     real(RP), intent(in) :: RHOT(KA,IA,JA)
     real(RP), intent(in) :: QTRC(KA,IA,JA,QA)
 
     integer :: k
 
     ! input or generate reference profile
     if ( atmos_refstate_in_basename == '' ) then
 
        if ( atmos_refstate_type == 'INIT' ) then
 
           if( io_l ) write(io_fid_log,*) '*** Reference type               : make from initial data'
           if( io_l ) write(io_fid_log,*) '*** Update state?                : ', atmos_refstate_update_flag
           if( io_l ) write(io_fid_log,*) '*** Update interval [sec]        : ', atmos_refstate_update_dt
           call atmos_refstate_generate_frominit( dens, rhot, qtrc ) ! (in)
 
        endif
 
        if( io_l ) write(io_fid_log,*)
        if( io_l ) write(io_fid_log,*) '###### Generated Reference State of Atmosphere ######'
        if( io_l ) write(io_fid_log,*) '   z*-coord.:    pressure: temperature:     density:   pot.temp.: water vapor'
        do k = ks, ke
           if( io_l ) write(io_fid_log,'(6F13.5)')   cz(k),                    &
                                                     atmos_refstate1d_pres(k), &
                                                     atmos_refstate1d_temp(k), &
                                                     atmos_refstate1d_dens(k), &
                                                     atmos_refstate1d_pott(k), &
                                                     atmos_refstate1d_qv(k)
        enddo
        if( io_l ) write(io_fid_log,*) '####################################################'
     endif
 
     if ( atmos_refstate_out_basename /= '' ) then
        if( io_l ) write(io_fid_log,*) '*** Reference state output? : ', trim(atmos_refstate_out_basename)
     else
        if( io_l ) write(io_fid_log,*) '*** Reference state output? : NO'
     endif
 
     ! output reference profile
     call atmos_refstate_write
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_refstate_read()

subroutine, public scale_atmos_refstate::atmos_refstate_read ( )

Read reference state profile.

Definition at line 239 of file scale_atmos_sub_refstate.F90.

References atmos_refstate_calc3d(), atmos_refstate_dens, atmos_refstate_pott, atmos_refstate_pres, atmos_refstate_qv, atmos_refstate_temp, scale_fileio::fileio_close(), scale_fileio::fileio_open(), scale_stdio::io_fid_log, scale_stdio::io_l, and scale_process::prc_mpistop().

Referenced by atmos_refstate_setup().

     use scale_fileio, only: &
        fileio_open, &
        fileio_check_coordinates, &
        fileio_read, &
        fileio_close
     use scale_process, only: &
        prc_mpistop
     implicit none
 
     integer :: fid
     !---------------------------------------------------------------------------
 
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '*** Input reference state profile ***'
 
     if ( atmos_refstate_in_basename /= '' ) then
 
        call fileio_open( fid, atmos_refstate_in_basename )
 
        if ( atmos_refstate_in_check_coordinates ) then
           call fileio_check_coordinates( fid, atmos=.true. )
        end if
 
        ! 1D
        call fileio_read( atmos_refstate1d_pres(:), fid, 'PRES_ref', 'Z', step=1 )
        call fileio_read( atmos_refstate1d_temp(:), fid, 'TEMP_ref', 'Z', step=1 )
        call fileio_read( atmos_refstate1d_dens(:), fid, 'DENS_ref', 'Z', step=1 )
        call fileio_read( atmos_refstate1d_pott(:), fid, 'POTT_ref', 'Z', step=1 )
        call fileio_read( atmos_refstate1d_qv(:),   fid, 'QV_ref',   'Z', step=1 )
 
        ! 3D
        call fileio_read( atmos_refstate_pres(:,:,:), fid, 'PRES_ref3D', 'ZXY', step=1 )
        call fileio_read( atmos_refstate_temp(:,:,:), fid, 'TEMP_ref3D', 'ZXY', step=1 )
        call fileio_read( atmos_refstate_dens(:,:,:), fid, 'DENS_ref3D', 'ZXY', step=1 )
        call fileio_read( atmos_refstate_pott(:,:,:), fid, 'POTT_ref3D', 'ZXY', step=1 )
        call fileio_read( atmos_refstate_qv(:,:,:),   fid, 'QV_ref3D',   'ZXY', step=1 )
 
     else
        write(*,*) 'xxx [ATMOS_REFSTATE_read] refstate file is not specified.'
        call prc_mpistop
     endif
 
     call atmos_refstate_calc3d
 
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_refstate_write()

subroutine, public scale_atmos_refstate::atmos_refstate_write ( )

Write reference state profile.

Definition at line 290 of file scale_atmos_sub_refstate.F90.

References atmos_refstate_calc3d(), atmos_refstate_dens, atmos_refstate_pott, atmos_refstate_pres, atmos_refstate_qv, atmos_refstate_temp, atmos_refstate_update(), scale_comm::comm_horizontal_mean(), scale_const::const_epsvap, scale_const::const_pstd, scale_grid_index::ia, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::ja, scale_grid_index::ka, scale_grid_index::ke, scale_grid_index::ks, scale_grid_real::real_cz, and scale_time::time_nowsec.

Referenced by atmos_refstate_resume().

     use scale_fileio, only: &
        fileio_write
     implicit none
     !---------------------------------------------------------------------------
 
     if ( atmos_refstate_out_basename /= '' ) then
 
        if( io_l ) write(io_fid_log,*)
        if( io_l ) write(io_fid_log,*) '*** Output reference state profile ***'
 
        ! 1D
        call fileio_write( atmos_refstate1d_pres(:), atmos_refstate_out_basename, atmos_refstate_out_title, & ! [IN]
                           'PRES_ref', 'Reference profile of pres.', 'Pa', 'Z',   atmos_refstate_out_dtype  ) ! [IN]
        call fileio_write( atmos_refstate1d_temp(:), atmos_refstate_out_basename, atmos_refstate_out_title, & ! [IN]
                           'TEMP_ref', 'Reference profile of temp.', 'K', 'Z',    atmos_refstate_out_dtype  ) ! [IN]
        call fileio_write( atmos_refstate1d_dens(:), atmos_refstate_out_basename, atmos_refstate_out_title, & ! [IN]
                           'DENS_ref', 'Reference profile of rho', 'kg/m3', 'Z',  atmos_refstate_out_dtype  ) ! [IN]
        call fileio_write( atmos_refstate1d_pott(:), atmos_refstate_out_basename, atmos_refstate_out_title, & ! [IN]
                           'POTT_ref', 'Reference profile of theta', 'K', 'Z',    atmos_refstate_out_dtype  ) ! [IN]
        call fileio_write( atmos_refstate1d_qv(:),   atmos_refstate_out_basename, atmos_refstate_out_title, & ! [IN]
                           'QV_ref',   'Reference profile of qv', 'kg/kg', 'Z',   atmos_refstate_out_dtype  ) ! [IN]
 
        ! 3D
        call fileio_write( atmos_refstate_pres(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title,   & ! [IN]
                           'PRES_ref3D', 'Reference profile of pres.', 'Pa', 'ZXY',   atmos_refstate_out_dtype  ) ! [IN]
        call fileio_write( atmos_refstate_temp(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title,   & ! [IN]
                           'TEMP_ref3D', 'Reference profile of temp.', 'K', 'ZXY',    atmos_refstate_out_dtype  ) ! [IN]
        call fileio_write( atmos_refstate_dens(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title,   & ! [IN]
                           'DENS_ref3D', 'Reference profile of rho', 'kg/m3', 'ZXY',  atmos_refstate_out_dtype  ) ! [IN]
        call fileio_write( atmos_refstate_pott(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title,   & ! [IN]
                           'POTT_ref3D', 'Reference profile of theta', 'K', 'ZXY',    atmos_refstate_out_dtype  ) ! [IN]
        call fileio_write( atmos_refstate_qv(:,:,:),   atmos_refstate_out_basename, atmos_refstate_out_title,   & ! [IN]
                           'QV_ref3D',   'Reference profile of qv', 'kg/kg', 'ZXY',   atmos_refstate_out_dtype  ) ! [IN]
 
     endif
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_refstate_update()

subroutine, public scale_atmos_refstate::atmos_refstate_update	(	real(rp), dimension(ka,ia,ja), intent(in)	DENS,
		real(rp), dimension(ka,ia,ja), intent(in)	RHOT,
		real(rp), dimension(ka,ia,ja,qa), intent(in)	QTRC
	)

Update reference state profile (Horizontal average)

Definition at line 569 of file scale_atmos_sub_refstate.F90.

References atmos_refstate_calc3d(), scale_comm::comm_horizontal_mean(), scale_atmos_hydrometeor::i_qv, scale_grid_index::ia, scale_interpolation::interp_vertical_xi2z(), scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::ja, scale_grid_index::ke, scale_grid_index::ks, smoothing(), scale_time::time_nowsec, scale_tracer::tracer_cp, scale_tracer::tracer_cv, and scale_tracer::tracer_mass.

Referenced by mod_atmos_driver::atmos_driver(), and atmos_refstate_write().

     use scale_time, only: &
        time_nowsec
     use scale_comm, only: &
        comm_horizontal_mean
     use scale_interpolation, only: &
        interp_vertical_xi2z
     use scale_atmos_thermodyn, only: &
        thermodyn_temp_pres => atmos_thermodyn_temp_pres
     use scale_atmos_hydrometeor, only: &
        i_qv
     implicit none
     real(RP), intent(in) :: DENS(KA,IA,JA)
     real(RP), intent(in) :: RHOT(KA,IA,JA)
     real(RP), intent(in) :: QTRC(KA,IA,JA,QA)
 
     real(RP) :: temp(KA,IA,JA)
     real(RP) :: pres(KA,IA,JA)
     real(RP) :: pott(KA,IA,JA)
     real(RP) :: work(KA,IA,JA)
 
     integer  :: k, i, j
     !---------------------------------------------------------------------------
 
     if ( time_nowsec - last_updated >= atmos_refstate_update_dt ) then
 
        if( io_l ) write(io_fid_log,*) '*** [REFSTATE] update reference state'
 
        call thermodyn_temp_pres( temp,       & ! [OUT]
                                  pres,       & ! [OUT]
                                  dens,       & ! [IN]
                                  rhot,       & ! [IN]
                                  qtrc,       & ! [IN]
                                  tracer_cv,  & ! [IN]
                                  tracer_cp,  & ! [IN]
                                  tracer_mass ) ! [IN]
 
        do j = 1, ja
        do i = 1, ia
        do k = ks, ke
           pott(k,i,j) = rhot(k,i,j) / dens(k,i,j)
        enddo
        enddo
        enddo
 
        call interp_vertical_xi2z( temp(:,:,:), & ! [IN]
                                   work(:,:,:)  ) ! [OUT]
 
        call comm_horizontal_mean( atmos_refstate1d_temp(:), work(:,:,:) )
 
        call interp_vertical_xi2z( pres(:,:,:), & ! [IN]
                                   work(:,:,:)  ) ! [OUT]
 
        call comm_horizontal_mean( atmos_refstate1d_pres(:), work(:,:,:) )
 
        call interp_vertical_xi2z( dens(:,:,:), & ! [IN]
                                   work(:,:,:)  ) ! [OUT]
 
        call comm_horizontal_mean( atmos_refstate1d_dens(:), work(:,:,:) )
 
        call interp_vertical_xi2z( pott(:,:,:), & ! [IN]
                                   work(:,:,:)  ) ! [OUT]
 
        call comm_horizontal_mean( atmos_refstate1d_pott(:), work(:,:,:) )
 
        if ( i_qv > 0 ) then
           call interp_vertical_xi2z( qtrc(:,:,:,i_qv), & ! [IN]
                                      work(:,:,:)       ) ! [OUT]
 
           call comm_horizontal_mean( atmos_refstate1d_qv(:), work(:,:,:) )
        else
           atmos_refstate1d_qv(:) = 0.0_rp
        endif
 
        do k = ke-1, ks, -1 ! fill undefined value
           if( atmos_refstate1d_dens(k) <= 0.0_rp ) atmos_refstate1d_dens(k) = atmos_refstate1d_dens(k+1)
           if( atmos_refstate1d_temp(k) <= 0.0_rp ) atmos_refstate1d_temp(k) = atmos_refstate1d_temp(k+1)
           if( atmos_refstate1d_pres(k) <= 0.0_rp ) atmos_refstate1d_pres(k) = atmos_refstate1d_pres(k+1)
           if( atmos_refstate1d_pott(k) <= 0.0_rp ) atmos_refstate1d_pott(k) = atmos_refstate1d_pott(k+1)
           if( atmos_refstate1d_qv(k) <= 0.0_rp ) atmos_refstate1d_qv(k) = atmos_refstate1d_qv(k+1)
        enddo
        call smoothing( atmos_refstate1d_pott(:) )
        if ( i_qv > 0 ) call smoothing( atmos_refstate1d_qv(:) )
 
        call atmos_refstate_calc3d
 
        last_updated = time_nowsec
 
     endif
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_refstate_calc3d()

subroutine scale_atmos_refstate::atmos_refstate_calc3d ( )

apply 1D reference to 3D (terrain-following) with re-calc hydrostatic balance

Definition at line 664 of file scale_atmos_sub_refstate.F90.

References scale_atmos_hydrostatic::atmos_hydrostatic_buildrho_atmos_0d(), scale_atmos_hydrostatic::atmos_hydrostatic_buildrho_atmos_rev_2d(), scale_atmos_hydrostatic::atmos_hydrostatic_buildrho_atmos_rev_3d(), atmos_refstate_dens, atmos_refstate_pott, atmos_refstate_pres, atmos_refstate_qv, atmos_refstate_temp, scale_const::const_cpdry, scale_const::const_pre00, scale_const::const_rdry, scale_const::const_undef, scale_grid::grid_cz, scale_grid::grid_fz, scale_grid_index::ieb, scale_interpolation::interp_vertical_z2xi(), scale_grid_index::isb, scale_grid_index::jeb, scale_grid_index::jsb, scale_grid_index::ke, scale_grid_index::ks, scale_grid_real::real_cz, scale_grid_real::real_fz, and scale_grid_real::real_phi.

Referenced by atmos_refstate_read(), atmos_refstate_update(), and atmos_refstate_write().

     use scale_const, only: &
        undef => const_undef, &
        rdry  => const_rdry,  &
        cpdry => const_cpdry, &
        p00   => const_pre00
     use scale_comm, only: &
        comm_vars8, &
        comm_wait
     use scale_grid, only: &
        grid_cz, &
        grid_fz
     use scale_grid_real, only: &
        real_phi, &
        real_cz,  &
        real_fz
     use scale_interpolation, only: &
        interp_vertical_z2xi
     use scale_atmos_hydrostatic, only: &
        hydrostatic_buildrho_atmos_0d     => atmos_hydrostatic_buildrho_atmos_0d,     &
        hydrostatic_buildrho_atmos_rev_2d => atmos_hydrostatic_buildrho_atmos_rev_2d, &
        hydrostatic_buildrho_atmos_rev_3d => atmos_hydrostatic_buildrho_atmos_rev_3d
     implicit none
 
 
     real(RP) :: dens(KA,IA,JA)
     real(RP) :: temp(KA,IA,JA)
     real(RP) :: pres(KA,IA,JA)
     real(RP) :: pott(KA,IA,JA)
     real(RP) :: qv  (KA,IA,JA)
     real(RP) :: qc  (KA,IA,JA)
     real(RP) :: dz  (KA,IA,JA)
 
     real(RP) :: dens_toa_1D
     real(RP) :: temp_toa_1D
     real(RP) :: pres_toa_1D
     real(RP) :: qc_1D
     real(RP) :: dz_1D
 
     real(RP) :: work(KA,IA,JA)
     real(RP) :: RovCP
     integer  :: k, i, j
     !---------------------------------------------------------------------------
 
     rovcp = rdry / cpdry
 
     !--- potential temperature
     do j = jsb, jeb
     do i = isb, ieb
        work(:,i,j) = atmos_refstate1d_pott(:)
     enddo
     enddo
 
     call interp_vertical_z2xi( work(:,:,:), & ! [IN]
                                pott(:,:,:)  ) ! [OUT]
 
     !--- water vapor
     do j = jsb, jeb
     do i = isb, ieb
        work(:,i,j) = atmos_refstate1d_qv(:)
     enddo
     enddo
 
     call interp_vertical_z2xi( work(:,:,:), & ! [IN]
                                qv(:,:,:)  ) ! [OUT]
 
 
 
     !--- build up density to TOA (1D)
     qc_1d = 0.0_rp
     dz_1d = grid_fz(ke) - grid_cz(ke)
 
     call hydrostatic_buildrho_atmos_0d( dens_toa_1d,               & ! [OUT]
                                         temp_toa_1d,               & ! [OUT]
                                         pres_toa_1d,               & ! [OUT]
                                         atmos_refstate1d_pott(ke), & ! [IN]
                                         atmos_refstate1d_qv(ke), & ! [IN]
                                         qc_1d,                     & ! [IN]
                                         atmos_refstate1d_dens(ke), & ! [IN]
                                         atmos_refstate1d_pott(ke), & ! [IN]
                                         atmos_refstate1d_qv(ke), & ! [IN]
                                         qc_1d,                     & ! [IN]
                                         dz_1d,                     & ! [IN]
                                         ke+1                       ) ! [IN]
 
     ! build down density from TOA (3D)
     do j = jsb, jeb
     do i = isb, ieb
        dz(ks,i,j) = real_cz(ks,i,j) - real_fz(ks-1,i,j) ! distance from surface to cell center
        do k = ks+1, ke
           dz(k,i,j) = real_cz(k,i,j) - real_cz(k-1,i,j) ! distance from cell center to cell center
        enddo
        dz(ke+1,i,j) = real_fz(ke,i,j) - real_cz(ke,i,j) ! distance from cell center to TOA
     enddo
     enddo
 
     do j = jsb, jeb
     do i = isb, ieb
        dens(ke+1,i,j) = dens_toa_1d
        temp(ke+1,i,j) = temp_toa_1d
        pres(ke+1,i,j) = pres_toa_1d
        pott(ke+1,i,j) = pott(ke,i,j)
        qv(ke+1,i,j) = qv(ke,i,j)
     enddo
     enddo
 
     do j = jsb, jeb
     do i = isb, ieb
        pott(ks-1,i,j) = pott(ks,i,j)
        qv(ks-1,i,j) = qv(ks,i,j)
     enddo
     enddo
 
     qc(:,:,:) = 0.0_rp
 
     call hydrostatic_buildrho_atmos_rev_2d( dens(ke  ,:,:), & ! [OUT]
                                             temp(ke  ,:,:), & ! [OUT]
                                             pres(ke  ,:,:), & ! [OUT]
                                             pott(ke  ,:,:), & ! [IN]
                                             qv(ke  ,:,:), & ! [IN]
                                             qc(ke  ,:,:), & ! [IN]
                                             dens(ke+1,:,:), & ! [IN]
                                             pott(ke+1,:,:), & ! [IN]
                                             qv(ke+1,:,:), & ! [IN]
                                             qc(ke+1,:,:), & ! [IN]
                                             dz(ke+1,:,:), & ! [IN]
                                             ke+1            ) ! [IN]
 
     call hydrostatic_buildrho_atmos_rev_3d( dens(:,:,:), & ! [INOUT]
                                             temp(:,:,:), & ! [OUT]
                                             pres(:,:,:), & ! [OUT]
                                             pott(:,:,:), & ! [IN]
                                             qv(:,:,:), & ! [IN]
                                             qc(:,:,:), & ! [IN]
                                             dz(:,:,:)  ) ! [IN]
 
 !    call HYDROSTATIC_buildrho_atmos_rev_2D( dens(KS-1,:,:), & ! [OUT]
 !                                            temp(KS-1,:,:), & ! [OUT]
 !                                            pres(KS-1,:,:), & ! [OUT]
 !                                            pott(KS-1,:,:), & ! [IN]
 !                                            qv  (KS-1,:,:), & ! [IN]
 !                                            qc  (KS-1,:,:), & ! [IN]
 !                                            dens(KS  ,:,:), & ! [IN]
 !                                            pott(KS  ,:,:), & ! [IN]
 !                                            qv  (KS  ,:,:), & ! [IN]
 !                                            qc  (KS  ,:,:), & ! [IN]
 !                                            dz  (KS  ,:,:), & ! [IN]
 !                                            KS              ) ! [IN]
     do j = jsb, jeb
     do i = isb, ieb
     do k = ks, ke
        atmos_refstate_dens(k,i,j) = dens(k,i,j)
        atmos_refstate_temp(k,i,j) = temp(k,i,j)
        atmos_refstate_pres(k,i,j) = pres(k,i,j)
        atmos_refstate_pott(k,i,j) = pott(k,i,j)
        atmos_refstate_qv(k,i,j) = qv(k,i,j)
     enddo
     enddo
     enddo
 
     ! boundary condition
     do j = jsb, jeb
     do i = isb, ieb
 
        atmos_refstate_temp(1:ks-1,i,j) = temp(ks,i,j)
        atmos_refstate_temp(ke+1:ka,i,j) = temp_toa_1d
 
        atmos_refstate_qv(1:ks-1,i,j) = qv(ks,i,j)
        atmos_refstate_qv(ke+1:ka,i,j) = qv(ke,i,j)
 
        atmos_refstate_pres(1:ks-2,i,j) = undef
        atmos_refstate_pres(ks-1,i,j) = atmos_refstate_pres(ks+1,i,j) &
                                      - atmos_refstate_dens(ks  ,i,j) * ( real_phi(ks-1,i,j) - real_phi(ks+1,i,j) )
        atmos_refstate_pres(ke+1,i,j) = atmos_refstate_pres(ke-1,i,j) &
                                      - atmos_refstate_dens(ke  ,i,j) * ( real_phi(ke+1,i,j) - real_phi(ke-1,i,j) )
        atmos_refstate_pres(ke+2:ka,i,j) = undef
 
        atmos_refstate_dens(1:ks-2,i,j) = undef
        atmos_refstate_dens(ks-1,i,j) = atmos_refstate_pres(ks-1,i,j) / ( atmos_refstate_temp(ks-1,i,j) * rdry )
        atmos_refstate_dens(ke+1,i,j) = atmos_refstate_pres(ke+1,i,j) / ( atmos_refstate_temp(ke+1,i,j) * rdry )
        atmos_refstate_dens(ke+2:ka,i,j) = undef
 
        atmos_refstate_pott(1:ks-2,i,j) = undef
        atmos_refstate_pott(ks-1,i,j) = atmos_refstate_temp(ks-1,i,j) * ( p00 / atmos_refstate_pres(ks-1,i,j) )**rovcp
        atmos_refstate_pott(ke+1,i,j) = atmos_refstate_temp(ke+1,i,j) * ( p00 / atmos_refstate_pres(ke+1,i,j) )**rovcp
        atmos_refstate_pott(ke+2:ka,i,j) = undef
     enddo
     enddo
 
     call comm_vars8( atmos_refstate_dens(:,:,:), 1 )
     call comm_vars8( atmos_refstate_temp(:,:,:), 2 )
     call comm_vars8( atmos_refstate_pres(:,:,:), 3 )
     call comm_vars8( atmos_refstate_pott(:,:,:), 4 )
     call comm_vars8( atmos_refstate_qv(:,:,:), 5 )
     call comm_wait ( atmos_refstate_dens(:,:,:), 1, .false. )
     call comm_wait ( atmos_refstate_temp(:,:,:), 2, .false. )
     call comm_wait ( atmos_refstate_pres(:,:,:), 3, .false. )
     call comm_wait ( atmos_refstate_pott(:,:,:), 4, .false. )
     call comm_wait ( atmos_refstate_qv(:,:,:), 5, .false. )
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ smoothing()

subroutine scale_atmos_refstate::smoothing ( real(rp), dimension(ka), intent(inout) phi )

Definition at line 869 of file scale_atmos_sub_refstate.F90.

References scale_const::const_eps, scale_grid::grid_fdz, scale_grid::grid_rcdz, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::ke, scale_grid_index::ks, and scale_process::prc_mpistop().

Referenced by atmos_refstate_update().

     use scale_process, only: &
        prc_mpistop
     use scale_const, only: &
        eps => const_eps
     use scale_grid, only: &
        fdz  => grid_fdz,  &
        rcdz => grid_rcdz
     implicit none
 
     real(RP), intent(inout) :: phi(KA)
 
     real(RP) :: dev (KA)
     real(RP) :: flux(KA)
     real(RP) :: fact(KA)
 
     integer, parameter :: iter_max = 100
     real(RP) :: sig0, sig1, zerosw
     logical  :: updated
     integer  :: k, iter
     !---------------------------------------------------------------------------
 
     dev(ks) = 0.0_rp
     dev(ke) = 0.0_rp
 
     flux(ks-1:ks+1) = 0.0_rp
     flux(ke-1:ke+1) = 0.0_rp
 
     fact(ks-1:ks+1) = 0.0_rp
     fact(ke-1:ke+1) = 0.0_rp
 
     do iter = 1, iter_max
        updated = .false.
 
        do k = ks+1, ke-1
           dev(k) = phi(k) - ( fdz(k-1)*phi(k+1) + fdz(k)*phi(k-1) ) / ( fdz(k) + fdz(k-1) )
        enddo
 
        do k = ks+2, ke-2
           sig0 = dev(k) * dev(k-1)
           sig1 = dev(k) * dev(k+1)
           ! if (sig0>0 .OR. sig1>0) then flux(k) = 0.0
           flux(k) = dev(k) &
                   / ( 2.0_rp*rcdz(k) + ( fdz(k-1)*rcdz(k+1) + fdz(k)*rcdz(k-1) ) / ( fdz(k) + fdz(k-1) ) ) &
                   * ( sign(0.5_rp ,sig0) + sign(0.5_rp ,sig1)          ) &
                   * ( sign(0.25_rp,sig0) + sign(0.25_rp,sig1) - 0.5_rp )
           updated = updated .OR. ( sig0 < -eps .AND. sig1 < -eps )
        enddo
 
        sig1 = dev(ks+1) * dev(ks+2)
        flux(ks+1) = dev(ks+1) &
                   / ( 2.0_rp*rcdz(ks+1) + (fdz(ks)*rcdz(ks+2)+fdz(ks+1)*rcdz(ks))/(fdz(ks+1)+fdz(ks)) ) &
                   * ( 0.5_rp - sign(0.5_rp ,sig1) )
        updated = updated .OR. ( sig1 < -eps )
 
        sig0 = dev(ke-1) * dev(ke-2)
        flux(ke-1) = dev(ke-1) &
                   / ( 2.0_rp*rcdz(ke-1) + (fdz(ke-2)*rcdz(ke)+fdz(ke-1)*rcdz(ke-2))/(fdz(ke-1)+fdz(ke-2)) ) &
                   * ( 0.5_rp - sign(0.5_rp ,sig0) )
        updated = updated .OR. ( sig0 < -eps )
 
        if ( .NOT. updated ) exit
 
        do k = ks+1, ke-1
           zerosw = 0.5_rp - sign( 0.5_rp, abs(flux(k))-eps ) ! if flux(k) == 0 then fact(k) = 0.0
           fact(k) = flux(k) / ( flux(k) - flux(k+1) - flux(k-1) + zerosw )
        enddo
 
        do k = ks, ke
           phi(k) = phi(k) + ( flux(k+1) * fact(k+1)          &
                             - flux(k  ) * fact(k  ) * 2.0_rp &
                             + flux(k-1) * fact(k-1)          ) * rcdz(k)
        enddo
 
        if ( iter == iter_max ) then
           if( io_l ) write(io_fid_log,*) "*** [scale_atmos_refstate/smoothing] iteration not converged!", phi
        endif
     enddo
 
     return