module ATMOSPHERE / Boundary treatment More...

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

subroutine, public	atmos_boundary_resume (DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
	Resume. More...

subroutine	atmos_boundary_resume_file
	Resume boundary value for real case experiment. More...

subroutine	atmos_boundary_resume_online
	Resume boundary value for real case experiment [online daughter]. More...

subroutine, public	atmos_boundary_firstsend (DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
	First send boundary value. More...

subroutine, public	atmos_boundary_finalize
	Finalize boundary value. More...

subroutine, public	atmos_boundary_update (DENS, MOMZ, MOMX, MOMY, RHOT, QTRC)
	Update boundary value with a constant time boundary. More...

subroutine	update_ref_index
	Update indices of array of boundary references. More...

Variables
integer, public	bnd_qa

integer, public	of

integer, public	tracer

integer, public	at

integer, public	boundary

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_dens

real(rp), allocatable, public	reference

real(rp), dimension(0-1), allocatable, public	dens

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_velz

real(rp), dimension(0-1), allocatable, public	velz

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_velx

real(rp), dimension(0-1), allocatable, public	velx

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_vely

real(rp), dimension(0-1), allocatable, public	vely

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_pott

real(rp), dimension(0-1), allocatable, public	pott

real(rp), dimension(:,:,:,:), allocatable, public	atmos_boundary_qtrc

real(rp), dimension(0-1), allocatable, public	qtrc

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_alpha_dens

real(rp), allocatable, public	damping

real(rp), allocatable, public	coefficient

real(rp), allocatable, public	for

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_alpha_velz

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_alpha_velx

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_alpha_vely

real(rp), dimension(:,:,:), allocatable, public	atmos_boundary_alpha_pott

real(rp), dimension(:,:,:,:), allocatable, public	atmos_boundary_alpha_qtrc

real(rp), public	atmos_boundary_smoother_fact = 0.2_RP

logical, public	atmos_boundary_update_flag = .false.

logical, public	switch

logical, public	real

logical, public	case

Detailed Description

module ATMOSPHERE / Boundary treatment

Description: Boundary treatment of model domain Additional forcing, Sponge layer, rayleigh dumping

Author: Team SCALE

History

2011-12-07 (Y.Miyamoto) [new]
2011-12-11 (H.Yashiro) [mod] integrate to SCALE-LES ver.3
2012-03-23 (H.Yashiro) [mod] Explicit index parameter inclusion
2014-05-18 (R.Yoshida) [add] boudary read/update for real case
2014-09-05 (R.Yoshida) [add] boudary update by online communicate

NAMELIST

PARAM_ATMOS_BOUNDARY

name	type	default value	comment
ATMOS_BOUNDARY_TYPE	character(len=H_SHORT)	'NONE'
ATMOS_BOUNDARY_IN_BASENAME	character(len=H_LONG)	''
ATMOS_BOUNDARY_IN_CHECK_COORDINATES	logical	.true.
ATMOS_BOUNDARY_OUT_BASENAME	character(len=H_LONG)	''
ATMOS_BOUNDARY_OUT_TITLE	character(len=H_MID)	'SCALE-RM BOUNDARY CONDITION'	title of the output file
ATMOS_BOUNDARY_OUT_DTYPE	character(len=H_SHORT)	'DEFAULT'	REAL4 or REAL8
ATMOS_BOUNDARY_USE_VELZ	logical	.false.	read from file?
ATMOS_BOUNDARY_USE_VELX	logical	.false.	read from file?
ATMOS_BOUNDARY_USE_VELY	logical	.false.	read from file?
ATMOS_BOUNDARY_USE_POTT	logical	.false.	read from file?
ATMOS_BOUNDARY_USE_DENS	logical	.false.	read from file?
ATMOS_BOUNDARY_USE_QV	logical	.false.	read from file?
ATMOS_BOUNDARY_USE_QHYD	logical	.false.	read from file?
ATMOS_BOUNDARY_VALUE_VELZ	real(RP)	0.0_RP	velocity w at boundary, 0 [m/s]
ATMOS_BOUNDARY_VALUE_VELX	real(RP)	0.0_RP	velocity u at boundary, 0 [m/s]
ATMOS_BOUNDARY_VALUE_VELY	real(RP)	0.0_RP	velocity v at boundary, 0 [m/s]
ATMOS_BOUNDARY_VALUE_POTT	real(RP)	300.0_RP	potential temp. at boundary, 300 [K]
ATMOS_BOUNDARY_VALUE_QTRC	real(RP)	0.0_RP	tracer at boundary, 0 [kg/kg]
ATMOS_BOUNDARY_ALPHAFACT_DENS	real(RP)	1.0_RP	alpha factor again default
ATMOS_BOUNDARY_ALPHAFACT_VELZ	real(RP)	1.0_RP	alpha factor again default
ATMOS_BOUNDARY_ALPHAFACT_VELX	real(RP)	1.0_RP	alpha factor again default
ATMOS_BOUNDARY_ALPHAFACT_VELY	real(RP)	1.0_RP	alpha factor again default
ATMOS_BOUNDARY_ALPHAFACT_POTT	real(RP)	1.0_RP	alpha factor again default
ATMOS_BOUNDARY_ALPHAFACT_QTRC	real(RP)	1.0_RP	alpha factor again default
ATMOS_BOUNDARY_SMOOTHER_FACT	real(RP)	0.2_RP	fact for smoother to damping
ATMOS_BOUNDARY_FRACZ	real(RP)	1.0_RP	fraction of boundary region for dumping (z) (0-1)
ATMOS_BOUNDARY_FRACX	real(RP)	1.0_RP	fraction of boundary region for dumping (x) (0-1)
ATMOS_BOUNDARY_FRACY	real(RP)	1.0_RP	fraction of boundary region for dumping (y) (0-1)
ATMOS_BOUNDARY_TAUZ	real(RP)		maximum value for damping tau (z) [s]
ATMOS_BOUNDARY_TAUX	real(RP)		maximum value for damping tau (x) [s]
ATMOS_BOUNDARY_TAUY	real(RP)		maximum value for damping tau (y) [s]
ATMOS_BOUNDARY_UPDATE_DT	real(DP)	0.0_DP	inteval time of boudary data update [s]
ATMOS_BOUNDARY_START_DATE	integer, dimension(6)	(/ -9999, 0, 0, 0, 0, 0 /)	boundary initial date
ATMOS_BOUNDARY_LINEAR_V	logical	.false.	linear or non-linear profile of relax region
ATMOS_BOUNDARY_LINEAR_H	logical	.true.	linear or non-linear profile of relax region
ATMOS_BOUNDARY_EXP_H	real(RP)	2.0_RP	factor of non-linear profile of relax region
ATMOS_BOUNDARY_INTERP_TYPE	character(len=H_LONG)	'lerp_initpoint'	type of boundary interporation

History Output

name	description	unit	variable
DENS_BND	Boundary Density	kg/m3	ATMOS_BOUNDARY_DENS
POTT_BND	Boundary potential temperature	K	ATMOS_BOUNDARY_POTT
VELX_BND	Boundary velocity x-direction	m/s	ATMOS_BOUNDARY_VELX
VELY_BND	Boundary velocity y-direction	m/s	ATMOS_BOUNDARY_VELY
VELZ_BND	Boundary velocity z-direction	m/s	ATMOS_BOUNDARY_VELZ
AQ_NAME_BND	tracer name in the boundary data; AQ_NAME depends on the parent model or data, e.g, QV, QC, QR.	kg/kg	ATMOS_BOUNDARY_QTRC

Function/Subroutine Documentation

◆ atmos_boundary_setup()

subroutine, public scale_atmos_boundary::atmos_boundary_setup ( )

Setup.

Definition at line 203 of file scale_atmos_sub_boundary.F90.

References atmos_boundary_alpha_dens, atmos_boundary_alpha_pott, atmos_boundary_alpha_qtrc, atmos_boundary_alpha_velx, atmos_boundary_alpha_vely, atmos_boundary_alpha_velz, atmos_boundary_dens, atmos_boundary_pott, atmos_boundary_qtrc, atmos_boundary_smoother_fact, atmos_boundary_update_flag, atmos_boundary_velx, atmos_boundary_vely, atmos_boundary_velz, bnd_qa, scale_comm::comm_fill_bnd, scale_const::const_undef, 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, scale_grid_nest::offline, scale_grid_nest::online_iam_daughter, scale_grid_nest::online_iam_parent, scale_process::prc_mpistop(), scale_atmos_phy_mp::qa_mp, scale_time::time_dtsec, and scale_grid_nest::use_nesting.

Referenced by mod_atmos_driver::atmos_driver_setup().

     use scale_process, only: &
        prc_mpistop
     use scale_comm, only: &
        comm_fill_bnd
     use scale_const, only: &
        const_undef
     use scale_time, only: &
        dt => time_dtsec
     use scale_grid_nest, only: &
        use_nesting,         &
        offline,             &
        online_iam_parent,   &
        online_iam_daughter
     use scale_atmos_phy_mp, only: &
        qa_mp
     implicit none
 
     namelist / param_atmos_boundary / &
        atmos_boundary_type,           &
        atmos_boundary_in_basename,    &
        atmos_boundary_in_check_coordinates, &
        atmos_boundary_out_basename,   &
        atmos_boundary_out_title,      &
        atmos_boundary_out_dtype,      &
        atmos_boundary_use_velz,       &
        atmos_boundary_use_velx,       &
        atmos_boundary_use_vely,       &
        atmos_boundary_use_pott,       &
        atmos_boundary_use_dens,       &
        atmos_boundary_use_qv,         &
        atmos_boundary_use_qhyd,       &
        atmos_boundary_value_velz,     &
        atmos_boundary_value_velx,     &
        atmos_boundary_value_vely,     &
        atmos_boundary_value_pott,     &
        atmos_boundary_value_qtrc,     &
        atmos_boundary_alphafact_dens, &
        atmos_boundary_alphafact_velz, &
        atmos_boundary_alphafact_velx, &
        atmos_boundary_alphafact_vely, &
        atmos_boundary_alphafact_pott, &
        atmos_boundary_alphafact_qtrc, &
        atmos_boundary_smoother_fact,  &
        atmos_boundary_fracz,          &
        atmos_boundary_fracx,          &
        atmos_boundary_fracy,          &
        atmos_boundary_tauz,           &
        atmos_boundary_taux,           &
        atmos_boundary_tauy,           &
        atmos_boundary_update_dt,      &
        atmos_boundary_start_date,     &
        atmos_boundary_linear_v,       &
        atmos_boundary_linear_h,       &
        atmos_boundary_exp_h,          &
        atmos_boundary_interp_type
 
     integer :: ierr
     !---------------------------------------------------------------------------
 
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '++++++ Module[BOUNDARY] / Categ[ATMOS-RM] / Origin[SCALElib]'
 
     atmos_boundary_tauz = dt * 10.0_rp
     atmos_boundary_taux = dt * 10.0_rp
     atmos_boundary_tauy = dt * 10.0_rp
 
     !--- read namelist
     rewind(io_fid_conf)
     read(io_fid_conf,nml=param_atmos_boundary,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_BOUNDARY. Check!'
        call prc_mpistop
     endif
     if( io_nml ) write(io_fid_nml,nml=param_atmos_boundary)
 
     ! setting switches
     if( .NOT. use_nesting ) then
        atmos_boundary_online = .false.
     else
        if( offline ) then
           atmos_boundary_online = .false.
        else
           atmos_boundary_online = .true.
        endif
     endif
     do_parent_process   = .false.
     do_daughter_process = .false.
     atmos_boundary_online_master = .false.
     if ( atmos_boundary_online ) then
        if ( online_iam_parent ) then
           do_parent_process = .true.
           if ( .NOT. online_iam_daughter ) then
              atmos_boundary_online_master = .true.
           endif
        endif
        if ( online_iam_daughter ) then
           do_daughter_process = .true.
        endif
     endif
 
     if( atmos_boundary_use_qhyd ) then
        bnd_qa = qa_mp
     else if ( qa_mp > 0 ) then
        bnd_qa = 1
     else
        bnd_qa = 0
     end if
 
     allocate( atmos_boundary_dens(ka,ia,ja) )
     allocate( atmos_boundary_velz(ka,ia,ja) )
     allocate( atmos_boundary_velx(ka,ia,ja) )
     allocate( atmos_boundary_vely(ka,ia,ja) )
     allocate( atmos_boundary_pott(ka,ia,ja) )
     allocate( atmos_boundary_qtrc(ka,ia,ja,bnd_qa) )
     atmos_boundary_dens(:,:,:)   = const_undef
     atmos_boundary_velz(:,:,:)   = const_undef
     atmos_boundary_velx(:,:,:)   = const_undef
     atmos_boundary_vely(:,:,:)   = const_undef
     atmos_boundary_pott(:,:,:)   = const_undef
     atmos_boundary_qtrc(:,:,:,:) = const_undef
 
     allocate( atmos_boundary_alpha_dens(ka,ia,ja) )
     allocate( atmos_boundary_alpha_velz(ka,ia,ja) )
     allocate( atmos_boundary_alpha_velx(ka,ia,ja) )
     allocate( atmos_boundary_alpha_vely(ka,ia,ja) )
     allocate( atmos_boundary_alpha_pott(ka,ia,ja) )
     allocate( atmos_boundary_alpha_qtrc(ka,ia,ja,bnd_qa) )
     atmos_boundary_alpha_dens(:,:,:)   = 0.0_rp
     atmos_boundary_alpha_velz(:,:,:)   = 0.0_rp
     atmos_boundary_alpha_velx(:,:,:)   = 0.0_rp
     atmos_boundary_alpha_vely(:,:,:)   = 0.0_rp
     atmos_boundary_alpha_pott(:,:,:)   = 0.0_rp
     atmos_boundary_alpha_qtrc(:,:,:,:) = 0.0_rp
 
     if ( atmos_boundary_type == 'REAL' .OR. do_daughter_process ) then
        l_bnd = .true.
     else
        l_bnd = .false.
     end if
 
     if ( l_bnd ) then
 
        select case(atmos_boundary_interp_type)
        case('same_parent')
           get_boundary => get_boundary_same_parent
        case('nearest_neighbor')
           get_boundary => get_boundary_nearest_neighbor
        case('lerp_initpoint')
           get_boundary => get_boundary_lerp_initpoint
        case('lerp_midpoint')
           get_boundary => get_boundary_lerp_midpoint
        case default
           write(*,*) 'xxx Wrong parameter in ATMOS_BOUNDARY_interp_TYPE. Check!'
           call prc_mpistop
        end select
 
        comm_fill_bnd = .false.
 
        allocate( atmos_boundary_ref_dens(ka,ia,ja,ref_size) )
        allocate( atmos_boundary_ref_velz(ka,ia,ja,ref_size) )
        allocate( atmos_boundary_ref_velx(ka,ia,ja,ref_size) )
        allocate( atmos_boundary_ref_vely(ka,ia,ja,ref_size) )
        allocate( atmos_boundary_ref_pott(ka,ia,ja,ref_size) )
        allocate( atmos_boundary_ref_qtrc(ka,ia,ja,bnd_qa,ref_size) )
        atmos_boundary_ref_dens(:,:,:,:)   = const_undef
        atmos_boundary_ref_velz(:,:,:,:)   = const_undef
        atmos_boundary_ref_velx(:,:,:,:)   = const_undef
        atmos_boundary_ref_vely(:,:,:,:)   = const_undef
        atmos_boundary_ref_pott(:,:,:,:)   = const_undef
        atmos_boundary_ref_qtrc(:,:,:,:,:) = const_undef
 
        ! initialize boundary value (reading file or waiting parent domain)
        if ( do_daughter_process ) then
           call atmos_boundary_initialize_online
        else
           if ( atmos_boundary_in_basename /= '' ) then
              call atmos_boundary_initialize_file
           else
              write(*,*) 'xxx You need specify ATMOS_BOUNDARY_IN_BASENAME'
              call prc_mpistop
           endif
        endif
 
        call atmos_boundary_setalpha
 
        atmos_boundary_update_flag = .true.
 
     elseif ( atmos_boundary_type == 'NONE' ) then
 
        atmos_boundary_update_flag = .false.
 
     elseif ( atmos_boundary_type == 'CONST' ) then
 
        call atmos_boundary_generate
 
        call atmos_boundary_setalpha
 
        atmos_boundary_update_flag = .false.
 
     elseif ( atmos_boundary_type == 'INIT' ) then
 
        call atmos_boundary_setalpha
 
        atmos_boundary_update_flag = .false.
 
     elseif ( atmos_boundary_type == 'FILE' ) then
 
        if ( atmos_boundary_in_basename /= '' ) then
           call atmos_boundary_read
        else
           write(*,*) 'xxx You need specify ATMOS_BOUNDARY_IN_BASENAME'
           call prc_mpistop
        endif
 
        atmos_boundary_update_flag = .false.
 
     else
        write(*,*) 'xxx unsupported ATMOS_BOUNDARY_TYPE. Check!', trim(atmos_boundary_type)
        call prc_mpistop
     endif
 
     if ( use_nesting ) atmos_boundary_update_flag = .true.
 
     !----- report data -----
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary parameters ***'
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary type                      : ', atmos_boundary_type
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '*** Is VELZ used in atmospheric boundary?          : ', atmos_boundary_use_velz
     if( io_l ) write(io_fid_log,*) '*** Is VELX used in atmospheric boundary?          : ', atmos_boundary_use_velx
     if( io_l ) write(io_fid_log,*) '*** Is VELY used in atmospheric boundary?          : ', atmos_boundary_use_vely
     if( io_l ) write(io_fid_log,*) '*** Is POTT used in atmospheric boundary?          : ', atmos_boundary_use_pott
     if( io_l ) write(io_fid_log,*) '*** Is DENS used in atmospheric boundary?          : ', atmos_boundary_use_dens
     if( io_l ) write(io_fid_log,*) '*** Is QV   used in atmospheric boundary?          : ', atmos_boundary_use_qv
     if( io_l ) write(io_fid_log,*) '*** Is QHYD used in atmospheric boundary?          : ', atmos_boundary_use_qhyd
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary VELZ values               : ', atmos_boundary_value_velz
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary VELX values               : ', atmos_boundary_value_velx
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary VELY values               : ', atmos_boundary_value_vely
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary POTT values               : ', atmos_boundary_value_pott
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary QTRC values               : ', atmos_boundary_value_qtrc
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary smoother factor           : ', atmos_boundary_smoother_fact
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary z-fraction                : ', atmos_boundary_fracz
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary x-fraction                : ', atmos_boundary_fracx
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary y-fraction                : ', atmos_boundary_fracy
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary z-relaxation time         : ', atmos_boundary_tauz
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary x-relaxation time         : ', atmos_boundary_taux
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary y-relaxation time         : ', atmos_boundary_tauy
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary update dt                 : ', atmos_boundary_update_dt
     if( io_l ) write(io_fid_log,*) '*** Atmospheric boundary start date                : ', atmos_boundary_start_date(:)
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '*** Linear profile in vertically relax region      : ', atmos_boundary_linear_v
     if( io_l ) write(io_fid_log,*) '*** Linear profile in horizontally relax region    : ', atmos_boundary_linear_h
     if( io_l ) write(io_fid_log,*) '*** Non-linear factor in horizontally relax region : ', atmos_boundary_exp_h
     if( io_l ) write(io_fid_log,*)
     if( io_l ) write(io_fid_log,*) '*** Online nesting for lateral boundary            : ', atmos_boundary_online
 
     if( io_l ) write(io_fid_log,*) '*** Does lateral boundary exist in this domain?    : ', l_bnd
     if ( l_bnd ) then
        if( io_l ) write(io_fid_log,*) '*** Lateral boundary interporation type                : ', atmos_boundary_interp_type
     endif
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_boundary_resume()

subroutine, public scale_atmos_boundary::atmos_boundary_resume	(	real(rp), dimension(ka,ia,ja), intent(in)	DENS,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMZ,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMX,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMY,
		real(rp), dimension(ka,ia,ja), intent(in)	RHOT,
		real(rp), dimension(ka,ia,ja,qa), intent(in)	QTRC
	)

Resume.

Definition at line 481 of file scale_atmos_sub_boundary.F90.

References atmos_boundary_alpha_dens, atmos_boundary_alpha_pott, atmos_boundary_alpha_qtrc, atmos_boundary_alpha_velx, atmos_boundary_alpha_vely, atmos_boundary_alpha_velz, atmos_boundary_dens, atmos_boundary_firstsend(), atmos_boundary_pott, atmos_boundary_qtrc, atmos_boundary_resume_file(), atmos_boundary_resume_online(), atmos_boundary_update_flag, atmos_boundary_velx, atmos_boundary_vely, atmos_boundary_velz, scale_atmos_phy_mp::atmos_phy_mp_name, scale_atmos_phy_mp::atmos_phy_mp_unit, scale_atmos_refstate::atmos_refstate_dens, bnd_qa, scale_calendar::calendar_combine_daysec(), scale_calendar::calendar_date2char(), scale_calendar::calendar_date2daysec(), scale_const::const_eps, scale_const::const_pi, dens, scale_fileio::fileio_close(), scale_fileio::fileio_open(), scale_grid::grid_cbfx, scale_grid::grid_cbfy, scale_grid::grid_cbfz, scale_grid::grid_fbfx, scale_grid::grid_fbfy, scale_grid::grid_fbfz, scale_grid_index::ia, scale_grid_index::ieb, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::isb, scale_grid_index::ja, scale_grid_index::jeb, scale_grid_index::jsb, scale_grid_index::ka, scale_grid_index::ke, scale_grid_index::ks, scale_grid_nest::online_use_velz, scale_process::prc_mpistop(), scale_atmos_phy_mp::qs_mp, qtrc, and scale_time::time_nowdate.

Referenced by mod_atmos_driver::atmos_driver_resume1().

     implicit none
 
     real(RP), intent(in) :: DENS(KA,IA,JA)
     real(RP), intent(in) :: MOMZ(KA,IA,JA)
     real(RP), intent(in) :: MOMX(KA,IA,JA)
     real(RP), intent(in) :: MOMY(KA,IA,JA)
     real(RP), intent(in) :: RHOT(KA,IA,JA)
     real(RP), intent(in) :: QTRC(KA,IA,JA,QA)
 
 
     call atmos_boundary_firstsend( &
          dens, momz, momx, momy, rhot, qtrc )
 
     if ( l_bnd ) then
 
        ! initialize boundary value (reading file or waiting parent domain)
        if ( do_daughter_process ) then
           call atmos_boundary_resume_online
        else
           if ( atmos_boundary_in_basename /= '' ) then
              call atmos_boundary_resume_file
           endif
        endif
 
     elseif ( atmos_boundary_type == 'INIT' ) then
 
        call atmos_boundary_setinitval( dens, & ! [IN]
                                        momz, & ! [IN]
                                        momx, & ! [IN]
                                        momy, & ! [IN]
                                        rhot, & ! [IN]
                                        qtrc  ) ! [IN]
     endif
 
     if( atmos_boundary_out_basename /= '' ) then
        call atmos_boundary_write
     endif
 
     if ( atmos_boundary_update_flag ) then
 
        call history_bnd( &
             atmos_boundary_dens, &
             atmos_boundary_velz, &
             atmos_boundary_velx, &
             atmos_boundary_vely, &
             atmos_boundary_pott, &
             atmos_boundary_qtrc )
     end if
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_boundary_resume_file()

subroutine scale_atmos_boundary::atmos_boundary_resume_file ( )

Resume boundary value for real case experiment.

Definition at line 1272 of file scale_atmos_sub_boundary.F90.

References atmos_boundary_dens, atmos_boundary_pott, atmos_boundary_qtrc, atmos_boundary_velx, atmos_boundary_vely, atmos_boundary_velz, bnd_qa, scale_calendar::calendar_combine_daysec(), scale_calendar::calendar_date2daysec(), scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_nest::nest_bnd_qa, scale_grid_nest::nest_comm_recvwait_issue(), scale_grid_nest::online_use_velz, scale_grid_nest::parent_dtsec, scale_process::prc_mpistop(), scale_time::time_dtsec, and scale_time::time_nowdate.

Referenced by atmos_boundary_resume().

     use gtool_file, only: &
        fileread
     use scale_process, only: &
        prc_mpistop
     use scale_time, only: &
        time_nowdate,      &
        time_dtsec
     use scale_calendar, only: &
        calendar_date2daysec,    &
        calendar_combine_daysec
     implicit none
 
     real(RP) :: bnd_DENS(KA,IA,JA)        ! damping coefficient for DENS (0-1)
     real(RP) :: bnd_VELZ(KA,IA,JA)        ! damping coefficient for VELZ (0-1)
     real(RP) :: bnd_VELX(KA,IA,JA)        ! damping coefficient for VELX (0-1)
     real(RP) :: bnd_VELY(KA,IA,JA)        ! damping coefficient for VELY (0-1)
     real(RP) :: bnd_POTT(KA,IA,JA)        ! damping coefficient for POTT (0-1)
     real(RP) :: bnd_QTRC(KA,IA,JA,BND_QA) ! damping coefficient for QTRC (0-1)
 
     integer  :: run_time_startdate(6)
     integer  :: run_time_startday
     real(DP) :: run_time_startsec
     real(DP) :: run_time_startms
     integer  :: run_time_offset_year
     real(DP) :: run_time_nowdaysec
 
     real(DP) :: boundary_diff_daysec
     real(RP) :: boundary_inc_offset
     integer  :: fillgaps_steps
 
     integer  :: i, j, k, iq
     !---------------------------------------------------------------------------
 
     if ( atmos_boundary_update_dt <= 0.0_dp ) then
        write(*,*) 'xxx You need specify ATMOS_BOUNDARY_UPDATE_DT as larger than 0.0'
        call prc_mpistop
     endif
     update_nstep = nint( atmos_boundary_update_dt / time_dtsec )
     if ( abs(update_nstep * time_dtsec - atmos_boundary_update_dt) > 1e-10_dp ) then
        write(*,*) 'xxx ATMOS_BOUNDARY_UPDATE_DT is not multiple of DT'
        call prc_mpistop
     end if
 
     !--- recalculate time of the run [no offset]
     run_time_startdate(:) = time_nowdate(:)
     run_time_startms      = 0.0_dp
     run_time_offset_year  = 0
 
     call calendar_date2daysec( run_time_startday,     & ! [OUT]
                                run_time_startsec,     & ! [OUT]
                                run_time_startdate(:), & ! [IN]
                                run_time_startms,      & ! [IN]
                                run_time_offset_year   ) ! [IN]
 
     run_time_nowdaysec = calendar_combine_daysec( run_time_startday, run_time_startsec )
 
     boundary_diff_daysec = run_time_nowdaysec - boundary_time_initdaysec
     boundary_timestep    = 1 + int( boundary_diff_daysec / atmos_boundary_update_dt )
     boundary_inc_offset  = mod( boundary_diff_daysec, atmos_boundary_update_dt )
     fillgaps_steps       = int( boundary_inc_offset / time_dtsec )
 
     if( io_l ) write(io_fid_log,*) '+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
     if( io_l ) write(io_fid_log,*) '+++ BOUNDARY OFFSET:', boundary_inc_offset
     if( io_l ) write(io_fid_log,*) '+++ BOUNDARY FILLGAPS STEPS:', fillgaps_steps
 
     ! read boundary data from input file
     call atmos_boundary_update_file( ref_now )
 
     boundary_timestep = boundary_timestep + 1
     call atmos_boundary_update_file( ref_new )
 
     ! copy now to old
     !$omp parallel do default(none) private(i,j,k,iq) OMP_SCHEDULE_ collapse(2) &
     !$omp shared(JA,IA,KA,ATMOS_BOUNDARY_ref_DENS,ref_old,ref_now,ATMOS_BOUNDARY_ref_VELX) &
     !$omp shared(ATMOS_BOUNDARY_ref_VELY,ATMOS_BOUNDARY_ref_POTT,BND_QA,ATMOS_BOUNDARY_ref_QTRC)
     do j = 1, ja
     do i = 1, ia
     do k = 1, ka
        atmos_boundary_ref_dens(k,i,j,ref_old) = atmos_boundary_ref_dens(k,i,j,ref_now)
        atmos_boundary_ref_velx(k,i,j,ref_old) = atmos_boundary_ref_velx(k,i,j,ref_now)
        atmos_boundary_ref_vely(k,i,j,ref_old) = atmos_boundary_ref_vely(k,i,j,ref_now)
        atmos_boundary_ref_pott(k,i,j,ref_old) = atmos_boundary_ref_pott(k,i,j,ref_now)
        do iq = 1, bnd_qa
           atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
        end do
     end do
     end do
     end do
 
     ! set boundary data
     do j = 1, ja
     do i = 1, ia
     do k = 1, ka
        atmos_boundary_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_now)
        atmos_boundary_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_now)
        atmos_boundary_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_now)
        atmos_boundary_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_now)
        do iq = 1, bnd_qa
           atmos_boundary_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
        end do
     end do
     end do
     end do
 
     if ( atmos_boundary_use_velz ) then
        do j = 1, ja
        do i = 1, ia
        do k = 1, ka
           atmos_boundary_velz(k,i,j) = atmos_boundary_value_velz
        end do
        end do
        end do
     end if
 
     now_step = fillgaps_steps
 
     ! get time boundary
     call get_boundary( bnd_dens(:,:,:),   & ! [OUT]
                        bnd_velz(:,:,:),   & ! [OUT]
                        bnd_velx(:,:,:),   & ! [OUT]
                        bnd_vely(:,:,:),   & ! [OUT]
                        bnd_pott(:,:,:),   & ! [OUT]
                        bnd_qtrc(:,:,:,:), & ! [OUT]
                        now_step,          & ! [IN]
                        update_nstep       ) ! [IN]
 
     ! fill in gaps of the offset
     do j = 1, ja
     do i = 1, ia
     do k = 1, ka
        atmos_boundary_dens(k,i,j) = bnd_dens(k,i,j)
        atmos_boundary_velx(k,i,j) = bnd_velx(k,i,j)
        atmos_boundary_vely(k,i,j) = bnd_vely(k,i,j)
        atmos_boundary_pott(k,i,j) = bnd_pott(k,i,j)
        do iq = 1, bnd_qa
          atmos_boundary_qtrc(k,i,j,iq) = bnd_qtrc(k,i,j,iq)
        end do
     end do
     end do
     end do
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_boundary_resume_online()

subroutine scale_atmos_boundary::atmos_boundary_resume_online ( )

Resume boundary value for real case experiment [online daughter].

Definition at line 1448 of file scale_atmos_sub_boundary.F90.

References atmos_boundary_dens, atmos_boundary_pott, atmos_boundary_qtrc, atmos_boundary_velx, atmos_boundary_vely, atmos_boundary_velz, bnd_qa, scale_grid_index::ia, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::ja, scale_grid_index::ka, scale_grid_nest::nest_comm_recvwait_issue(), scale_grid_nest::online_use_velz, scale_grid_nest::parent_nstep, scale_process::prc_mpistop(), scale_time::time_dtsec, and scale_time::time_nstep.

Referenced by atmos_boundary_resume().

     use scale_process, only: &
        prc_mpistop
     use scale_time, only: &
        time_dtsec,        &
        time_nstep
     use scale_grid_nest, only: &
        nest_comm_recvwait_issue, &
        online_use_velz,          &
        parent_nstep
     implicit none
 
     ! parameters
     integer, parameter  :: handle = 2
 
     ! works
     integer  :: i, j, k, iq
     !---------------------------------------------------------------------------
 
     ! import data from parent domain
     boundary_timestep = 1
     if( io_l ) write(io_fid_log,*) '+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
 
     call atmos_boundary_update_online_daughter( ref_now )
 
     boundary_timestep = boundary_timestep + 1
     if( io_l ) write(io_fid_log,*) '+++ BOUNDARY TIMESTEP NUMBER FOR INIT:', boundary_timestep
 
     call atmos_boundary_update_online_daughter( ref_new )
 
     ! copy now to old
     do j = 1, ja
     do i = 1, ia
     do k = 1, ka
        atmos_boundary_ref_dens(k,i,j,ref_old) = atmos_boundary_ref_dens(k,i,j,ref_now)
        atmos_boundary_ref_velx(k,i,j,ref_old) = atmos_boundary_ref_velx(k,i,j,ref_now)
        atmos_boundary_ref_vely(k,i,j,ref_old) = atmos_boundary_ref_vely(k,i,j,ref_now)
        atmos_boundary_ref_pott(k,i,j,ref_old) = atmos_boundary_ref_pott(k,i,j,ref_now)
        do iq = 1, bnd_qa
           atmos_boundary_ref_qtrc(k,i,j,iq,ref_old) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
        end do
     end do
     end do
     end do
 
     ! set boundary data
     do j = 1, ja
     do i = 1, ia
     do k = 1, ka
        atmos_boundary_dens(k,i,j) = atmos_boundary_ref_dens(k,i,j,ref_now)
        atmos_boundary_velx(k,i,j) = atmos_boundary_ref_velx(k,i,j,ref_now)
        atmos_boundary_vely(k,i,j) = atmos_boundary_ref_vely(k,i,j,ref_now)
        atmos_boundary_pott(k,i,j) = atmos_boundary_ref_pott(k,i,j,ref_now)
        do iq = 1, bnd_qa
           atmos_boundary_qtrc(k,i,j,iq) = atmos_boundary_ref_qtrc(k,i,j,iq,ref_now)
        end do
     end do
     end do
     end do
 
     if ( online_use_velz ) then
        do j = 1, ja
        do i = 1, ia
        do k = 1, ka
           atmos_boundary_velz(k,i,j) = atmos_boundary_ref_velz(k,i,j,ref_now)
        end do
        end do
        end do
     else if ( atmos_boundary_use_velz ) then
        do j = 1, ja
        do i = 1, ia
        do k = 1, ka
           atmos_boundary_velz(k,i,j) = atmos_boundary_value_velz
        end do
        end do
        end do
     end if
 
     update_nstep = nint( atmos_boundary_update_dt / time_dtsec )
     if ( update_nstep * parent_nstep(handle) /= time_nstep ) then
        write(*,*) 'xxx NSTEP is not multiple of PARENT_NSTEP'
        call prc_mpistop
     end if
 
     now_step = 0 ! should be set as zero in initialize process
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_boundary_firstsend()

subroutine, public scale_atmos_boundary::atmos_boundary_firstsend	(	real(rp), dimension(ka,ia,ja), intent(in)	DENS,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMZ,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMX,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMY,
		real(rp), dimension(ka,ia,ja), intent(in)	RHOT,
		real(rp), dimension(ka,ia,ja,qa), intent(in)	QTRC
	)

First send boundary value.

Definition at line 1540 of file scale_atmos_sub_boundary.F90.

References dens, and qtrc.

Referenced by atmos_boundary_resume().

     implicit none
 
     ! arguments
     real(RP), intent(in) :: DENS(KA,IA,JA)
     real(RP), intent(in) :: MOMZ(KA,IA,JA)
     real(RP), intent(in) :: MOMX(KA,IA,JA)
     real(RP), intent(in) :: MOMY(KA,IA,JA)
     real(RP), intent(in) :: RHOT(KA,IA,JA)
     real(RP), intent(in) :: QTRC(KA,IA,JA,QA)
     !---------------------------------------------------------------------------
 
     ! send data at the first time
     if ( do_parent_process ) then !online [parent]
        ! issue send
        call atmos_boundary_send( dens, momz, momx, momy, rhot, qtrc )
     endif
 
     return

Here is the caller graph for this function:

◆ atmos_boundary_finalize()

subroutine, public scale_atmos_boundary::atmos_boundary_finalize ( )

Finalize boundary value.

Definition at line 1563 of file scale_atmos_sub_boundary.F90.

References scale_fileio::fileio_close(), scale_grid_nest::nest_bnd_qa, scale_grid_nest::nest_comm_recv_cancel(), and scale_grid_nest::nest_comm_recvwait_issue().

Referenced by mod_atmos_driver::atmos_driver_finalize().

     use scale_grid_nest, only: &
        nest_comm_recvwait_issue, &
        nest_comm_recv_cancel,    &
        nestqa => nest_bnd_qa
     use scale_fileio, only: &
        fileio_close
     implicit none
 
     ! works
     integer :: handle
     !---------------------------------------------------------------------------
 
     if ( do_parent_process ) then !online [parent]
        handle = 1
        call nest_comm_recvwait_issue( handle, nestqa )
     endif
 
     if ( do_daughter_process ) then !online [daughter]
        handle = 2
        call nest_comm_recv_cancel( handle )
     endif
 
     if ( atmos_boundary_fid > 0 ) then
        call fileio_close( atmos_boundary_fid )
        atmos_boundary_fid = -1
     end if
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ atmos_boundary_update()

subroutine, public scale_atmos_boundary::atmos_boundary_update	(	real(rp), dimension(ka,ia,ja), intent(inout)	DENS,
		real(rp), dimension(ka,ia,ja), intent(inout)	MOMZ,
		real(rp), dimension(ka,ia,ja), intent(inout)	MOMX,
		real(rp), dimension(ka,ia,ja), intent(inout)	MOMY,
		real(rp), dimension(ka,ia,ja), intent(inout)	RHOT,
		real(rp), dimension(ka,ia,ja,qa), intent(inout)	QTRC
	)

Update boundary value with a constant time boundary.

Definition at line 1597 of file scale_atmos_sub_boundary.F90.

References atmos_boundary_dens, atmos_boundary_pott, atmos_boundary_qtrc, atmos_boundary_velx, atmos_boundary_vely, atmos_boundary_velz, scale_atmos_hydrometeor::atmos_hydrometeor_diagnose_number_concentration(), scale_atmos_phy_mp::atmos_phy_mp_name, bnd_qa, scale_grid_nest::daughter_ia, scale_grid_nest::daughter_ja, scale_grid_nest::daughter_ka, dens, scale_fileio::fileio_flush(), scale_grid_index::ia, scale_grid_index::ie, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::is, scale_grid_index::ja, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ka, scale_grid_index::ke, scale_grid_index::ks, scale_grid_nest::nest_bnd_qa, scale_grid_nest::nest_comm_nestdown(), scale_grid_nest::nest_comm_recvwait_issue(), scale_grid_nest::nest_comm_test(), scale_grid_nest::online_boundary_diagqnum, scale_grid_nest::online_use_velz, scale_grid_nest::parent_ia, scale_grid_nest::parent_ja, scale_grid_nest::parent_ka, scale_rm_process::prc_has_e, scale_rm_process::prc_has_n, scale_rm_process::prc_has_s, scale_rm_process::prc_has_w, scale_process::prc_mpistop(), scale_tracer::qa, scale_atmos_phy_mp::qa_mp, scale_atmos_phy_mp::qs_mp, qtrc, scale_time::time_dtsec, and update_ref_index().

Referenced by mod_atmos_driver::atmos_driver().

     use scale_process, only: &
        prc_mpistop
     use scale_rm_process, only: &
        prc_has_w,   &
        prc_has_e,   &
        prc_has_s,   &
        prc_has_n
     use scale_atmos_phy_mp, only: &
        qs_mp
     use scale_grid_nest, only: &
        online_use_velz,       &
        nest_comm_test
     implicit none
 
     real(RP), intent(inout) :: DENS(KA,IA,JA)
     real(RP), intent(inout) :: MOMZ(KA,IA,JA)
     real(RP), intent(inout) :: MOMX(KA,IA,JA)
     real(RP), intent(inout) :: MOMY(KA,IA,JA)
     real(RP), intent(inout) :: RHOT(KA,IA,JA)
     real(RP), intent(inout) :: QTRC(KA,IA,JA,QA)
 
     real(RP) :: bnd_DENS(KA,IA,JA)        ! damping coefficient for DENS (0-1)
     real(RP) :: bnd_VELZ(KA,IA,JA)        ! damping coefficient for VELZ (0-1)
     real(RP) :: bnd_VELX(KA,IA,JA)        ! damping coefficient for VELX (0-1)
     real(RP) :: bnd_VELY(KA,IA,JA)        ! damping coefficient for VELY (0-1)
     real(RP) :: bnd_POTT(KA,IA,JA)        ! damping coefficient for POTT (0-1)
     real(RP) :: bnd_QTRC(KA,IA,JA,BND_QA) ! damping coefficient for QTRC (0-1)
 
     integer :: handle
     integer :: i, j, k, iq, iqa
     !---------------------------------------------------------------------------
 
     if ( do_parent_process ) then !online [parent]
        ! should be called every time step
        call atmos_boundary_update_online_parent( dens,momz,momx,momy,rhot,qtrc )
     endif
 
     if ( l_bnd ) then
        ! update referce vars
        if ( now_step >= update_nstep ) then
           now_step          = 0
           boundary_timestep = boundary_timestep + 1
 
           call update_ref_index
 
           if ( do_daughter_process ) then !online [daughter]
              call atmos_boundary_update_online_daughter( ref_new )
           else
              call atmos_boundary_update_file( ref_new )
           end if
        end if
 
        ! step boundary
        now_step = now_step + 1
 
        ! get boundaryal coefficients
        call get_boundary( bnd_dens(:,:,:),   & ! [OUT]
                           bnd_velz(:,:,:),   & ! [OUT]
                           bnd_velx(:,:,:),   & ! [OUT]
                           bnd_vely(:,:,:),   & ! [OUT]
                           bnd_pott(:,:,:),   & ! [OUT]
                           bnd_qtrc(:,:,:,:), & ! [OUT]
                           now_step,          & ! [IN]
                           update_nstep       ) ! [IN]
 
        ! update boundary vars
        do j  = 1, ja
        do i  = 1, ia
        do k  = 1, ka
           atmos_boundary_dens(k,i,j) = bnd_dens(k,i,j)
           atmos_boundary_velx(k,i,j) = bnd_velx(k,i,j)
           atmos_boundary_vely(k,i,j) = bnd_vely(k,i,j)
           atmos_boundary_pott(k,i,j) = bnd_pott(k,i,j)
           do iq = 1, bnd_qa
              atmos_boundary_qtrc(k,i,j,iq) = bnd_qtrc(k,i,j,iq)
           end do
        end do
        end do
        end do
        if ( online_use_velz ) then
           do j  = 1, ja
           do i  = 1, ia
           do k  = 1, ka
              atmos_boundary_velz(k,i,j) = bnd_velz(k,i,j)
           end do
           end do
           end do
        end if
 
        ! fill HALO in western region
        if ( .NOT. prc_has_w ) then
           !$omp parallel do default(none)                                               &
           !$omp shared(JS,IS,KA,DENS,ATMOS_BOUNDARY_DENS,MOMX,ATMOS_BOUNDARY_VELX,RHOT) &
           !$omp shared(ATMOS_BOUNDARY_POTT,ATMOS_BOUNDARY_QTRC,BND_QA,QS_MP,QTRC,QA,JA)    &
           !$omp private(i,j,k,iq,iqa) OMP_SCHEDULE_ collapse(2)
           do j = 1, ja
           do i = 1, is-1
           do k = 1, ka
              dens(k,i,j) = atmos_boundary_dens(k,i,j)
              momx(k,i,j) = atmos_boundary_velx(k,i,j) &
                   * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i+1,j) ) * 0.5_rp
              rhot(k,i,j) = atmos_boundary_pott(k,i,j) * atmos_boundary_dens(k,i,j)
              do iq = 1, bnd_qa
                 iqa = iq + qs_mp - 1
                 qtrc(k,i,j,iqa) = atmos_boundary_qtrc(k,i,j,iq)
              end do
              do iq = 1, qa
                 if ( iq < qs_mp .or. iq >= bnd_qa + qs_mp ) then
                    qtrc(k,i,j,iq) = qtrc(k,is,j,iq) &
                                * ( 0.5_rp - sign(0.5_rp, atmos_boundary_velx(k,is-1,j)) )
                 end if
              end do
           end do
           end do
           end do
           do j = 1, ja-1
           do i = 1, is-1
           do k = 1, ka
              momy(k,i,j) = atmos_boundary_vely(k,i,j) &
                   * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i,j+1) ) * 0.5_rp
           end do
           end do
           end do
           do i = 1, is-1
           do k = 1, ka
              momy(k,i,ja) = atmos_boundary_vely(k,i,ja) &
                   * atmos_boundary_dens(k,i,ja)
           end do
           end do
           if ( online_use_velz ) then
              do j = 1, ja
              do i = 1, is-1
              do k = ks, ke-1
                 momz(k,i,j) = atmos_boundary_velz(k,i,j) &
                      * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k+1,i,j) ) * 0.5_rp
              end do
              end do
              end do
           else
              do j = 1, ja
              do i = 1, is-1
              do k = ks, ke-1
                 momz(k,i,j) = momz(k,is,j)
              end do
              end do
              end do
           end if
        end if
 
        ! fill HALO in eastern region
        if ( .NOT. prc_has_e ) then
           !$omp parallel do default(none)                                             &
           !$omp shared(JA,IE,IA,KA,DENS,ATMOS_BOUNDARY_DENS,ATMOS_BOUNDARY_VELX,RHOT) &
           !$omp shared(ATMOS_BOUNDARY_POTT,ATMOS_BOUNDARY_QTRC,BND_QA,QS_MP,QTRC,QA)  &
           !$omp private(i,j,k,iq,iqa) OMP_SCHEDULE_ collapse(2)
           do j = 1, ja
           do i = ie+1, ia
           do k = 1, ka
              dens(k,i,j) = atmos_boundary_dens(k,i,j)
              rhot(k,i,j) = atmos_boundary_pott(k,i,j) * atmos_boundary_dens(k,i,j)
              do iq = 1, bnd_qa
                 iqa = iq + qs_mp - 1
                 qtrc(k,i,j,iqa) = atmos_boundary_qtrc(k,i,j,iq)
              end do
              do iq = 1, qa
                 if ( iq < qs_mp .or. iq >= bnd_qa + qs_mp ) then
                    qtrc(k,i,j,iq) = qtrc(k,ie,j,iq) &
                                * ( 0.5_rp + sign(0.5_rp, atmos_boundary_velx(k,ie,j)) )
                 end if
              end do
           end do
           end do
           end do
           do j = 1, ja
           do i = ie, ia-1
           do k = 1, ka
              momx(k,i,j) = atmos_boundary_velx(k,i,j) &
                   * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i+1,j) ) * 0.5_rp
           end do
           end do
           end do
           do j = 1, ja
           do k = 1, ka
              momx(k,ia,j) = atmos_boundary_velx(k,ia,j) * atmos_boundary_dens(k,ia,j)
           end do
           end do
           do j = 1, ja-1
           do i = ie+1, ia
           do k = 1, ka
              momy(k,i,j) = atmos_boundary_vely(k,i,j) &
                   * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i,j+1) ) * 0.5_rp
           end do
           end do
           end do
           do i = ie+1, ia
           do k = 1, ka
              momy(k,i,ja) = atmos_boundary_vely(k,i,ja) &
                   * atmos_boundary_dens(k,i,ja)
           end do
           end do
           if ( online_use_velz ) then
              do j = 1, ja
              do i = ie+1, ia
              do k = ks, ke-1
                 momz(k,i,j) = atmos_boundary_velz(k,i,j) &
                      * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k+1,i,j) ) * 0.5_rp
              end do
              end do
              end do
           else
              do j = 1, ja
              do i = ie+1, ia
              do k = ks, ke-1
                 momz(k,i,j) = momz(k,ie,j)
              end do
              end do
              end do
           end if
        end if
 
        ! fill HALO in southern region
        if ( .NOT. prc_has_s ) then
           !$omp parallel do default(none)                                               &
           !$omp shared(JS,IA,KA,DENS,ATMOS_BOUNDARY_DENS,MOMY,ATMOS_BOUNDARY_VELY,RHOT) &
           !$omp shared(ATMOS_BOUNDARY_POTT,ATMOS_BOUNDARY_QTRC,BND_QA,QS_MP,QTRC,QA)    &
           !$omp private(i,j,k,iq,iqa) OMP_SCHEDULE_ collapse(2)
           do j = 1, js-1
           do i = 1, ia
           do k = 1, ka
              dens(k,i,j) = atmos_boundary_dens(k,i,j)
              momy(k,i,j) = atmos_boundary_vely(k,i,j) &
                   * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i,j+1) ) * 0.5_rp
              rhot(k,i,j) = atmos_boundary_pott(k,i,j) * atmos_boundary_dens(k,i,j)
              do iq = 1, bnd_qa
                 iqa = iq + qs_mp - 1
                 qtrc(k,i,j,iqa) = atmos_boundary_qtrc(k,i,j,iq)
              end do
              do iq = 1, qa
                 if ( iq < qs_mp .or. iq >= bnd_qa + qs_mp ) then
                    qtrc(k,i,j,iq) = qtrc(k,i,js,iq) &
                                * ( 0.5_rp - sign(0.5_rp, atmos_boundary_vely(k,i,js-1)) )
                 end if
              end do
           end do
           end do
           end do
           do j = 1, js-1
           do i = 1, ia-1
           do k = 1, ka
              momx(k,i,j) = atmos_boundary_velx(k,i,j) &
                   * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i+1,j) ) * 0.5_rp
           end do
           end do
           end do
           do j = 1, js-1
           do k = 1, ka
              momx(k,ia,j) = atmos_boundary_velx(k,ia,j) &
                   * atmos_boundary_dens(k,ia,j)
           end do
           end do
           if ( online_use_velz ) then
              do j = 1, js-1
              do i = 1, ia
              do k = ks, ke-1
                 momz(k,i,j) = atmos_boundary_velz(k,i,j) &
                      * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k+1,i,j) ) * 0.5_rp
              end do
              end do
              end do
           else
              do j = 1, js-1
              do i = 1, ia
              do k = ks, ke-1
                 momz(k,i,j) = momz(k,i,js)
              end do
              end do
              end do
           end if
        end if
 
        ! fill HALO in northern region
        if ( .NOT. prc_has_n ) then
           !$omp parallel do default(none)                                             &
           !$omp shared(JE,JA,IA,KA,DENS,ATMOS_BOUNDARY_DENS,ATMOS_BOUNDARY_VELY,RHOT) &
           !$omp shared(ATMOS_BOUNDARY_POTT,ATMOS_BOUNDARY_QTRC,BND_QA,QS_MP,QTRC,QA)  &
           !$omp private(i,j,k,iq,iqa) OMP_SCHEDULE_ collapse(2)
           do j = je+1, ja
           do i = 1, ia
           do k = 1, ka
              dens(k,i,j) = atmos_boundary_dens(k,i,j)
              rhot(k,i,j) = atmos_boundary_pott(k,i,j) * atmos_boundary_dens(k,i,j)
              do iq = 1, bnd_qa
                 iqa = iq + qs_mp - 1
                 qtrc(k,i,j,iqa) = atmos_boundary_qtrc(k,i,j,iq)
              end do
              do iq = bnd_qa+1, qa
                 if ( iq < qs_mp .or. iq >= bnd_qa + qs_mp ) then
                    qtrc(k,i,j,iq) = qtrc(k,i,je,iq) &
                                * ( 0.5_rp + sign(0.5_rp, atmos_boundary_vely(k,i,je)) )
                 end if
              end do
           end do
           end do
           end do
           do j = je, ja-1
           do i = 1, ia
           do k = 1, ka
              momy(k,i,j) = atmos_boundary_vely(k,i,j) &
                   * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i,j+1) ) * 0.5_rp
           end do
           end do
           end do
           do i = 1, ia
           do k = 1, ka
              momy(k,i,ja) = atmos_boundary_vely(k,i,ja) * atmos_boundary_dens(k,i,ja)
           end do
           end do
           do j = je+1, ja
           do i = 1, ia-1
           do k = 1, ka
              momx(k,i,j) = atmos_boundary_velx(k,i,j) &
                   * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k,i+1,j) ) * 0.5_rp
           end do
           end do
           end do
           do j = je+1, ja
           do k = 1, ka
              momx(k,ia,j) = atmos_boundary_velx(k,ia,j) &
                   * atmos_boundary_dens(k,ia,j)
           end do
           end do
           if ( online_use_velz ) then
              do j = je+1, ja
              do i = 1, ia
              do k = ks, ke-1
                 momz(k,i,j) = atmos_boundary_velz(k,i,j) &
                      * ( atmos_boundary_dens(k,i,j) + atmos_boundary_dens(k+1,i,j) ) * 0.5_rp
              end do
              end do
              end do
           else
              do j = je+1, ja
              do i = 1, ia
              do k = ks, ke-1
                 momz(k,i,j) = momz(k,i,je)
              end do
              end do
              end do
           end if
        end if
 
     elseif ( do_parent_process ) then
        ! do nothing
     else
        write(*,*) 'xxx [BUG] invalid path'
        call prc_mpistop
     end if
 
     call history_bnd( atmos_boundary_dens, &
                       atmos_boundary_velz, &
                       atmos_boundary_velx, &
                       atmos_boundary_vely, &
                       atmos_boundary_pott, &
                       atmos_boundary_qtrc )
 
     ! To be enable to do asynchronous communicaton
     if ( do_parent_process ) then !online [parent]
        handle = 1
        call nest_comm_test( handle )
     endif
     if ( do_daughter_process ) then !online [daughter]
        handle = 2
        call nest_comm_test( handle )
     endif
 
     return

Here is the call graph for this function:

Here is the caller graph for this function:

◆ update_ref_index()

subroutine scale_atmos_boundary::update_ref_index ( )

Update indices of array of boundary references.

Definition at line 2489 of file scale_atmos_sub_boundary.F90.

References scale_atmos_phy_mp::atmos_phy_mp_name.

Referenced by atmos_boundary_update().

     implicit none
 
     ! works
     integer :: ref_tmp
     !---------------------------------------------------------------------------
 
     ref_tmp = ref_old
     ref_old = ref_now
     ref_now = ref_new
     ref_new = ref_tmp
 
     return