SCALE-RM
Functions/Subroutines | Variables
mod_atmos_phy_cp_vars Module Reference

module Atmosphere / Physics Cumulus More...

Functions/Subroutines

subroutine, public atmos_phy_cp_vars_setup
 Setup. More...
 
subroutine, public atmos_phy_cp_vars_fillhalo
 HALO Communication. More...
 
subroutine, public atmos_phy_cp_vars_restart_open
 Open restart file for read. More...
 
subroutine, public atmos_phy_cp_vars_restart_read
 Read restart. More...
 
subroutine, public atmos_phy_cp_vars_restart_create
 Create restart file. More...
 
subroutine, public atmos_phy_cp_vars_restart_enddef
 Exit netCDF define mode. More...
 
subroutine, public atmos_phy_cp_vars_restart_close
 Close restart file. More...
 
subroutine, public atmos_phy_cp_vars_restart_def_var
 Write restart. More...
 
subroutine, public atmos_phy_cp_vars_restart_write
 Write restart. More...
 

Variables

logical, public atmos_phy_cp_restart_output = .false.
 output restart file? More...
 
character(len=h_long), public atmos_phy_cp_restart_in_basename = ''
 Basename of the input file. More...
 
logical, public atmos_phy_cp_restart_in_postfix_timelabel = .false.
 Add timelabel to the basename of input file? More...
 
character(len=h_long), public atmos_phy_cp_restart_out_basename = ''
 Basename of the output file. More...
 
logical, public atmos_phy_cp_restart_out_postfix_timelabel = .true.
 Add timelabel to the basename of output file? More...
 
character(len=h_mid), public atmos_phy_cp_restart_out_title = 'ATMOS_PHY_CP restart'
 title of the output file More...
 
character(len=h_short), public atmos_phy_cp_restart_out_dtype = 'DEFAULT'
 REAL4 or REAL8. More...
 
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_dens_t
 
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_momz_t
 
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_momx_t
 
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_momy_t
 
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_rhot_t
 
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_cp_rhoq_t
 
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_mflx_cloudbase
 
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_sflx_rain
 
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_cloudtop
 
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_cloudbase
 
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_cldfrac_dp
 
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_cldfrac_sh
 
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_kf_nca
 
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_kf_w0avg
 

Detailed Description

module Atmosphere / Physics Cumulus

Description
Container for mod_atmos_phy_cp
Author
Team SCALE
History
  • 2014-05-04 (H.Yashiro) [new]
NAMELIST
  • PARAM_ATMOS_PHY_CP_VARS
    nametypedefault valuecomment
    ATMOS_PHY_CP_RESTART_IN_BASENAME character(len=H_LONG) '' Basename of the input file
    ATMOS_PHY_CP_RESTART_IN_POSTFIX_TIMELABEL logical .false. Add timelabel to the basename of input file?
    ATMOS_PHY_CP_RESTART_OUTPUT logical .false. output restart file?
    ATMOS_PHY_CP_RESTART_OUT_BASENAME character(len=H_LONG) '' Basename of the output file
    ATMOS_PHY_CP_RESTART_OUT_POSTFIX_TIMELABEL logical .true. Add timelabel to the basename of output file?
    ATMOS_PHY_CP_RESTART_OUT_TITLE character(len=H_MID) 'ATMOS_PHY_CP restart' title of the output file
    ATMOS_PHY_CP_RESTART_OUT_DTYPE character(len=H_SHORT) 'DEFAULT' REAL4 or REAL8

History Output
No history output

Function/Subroutine Documentation

◆ atmos_phy_cp_vars_setup()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_setup ( )

Setup.

Definition at line 136 of file mod_atmos_phy_cp_vars.f90.

References atmos_phy_cp_cldfrac_dp, atmos_phy_cp_cldfrac_sh, atmos_phy_cp_cloudbase, atmos_phy_cp_cloudtop, atmos_phy_cp_dens_t, atmos_phy_cp_kf_nca, atmos_phy_cp_kf_w0avg, atmos_phy_cp_mflx_cloudbase, atmos_phy_cp_momx_t, atmos_phy_cp_momy_t, atmos_phy_cp_momz_t, atmos_phy_cp_restart_in_basename, atmos_phy_cp_restart_in_postfix_timelabel, atmos_phy_cp_restart_out_basename, atmos_phy_cp_restart_out_dtype, atmos_phy_cp_restart_out_postfix_timelabel, atmos_phy_cp_restart_out_title, atmos_phy_cp_restart_output, atmos_phy_cp_rhoq_t, atmos_phy_cp_rhot_t, atmos_phy_cp_sflx_rain, scale_atmos_phy_mp::atmos_phy_mp_name, 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_process::prc_mpistop(), scale_atmos_phy_mp::qa_mp, scale_atmos_phy_mp::qe_mp, and scale_atmos_phy_mp::qs_mp.

Referenced by mod_atmos_vars::atmos_vars_setup().

136  use scale_process, only: &
138  use scale_const, only: &
139  undef => const_undef
140  use scale_atmos_phy_mp, only: &
141  aq_name => atmos_phy_mp_name, &
142  qs_mp, &
143  qe_mp, &
144  qa_mp
145  implicit none
146 
147  namelist / param_atmos_phy_cp_vars / &
148  atmos_phy_cp_restart_in_basename, &
149  atmos_phy_cp_restart_in_postfix_timelabel, &
150  atmos_phy_cp_restart_output, &
151  atmos_phy_cp_restart_out_basename, &
152  atmos_phy_cp_restart_out_postfix_timelabel, &
153  atmos_phy_cp_restart_out_title, &
154  atmos_phy_cp_restart_out_dtype
155 
156  integer :: ierr
157  integer :: iv
158  integer :: iq
159  !---------------------------------------------------------------------------
160 
161  if( io_l ) write(io_fid_log,*)
162  if( io_l ) write(io_fid_log,*) '++++++ Module[VARS] / Categ[ATMOS PHY_CP] / Origin[SCALE-RM]'
163 
164  allocate( atmos_phy_cp_dens_t(ka,ia,ja) )
165  allocate( atmos_phy_cp_momz_t(ka,ia,ja) )
166  allocate( atmos_phy_cp_momx_t(ka,ia,ja) )
167  allocate( atmos_phy_cp_momy_t(ka,ia,ja) )
168  allocate( atmos_phy_cp_rhot_t(ka,ia,ja) )
169  allocate( atmos_phy_cp_rhoq_t(ka,ia,ja,qs_mp:qe_mp) )
170  atmos_phy_cp_dens_t(:,:,:) = 0.0_rp
171  atmos_phy_cp_momz_t(:,:,:) = undef
172  atmos_phy_cp_momx_t(:,:,:) = undef
173  atmos_phy_cp_momy_t(:,:,:) = undef
174  atmos_phy_cp_rhot_t(:,:,:) = 0.0_rp
175  atmos_phy_cp_rhoq_t(:,:,:,:) = 0.0_rp
176 
177  allocate( atmos_phy_cp_mflx_cloudbase(ia,ja) )
178  allocate( atmos_phy_cp_sflx_rain(ia,ja) )
179  allocate( atmos_phy_cp_cloudtop(ia,ja) )
180  allocate( atmos_phy_cp_cloudbase(ia,ja) )
181  allocate( atmos_phy_cp_cldfrac_dp(ka,ia,ja) )
182  allocate( atmos_phy_cp_cldfrac_sh(ka,ia,ja) )
183  allocate( atmos_phy_cp_kf_nca(ia,ja) )
184  allocate( atmos_phy_cp_kf_w0avg(ka,ia,ja) )
185  atmos_phy_cp_mflx_cloudbase(:,:) = 0.0_rp
186  atmos_phy_cp_sflx_rain(:,:) = 0.0_rp
187  atmos_phy_cp_cloudtop(:,:) = 0.0_rp
188  atmos_phy_cp_cloudbase(:,:) = 0.0_rp
189  atmos_phy_cp_cldfrac_dp(:,:,:) = 0.0_rp
190  atmos_phy_cp_cldfrac_sh(:,:,:) = 0.0_rp
191  atmos_phy_cp_kf_nca(:,:) = -100.0_rp
192  atmos_phy_cp_kf_w0avg(:,:,:) = 0.0_rp
193 
194  ! for tendency restart
195  vmax_t = 2 + qa_mp
196  allocate( var_t_name(vmax_t) )
197  allocate( var_t_desc(vmax_t) )
198  allocate( var_t_unit(vmax_t) )
199  allocate( var_t_id(vmax_t) )
200 
201  var_t_name(i_cp_dens_t) = 'DENS_t_CP'
202  var_t_desc(i_cp_dens_t) = 'tendency DENS in CP'
203  var_t_unit(i_cp_dens_t) = 'kg/m3/s'
204  var_t_name(i_cp_rhot_t) = 'RHOT_t_CP'
205  var_t_desc(i_cp_rhot_t) = 'tendency RHOT in CP'
206  var_t_unit(i_cp_rhot_t) = 'K*kg/m3/s'
207 
208  do iq = 1, qa_mp
209  var_t_name(2+iq) = trim(aq_name(iq))//'_t_CP'
210  var_t_desc(2+iq) = 'tendency rho*'//trim(aq_name(iq))//' in CP'
211  var_t_unit(2+iq) = 'kg/m3/s'
212  enddo
213 
214  !--- read namelist
215  rewind(io_fid_conf)
216  read(io_fid_conf,nml=param_atmos_phy_cp_vars,iostat=ierr)
217  if( ierr < 0 ) then !--- missing
218  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
219  elseif( ierr > 0 ) then !--- fatal error
220  write(*,*) 'xxx Not appropriate names in namelist PARAM_ATMOS_PHY_CP_VARS. Check!'
221  call prc_mpistop
222  endif
223  if( io_nml ) write(io_fid_nml,nml=param_atmos_phy_cp_vars)
224 
225  if( io_l ) write(io_fid_log,*)
226  if( io_l ) write(io_fid_log,*) '*** [ATMOS_PHY_CP] prognostic/diagnostic variables'
227  if( io_l ) write(io_fid_log,'(1x,A,A24,A,A48,A,A12,A)') &
228  '*** |', 'VARNAME ','|', &
229  'DESCRIPTION ', '[', 'UNIT ', ']'
230  do iv = 1, vmax
231  if( io_l ) write(io_fid_log,'(1x,A,I3,A,A24,A,A48,A,A12,A)') &
232  '*** NO.',iv,'|',var_name(iv),'|',var_desc(iv),'[',var_unit(iv),']'
233  enddo
234 
235  ! tendency
236  do iv = 1, vmax_t
237  if( io_l ) write(io_fid_log,'(1x,A,I3,A,A24,A,A48,A,A12,A)') &
238  '*** NO.',iv+vmax,'|',var_t_name(iv),'|',var_t_desc(iv),'[',var_t_unit(iv),']'
239  enddo
240 
241  if( io_l ) write(io_fid_log,*)
242  if ( atmos_phy_cp_restart_in_basename /= '' ) then
243  if( io_l ) write(io_fid_log,*) '*** Restart input? : YES, file = ', trim(atmos_phy_cp_restart_in_basename)
244  if( io_l ) write(io_fid_log,*) '*** Add timelabel? : ', atmos_phy_cp_restart_in_postfix_timelabel
245  else
246  if( io_l ) write(io_fid_log,*) '*** Restart input? : NO'
247  endif
248  if ( atmos_phy_cp_restart_output &
249  .AND. atmos_phy_cp_restart_out_basename /= '' ) then
250  if( io_l ) write(io_fid_log,*) '*** Restart output? : YES, file = ', trim(atmos_phy_cp_restart_out_basename)
251  if( io_l ) write(io_fid_log,*) '*** Add timelabel? : ', atmos_phy_cp_restart_out_postfix_timelabel
252  else
253  if( io_l ) write(io_fid_log,*) '*** Restart output? : NO'
254  atmos_phy_cp_restart_output = .false.
255  endif
256 
257  return
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_momy_t
subroutine, public prc_mpistop
Abort MPI.
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_momx_t
module ATMOSPHERE / Physics Cloud Microphysics
character(len=h_short), dimension(:), pointer, public atmos_phy_mp_name
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_dens_t
real(rp), public const_undef
Definition: scale_const.F90:43
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_cp_rhoq_t
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_momz_t
module PROCESS
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_rhot_t
module CONSTANT
Definition: scale_const.F90:14
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_mflx_cloudbase
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_sflx_rain
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_cp_vars_fillhalo()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_fillhalo ( )

HALO Communication.

Definition at line 263 of file mod_atmos_phy_cp_vars.f90.

References atmos_phy_cp_cldfrac_dp, atmos_phy_cp_cldfrac_sh, atmos_phy_cp_cloudbase, atmos_phy_cp_cloudtop, atmos_phy_cp_dens_t, atmos_phy_cp_kf_nca, atmos_phy_cp_kf_w0avg, atmos_phy_cp_mflx_cloudbase, atmos_phy_cp_rhoq_t, atmos_phy_cp_rhot_t, atmos_phy_cp_sflx_rain, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ka, scale_grid_index::ke, scale_grid_index::ks, and scale_atmos_phy_mp::qa_mp.

Referenced by atmos_phy_cp_vars_restart_read(), and atmos_phy_cp_vars_restart_write().

263  use scale_comm, only: &
264  comm_vars8, &
265  comm_wait
266  use scale_atmos_phy_mp, only: &
267  qa_mp
268  implicit none
269 
270  integer :: i, j
271  integer :: iq
272  !---------------------------------------------------------------------------
273 
274  do j = js, je
275  do i = is, ie
276  atmos_phy_cp_cldfrac_dp( 1:ks-1,i,j) = atmos_phy_cp_cldfrac_dp(ks,i,j)
277  atmos_phy_cp_cldfrac_dp(ke+1:ka, i,j) = atmos_phy_cp_cldfrac_dp(ke,i,j)
278  atmos_phy_cp_cldfrac_sh( 1:ks-1,i,j) = atmos_phy_cp_cldfrac_sh(ks,i,j)
279  atmos_phy_cp_cldfrac_sh(ke+1:ka, i,j) = atmos_phy_cp_cldfrac_sh(ke,i,j)
280  atmos_phy_cp_kf_w0avg( 1:ks-1,i,j) = atmos_phy_cp_kf_w0avg(ks,i,j)
281  atmos_phy_cp_kf_w0avg(ke+1:ka, i,j) = atmos_phy_cp_kf_w0avg(ke,i,j)
282  atmos_phy_cp_dens_t( 1:ks-1,i,j) = atmos_phy_cp_dens_t(ks,i,j)
283  atmos_phy_cp_dens_t(ke+1:ka ,i,j) = atmos_phy_cp_dens_t(ke,i,j)
284  atmos_phy_cp_rhot_t( 1:ks-1,i,j) = atmos_phy_cp_rhot_t(ks,i,j)
285  atmos_phy_cp_rhot_t(ke+1:ka ,i,j) = atmos_phy_cp_rhot_t(ke,i,j)
286  enddo
287  enddo
288 
289  do iq = 1, qa_mp
290  do j = js, je
291  do i = is, ie
292  atmos_phy_cp_rhoq_t( 1:ks-1,i,j,iq) = atmos_phy_cp_rhoq_t(ks,i,j,iq)
293  atmos_phy_cp_rhoq_t(ke+1:ka ,i,j,iq) = atmos_phy_cp_rhoq_t(ke,i,j,iq)
294  enddo
295  enddo
296  end do
297 
298  call comm_vars8( atmos_phy_cp_mflx_cloudbase(:,:) , 1 )
299  call comm_vars8( atmos_phy_cp_sflx_rain(:,:) , 2 )
300  call comm_vars8( atmos_phy_cp_cloudtop(:,:) , 3 )
301  call comm_vars8( atmos_phy_cp_cloudbase(:,:) , 4 )
302  call comm_vars8( atmos_phy_cp_cldfrac_dp(:,:,:), 5 )
303  call comm_vars8( atmos_phy_cp_cldfrac_sh(:,:,:), 6 )
304  call comm_vars8( atmos_phy_cp_kf_nca(:,:) , 7 )
305  call comm_vars8( atmos_phy_cp_kf_w0avg(:,:,:), 8 )
306 
307  ! tendency
308  call comm_vars8( atmos_phy_cp_dens_t(:,:,:), vmax+1 )
309  call comm_vars8( atmos_phy_cp_rhot_t(:,:,:), vmax+2 )
310 
311  do iq = 1, qa_mp
312  call comm_vars8( atmos_phy_cp_rhoq_t(:,:,:,iq), vmax+2+iq )
313  enddo
314 
315  call comm_wait ( atmos_phy_cp_mflx_cloudbase(:,:) , 1 )
316  call comm_wait ( atmos_phy_cp_sflx_rain(:,:) , 2 )
317  call comm_wait ( atmos_phy_cp_cloudtop(:,:) , 3 )
318  call comm_wait ( atmos_phy_cp_cloudbase(:,:) , 4 )
319  call comm_wait ( atmos_phy_cp_cldfrac_dp(:,:,:), 5 )
320  call comm_wait ( atmos_phy_cp_cldfrac_sh(:,:,:), 6 )
321  call comm_wait ( atmos_phy_cp_kf_nca(:,:) , 7 )
322  call comm_wait ( atmos_phy_cp_kf_w0avg(:,:,:), 8 )
323 
324  call comm_wait ( atmos_phy_cp_dens_t(:,:,:), vmax+1 )
325  call comm_wait ( atmos_phy_cp_rhot_t(:,:,:), vmax+2 )
326 
327  do iq = 1, qa_mp
328  call comm_wait ( atmos_phy_cp_rhoq_t(:,:,:,iq), vmax+2+iq )
329  enddo
330 
331  return
module ATMOSPHERE / Physics Cloud Microphysics
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_dens_t
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_cp_rhoq_t
module COMMUNICATION
Definition: scale_comm.F90:23
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_rhot_t
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_mflx_cloudbase
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_sflx_rain
Here is the caller graph for this function:

◆ atmos_phy_cp_vars_restart_open()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_restart_open ( )

Open restart file for read.

Definition at line 337 of file mod_atmos_phy_cp_vars.f90.

References atmos_phy_cp_restart_in_basename, atmos_phy_cp_restart_in_postfix_timelabel, scale_fileio::fileio_open(), scale_stdio::io_fid_log, scale_stdio::io_l, and scale_time::time_gettimelabel().

Referenced by mod_atmos_vars::atmos_vars_restart_open().

337  use scale_time, only: &
339  use scale_fileio, only: &
341  implicit none
342 
343  character(len=19) :: timelabel
344  character(len=H_LONG) :: basename
345  !---------------------------------------------------------------------------
346 
347  if( io_l ) write(io_fid_log,*)
348  if( io_l ) write(io_fid_log,*) '*** Open restart file (ATMOS_PHY_CP) ***'
349 
350  if ( atmos_phy_cp_restart_in_basename /= '' ) then
351 
352  if ( atmos_phy_cp_restart_in_postfix_timelabel ) then
353  call time_gettimelabel( timelabel )
354  basename = trim(atmos_phy_cp_restart_in_basename)//'_'//trim(timelabel)
355  else
356  basename = trim(atmos_phy_cp_restart_in_basename)
357  endif
358 
359  if( io_l ) write(io_fid_log,*) '*** basename: ', trim(basename)
360 
361  call fileio_open( restart_fid, basename )
362  else
363  if( io_l ) write(io_fid_log,*) '*** restart file for ATMOS_PHY_CP is not specified.'
364  endif
365 
366  return
module FILE I/O (netcdf)
subroutine, public time_gettimelabel(timelabel)
generate time label
Definition: scale_time.F90:90
module TIME
Definition: scale_time.F90:15
subroutine, public fileio_open(fid, basename)
open a netCDF file for read
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_cp_vars_restart_read()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_restart_read ( )

Read restart.

Definition at line 372 of file mod_atmos_phy_cp_vars.f90.

References atmos_phy_cp_cldfrac_dp, atmos_phy_cp_cldfrac_sh, atmos_phy_cp_cloudbase, atmos_phy_cp_cloudtop, atmos_phy_cp_dens_t, atmos_phy_cp_kf_nca, atmos_phy_cp_kf_w0avg, atmos_phy_cp_mflx_cloudbase, atmos_phy_cp_rhoq_t, atmos_phy_cp_rhot_t, atmos_phy_cp_sflx_rain, atmos_phy_cp_vars_fillhalo(), scale_fileio::fileio_flush(), scale_grid_index::ia, scale_stdio::io_aggregate, 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_atmos_phy_mp::qa_mp, and scale_rm_statistics::statistics_checktotal.

Referenced by mod_atmos_vars::atmos_vars_restart_read().

372  use scale_rm_statistics, only: &
374  stat_total
375  use scale_fileio, only: &
376  fileio_read, &
378  use scale_atmos_phy_mp, only: &
379  qa_mp
380  implicit none
381 
382  real(RP) :: total
383  integer :: i, j, iq
384  !---------------------------------------------------------------------------
385 
386  if ( restart_fid /= -1 ) then
387  if( io_l ) write(io_fid_log,*)
388  if( io_l ) write(io_fid_log,*) '*** Read from restart file (ATMOS_PHY_CP) ***'
389 
390  call fileio_read( atmos_phy_cp_mflx_cloudbase(:,:), & ! [OUT]
391  restart_fid, var_name(1), 'XY', step=1 ) ! [IN]
392  call fileio_read( atmos_phy_cp_sflx_rain(:,:), & ! [OUT]
393  restart_fid, var_name(2), 'XY', step=1 ) ! [IN]
394  call fileio_read( atmos_phy_cp_cloudtop(:,:), & ! [OUT]
395  restart_fid, var_name(3), 'XY', step=1 ) ! [IN]
396  call fileio_read( atmos_phy_cp_cloudbase(:,:), & ! [OUT]
397  restart_fid, var_name(4), 'XY', step=1 ) ! [IN]
398  call fileio_read( atmos_phy_cp_cldfrac_dp(:,:,:), & ! [OUT]
399  restart_fid, var_name(5), 'ZXY', step=1 ) ! [IN]
400  call fileio_read( atmos_phy_cp_cldfrac_sh(:,:,:), & ! [OUT]
401  restart_fid, var_name(6), 'ZXY', step=1 ) ! [IN]
402  call fileio_read( atmos_phy_cp_kf_nca(:,:), & ! [OUT]
403  restart_fid, var_name(7), 'XY', step=1 ) ! [IN]
404  call fileio_read( atmos_phy_cp_kf_w0avg(:,:,:), & ! [OUT]
405  restart_fid, var_name(8), 'ZXY', step=1 ) ! [IN]
406  ! tendency
407  call fileio_read( atmos_phy_cp_dens_t(:,:,:), & ! [OUT]
408  restart_fid, var_t_name(1), 'ZXY', step=1 ) ! [IN]
409  call fileio_read( atmos_phy_cp_rhot_t(:,:,:), & ! [OUT]
410  restart_fid, var_t_name(2), 'ZXY', step=1 ) ! [IN]
411  do iq = 1, qa_mp
412  call fileio_read( atmos_phy_cp_rhoq_t(:,:,:,iq), & ! [OUT]
413  restart_fid, var_t_name(2+iq), 'ZXY', step=1 ) ! [IN]
414  enddo
415 
416  if ( io_aggregate ) then
417  call fileio_flush( restart_fid ) ! X/Y halos have been read from file
418 
419  ! fill K halos
420  do j = 1, ja
421  do i = 1, ia
422  atmos_phy_cp_cldfrac_dp( 1:ks-1,i,j) = atmos_phy_cp_cldfrac_dp(ks,i,j)
423  atmos_phy_cp_cldfrac_sh( 1:ks-1,i,j) = atmos_phy_cp_cldfrac_sh(ks,i,j)
424  atmos_phy_cp_kf_w0avg( 1:ks-1,i,j) = atmos_phy_cp_kf_w0avg(ks,i,j)
425  atmos_phy_cp_dens_t( 1:ks-1,i,j) = atmos_phy_cp_dens_t(ks,i,j)
426  atmos_phy_cp_rhot_t( 1:ks-1,i,j) = atmos_phy_cp_rhot_t(ks,i,j)
427  atmos_phy_cp_cldfrac_dp(ke+1:ka, i,j) = atmos_phy_cp_cldfrac_dp(ke,i,j)
428  atmos_phy_cp_cldfrac_sh(ke+1:ka, i,j) = atmos_phy_cp_cldfrac_sh(ke,i,j)
429  atmos_phy_cp_kf_w0avg(ke+1:ka, i,j) = atmos_phy_cp_kf_w0avg(ke,i,j)
430  atmos_phy_cp_dens_t(ke+1:ka, i,j) = atmos_phy_cp_dens_t(ke,i,j)
431  atmos_phy_cp_rhot_t(ke+1:ka, i,j) = atmos_phy_cp_rhot_t(ke,i,j)
432  enddo
433  enddo
434 
435  do iq = 1, qa_mp
436  do j = 1, ja
437  do i = 1, ia
438  atmos_phy_cp_rhoq_t( 1:ks-1,i,j,iq) = atmos_phy_cp_rhoq_t(ks,i,j,iq)
439  atmos_phy_cp_rhoq_t(ke+1:ka, i,j,iq) = atmos_phy_cp_rhoq_t(ke,i,j,iq)
440  enddo
441  enddo
442  enddo
443  else
444  call atmos_phy_cp_vars_fillhalo
445  end if
446 
447  if ( statistics_checktotal ) then
448  call stat_total( total, atmos_phy_cp_mflx_cloudbase(:,:) , var_name(1) )
449  call stat_total( total, atmos_phy_cp_sflx_rain(:,:) , var_name(2) )
450  call stat_total( total, atmos_phy_cp_cloudtop(:,:) , var_name(3) )
451  call stat_total( total, atmos_phy_cp_cloudbase(:,:) , var_name(4) )
452  call stat_total( total, atmos_phy_cp_cldfrac_dp(:,:,:), var_name(5) )
453  call stat_total( total, atmos_phy_cp_cldfrac_sh(:,:,:), var_name(6) )
454  call stat_total( total, atmos_phy_cp_kf_nca(:,:) , var_name(7) )
455  call stat_total( total, atmos_phy_cp_kf_w0avg(:,:,:), var_name(8) )
456  ! tendency
457  call stat_total( total, atmos_phy_cp_dens_t(:,:,:), var_t_name(1) )
458  call stat_total( total, atmos_phy_cp_rhot_t(:,:,:), var_t_name(2) )
459  do iq = 1, qa_mp
460  call stat_total( total, atmos_phy_cp_rhoq_t(:,:,:,iq), var_t_name(2+iq) )
461  enddo
462  endif
463  else
464  if( io_l ) write(io_fid_log,*) '*** invalid restart file ID for ATMOS_PHY_CP.'
465  endif
466 
467  return
logical, public statistics_checktotal
calc&report variable totals to logfile?
subroutine, public fileio_flush(fid)
Flush all pending requests to a netCDF file (PnetCDF only)
module ATMOSPHERE / Physics Cloud Microphysics
module FILE I/O (netcdf)
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_dens_t
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_cp_rhoq_t
module Statistics
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_rhot_t
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_mflx_cloudbase
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_sflx_rain
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_cp_vars_restart_create()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_restart_create ( )

Create restart file.

Definition at line 473 of file mod_atmos_phy_cp_vars.f90.

References atmos_phy_cp_restart_out_basename, atmos_phy_cp_restart_out_dtype, atmos_phy_cp_restart_out_postfix_timelabel, atmos_phy_cp_restart_out_title, scale_fileio::fileio_create(), scale_stdio::io_fid_log, scale_stdio::io_l, and scale_time::time_gettimelabel().

Referenced by mod_atmos_vars::atmos_vars_restart_create().

473  use scale_time, only: &
475  use scale_fileio, only: &
477  implicit none
478 
479  character(len=19) :: timelabel
480  character(len=H_LONG) :: basename
481  !---------------------------------------------------------------------------
482 
483  if ( atmos_phy_cp_restart_out_basename /= '' ) then
484 
485  if( io_l ) write(io_fid_log,*)
486  if( io_l ) write(io_fid_log,*) '*** Create restart file (ATMOS_PHY_AE) ***'
487 
488  if ( atmos_phy_cp_restart_out_postfix_timelabel ) then
489  call time_gettimelabel( timelabel )
490  basename = trim(atmos_phy_cp_restart_out_basename)//'_'//trim(timelabel)
491  else
492  basename = trim(atmos_phy_cp_restart_out_basename)
493  endif
494 
495  if( io_l ) write(io_fid_log,*) '*** basename: ', trim(basename)
496 
497  call fileio_create( restart_fid, & ! [OUT]
498  basename, atmos_phy_cp_restart_out_title, atmos_phy_cp_restart_out_dtype ) ! [IN]
499 
500  endif
501 
502  return
module FILE I/O (netcdf)
subroutine, public time_gettimelabel(timelabel)
generate time label
Definition: scale_time.F90:90
subroutine, public fileio_create(fid, basename, title, datatype, date, subsec, append, nozcoord)
Create/open a netCDF file.
module TIME
Definition: scale_time.F90:15
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_cp_vars_restart_enddef()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_restart_enddef ( )

Exit netCDF define mode.

Definition at line 508 of file mod_atmos_phy_cp_vars.f90.

References scale_fileio::fileio_enddef().

Referenced by mod_atmos_vars::atmos_vars_restart_enddef().

508  use scale_fileio, only: &
510  implicit none
511 
512  if ( restart_fid /= -1 ) then
513  call fileio_enddef( restart_fid ) ! [IN]
514  endif
515 
516  return
module FILE I/O (netcdf)
subroutine, public fileio_enddef(fid)
Exit netCDF file define mode.
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_cp_vars_restart_close()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_restart_close ( )

Close restart file.

Definition at line 522 of file mod_atmos_phy_cp_vars.f90.

References scale_fileio::fileio_close(), scale_stdio::io_fid_log, and scale_stdio::io_l.

Referenced by mod_atmos_vars::atmos_vars_restart_close().

522  use scale_fileio, only: &
524  implicit none
525  !---------------------------------------------------------------------------
526 
527  if ( restart_fid /= -1 ) then
528  if( io_l ) write(io_fid_log,*)
529  if( io_l ) write(io_fid_log,*) '*** Close restart file (ATMOS_PHY_CP) ***'
530 
531  call fileio_close( restart_fid ) ! [IN]
532 
533  restart_fid = -1
534  endif
535 
536  return
module FILE I/O (netcdf)
subroutine, public fileio_close(fid)
Close a netCDF file.
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_cp_vars_restart_def_var()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_restart_def_var ( )

Write restart.

Definition at line 542 of file mod_atmos_phy_cp_vars.f90.

References atmos_phy_cp_restart_out_dtype, scale_fileio::fileio_def_var(), and scale_atmos_phy_mp::qa_mp.

Referenced by mod_atmos_vars::atmos_vars_restart_def_var().

542  use scale_fileio, only: &
544  use scale_atmos_phy_mp, only: &
545  qa_mp
546  implicit none
547 
548  integer :: iq
549  !---------------------------------------------------------------------------
550 
551  if ( restart_fid /= -1 ) then
552 
553  call fileio_def_var( restart_fid, var_id(1), var_name(1), var_desc(1), &
554  var_unit(1), 'XY', atmos_phy_cp_restart_out_dtype ) ! [IN]
555  call fileio_def_var( restart_fid, var_id(2), var_name(2), var_desc(2), &
556  var_unit(2), 'XY', atmos_phy_cp_restart_out_dtype ) ! [IN]
557  call fileio_def_var( restart_fid, var_id(3), var_name(3), var_desc(3), &
558  var_unit(3), 'XY', atmos_phy_cp_restart_out_dtype ) ! [IN]
559  call fileio_def_var( restart_fid, var_id(4), var_name(4), var_desc(4), &
560  var_unit(4), 'XY', atmos_phy_cp_restart_out_dtype ) ! [IN]
561  call fileio_def_var( restart_fid, var_id(5), var_name(5), var_desc(5), &
562  var_unit(5), 'ZXY', atmos_phy_cp_restart_out_dtype ) ! [IN]
563  call fileio_def_var( restart_fid, var_id(6), var_name(6), var_desc(6), &
564  var_unit(6), 'ZXY', atmos_phy_cp_restart_out_dtype ) ! [IN]
565  call fileio_def_var( restart_fid, var_id(7), var_name(7), var_desc(7), &
566  var_unit(7), 'XY', atmos_phy_cp_restart_out_dtype ) ! [IN]
567  call fileio_def_var( restart_fid, var_id(8), var_name(8), var_desc(8), &
568  var_unit(8), 'ZXY', atmos_phy_cp_restart_out_dtype ) ! [IN]
569 
570  call fileio_def_var( restart_fid, var_t_id(1), var_t_name(1), var_t_desc(1), &
571  var_t_unit(1), 'ZXY', atmos_phy_cp_restart_out_dtype ) ! [IN]
572  call fileio_def_var( restart_fid, var_t_id(2), var_t_name(2), var_t_desc(2), &
573  var_t_unit(2), 'ZXY', atmos_phy_cp_restart_out_dtype ) ! [IN]
574 
575  do iq = 1, qa_mp
576  call fileio_def_var( restart_fid, var_t_id(2+iq), var_t_name(2+iq), var_t_desc(2+iq), &
577  var_t_unit(2+iq), 'ZXY', atmos_phy_cp_restart_out_dtype ) ! [IN]
578  enddo
579 
580  endif
581 
582  return
module ATMOSPHERE / Physics Cloud Microphysics
module FILE I/O (netcdf)
subroutine, public fileio_def_var(fid, vid, varname, desc, unit, axistype, datatype, timeintv, nsteps)
Define a variable to file.
Here is the call graph for this function:
Here is the caller graph for this function:

◆ atmos_phy_cp_vars_restart_write()

subroutine, public mod_atmos_phy_cp_vars::atmos_phy_cp_vars_restart_write ( )

Write restart.

Definition at line 588 of file mod_atmos_phy_cp_vars.f90.

References atmos_phy_cp_cldfrac_dp, atmos_phy_cp_cldfrac_sh, atmos_phy_cp_cloudbase, atmos_phy_cp_cloudtop, atmos_phy_cp_dens_t, atmos_phy_cp_kf_nca, atmos_phy_cp_kf_w0avg, atmos_phy_cp_mflx_cloudbase, atmos_phy_cp_rhoq_t, atmos_phy_cp_rhot_t, atmos_phy_cp_sflx_rain, atmos_phy_cp_vars_fillhalo(), scale_atmos_phy_mp::qa_mp, and scale_rm_statistics::statistics_checktotal.

Referenced by mod_atmos_vars::atmos_vars_restart_write().

588  use scale_rm_statistics, only: &
590  stat_total
591  use scale_fileio, only: &
592  fileio_write => fileio_write_var
593  use scale_atmos_phy_mp, only: &
594  qa_mp
595  implicit none
596 
597  real(RP) :: total
598  integer :: iq
599  !---------------------------------------------------------------------------
600 
601  if ( restart_fid /= -1 ) then
602 
603  call atmos_phy_cp_vars_fillhalo
604 
605  if ( statistics_checktotal ) then
606  call stat_total( total, atmos_phy_cp_mflx_cloudbase(:,:) , var_name(1) )
607  call stat_total( total, atmos_phy_cp_sflx_rain(:,:) , var_name(2) )
608  call stat_total( total, atmos_phy_cp_cloudtop(:,:) , var_name(3) )
609  call stat_total( total, atmos_phy_cp_cloudbase(:,:) , var_name(4) )
610  call stat_total( total, atmos_phy_cp_cldfrac_dp(:,:,:), var_name(5) )
611  call stat_total( total, atmos_phy_cp_cldfrac_sh(:,:,:), var_name(6) )
612  call stat_total( total, atmos_phy_cp_kf_nca(:,:) , var_name(7) )
613  call stat_total( total, atmos_phy_cp_kf_w0avg(:,:,:), var_name(8) )
614  ! tendency
615  call stat_total( total, atmos_phy_cp_dens_t(:,:,:), var_t_name(1) )
616  call stat_total( total, atmos_phy_cp_rhot_t(:,:,:), var_t_name(2) )
617  do iq = 1, qa_mp
618  call stat_total( total, atmos_phy_cp_rhoq_t(:,:,:,iq), var_t_name(2+iq) )
619  enddo
620  endif
621 
622  call fileio_write( restart_fid, var_id(1), atmos_phy_cp_mflx_cloudbase(:,:), & ! [IN]
623  var_name(1), 'XY' ) ! [IN]
624  call fileio_write( restart_fid, var_id(2), atmos_phy_cp_sflx_rain(:,:), & ! [IN]
625  var_name(2), 'XY' ) ! [IN]
626  call fileio_write( restart_fid, var_id(3), atmos_phy_cp_cloudtop(:,:), & ! [IN]
627  var_name(3), 'XY' ) ! [IN]
628  call fileio_write( restart_fid, var_id(4), atmos_phy_cp_cloudbase(:,:), & ! [IN]
629  var_name(4), 'XY' ) ! [IN]
630  call fileio_write( restart_fid, var_id(5), atmos_phy_cp_cldfrac_dp(:,:,:), & ! [IN]
631  var_name(5), 'ZXY' ) ! [IN]
632  call fileio_write( restart_fid, var_id(6), atmos_phy_cp_cldfrac_sh(:,:,:), & ! [IN]
633  var_name(6), 'ZXY' ) ! [IN]
634  call fileio_write( restart_fid, var_id(7), atmos_phy_cp_kf_nca(:,:), & ! [IN]
635  var_name(7), 'XY' ) ! [IN]
636  call fileio_write( restart_fid, var_id(8), atmos_phy_cp_kf_w0avg(:,:,:), & ! [IN]
637  var_name(8), 'ZXY' ) ! [IN]
638 
639  ! tendency
640  call fileio_write( restart_fid, var_t_id(1), atmos_phy_cp_dens_t(:,:,:), & ! [IN]
641  var_t_name(1), 'ZXY' ) ! [IN]
642  call fileio_write( restart_fid, var_t_id(2), atmos_phy_cp_rhot_t(:,:,:), & ! [IN]
643  var_t_name(2), 'ZXY' ) ! [IN]
644  do iq = 1, qa_mp
645  call fileio_write( restart_fid, var_t_id(2+iq), atmos_phy_cp_rhoq_t(:,:,:,iq), & ! [IN]
646  var_t_name(2+iq), 'ZXY' ) ! [IN]
647  enddo
648 
649  endif
650 
651  return
logical, public statistics_checktotal
calc&report variable totals to logfile?
module ATMOSPHERE / Physics Cloud Microphysics
module FILE I/O (netcdf)
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_dens_t
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_cp_rhoq_t
module Statistics
real(rp), dimension(:,:,:), allocatable, public atmos_phy_cp_rhot_t
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_mflx_cloudbase
real(rp), dimension(:,:), allocatable, public atmos_phy_cp_sflx_rain
Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ atmos_phy_cp_restart_output

logical, public mod_atmos_phy_cp_vars::atmos_phy_cp_restart_output = .false.

output restart file?

Definition at line 46 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_admin_restart::admin_restart_setup(), and atmos_phy_cp_vars_setup().

46  logical, public :: ATMOS_PHY_CP_RESTART_OUTPUT = .false.

◆ atmos_phy_cp_restart_in_basename

character(len=h_long), public mod_atmos_phy_cp_vars::atmos_phy_cp_restart_in_basename = ''

Basename of the input file.

Definition at line 48 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_admin_restart::admin_restart_setup(), atmos_phy_cp_vars_restart_open(), and atmos_phy_cp_vars_setup().

48  character(len=H_LONG), public :: ATMOS_PHY_CP_RESTART_IN_BASENAME = ''

◆ atmos_phy_cp_restart_in_postfix_timelabel

logical, public mod_atmos_phy_cp_vars::atmos_phy_cp_restart_in_postfix_timelabel = .false.

Add timelabel to the basename of input file?

Definition at line 49 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_admin_restart::admin_restart_setup(), atmos_phy_cp_vars_restart_open(), and atmos_phy_cp_vars_setup().

49  logical, public :: ATMOS_PHY_CP_RESTART_IN_POSTFIX_TIMELABEL = .false.

◆ atmos_phy_cp_restart_out_basename

character(len=h_long), public mod_atmos_phy_cp_vars::atmos_phy_cp_restart_out_basename = ''

Basename of the output file.

Definition at line 50 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_admin_restart::admin_restart_setup(), atmos_phy_cp_vars_restart_create(), and atmos_phy_cp_vars_setup().

50  character(len=H_LONG), public :: ATMOS_PHY_CP_RESTART_OUT_BASENAME = ''

◆ atmos_phy_cp_restart_out_postfix_timelabel

logical, public mod_atmos_phy_cp_vars::atmos_phy_cp_restart_out_postfix_timelabel = .true.

Add timelabel to the basename of output file?

Definition at line 51 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_admin_restart::admin_restart_setup(), atmos_phy_cp_vars_restart_create(), and atmos_phy_cp_vars_setup().

51  logical, public :: ATMOS_PHY_CP_RESTART_OUT_POSTFIX_TIMELABEL = .true.

◆ atmos_phy_cp_restart_out_title

character(len=h_mid), public mod_atmos_phy_cp_vars::atmos_phy_cp_restart_out_title = 'ATMOS_PHY_CP restart'

title of the output file

Definition at line 52 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_admin_restart::admin_restart_setup(), atmos_phy_cp_vars_restart_create(), and atmos_phy_cp_vars_setup().

52  character(len=H_MID), public :: ATMOS_PHY_CP_RESTART_OUT_TITLE = 'ATMOS_PHY_CP restart'

◆ atmos_phy_cp_restart_out_dtype

character(len=h_short), public mod_atmos_phy_cp_vars::atmos_phy_cp_restart_out_dtype = 'DEFAULT'

REAL4 or REAL8.

Definition at line 53 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_admin_restart::admin_restart_setup(), atmos_phy_cp_vars_restart_create(), atmos_phy_cp_vars_restart_def_var(), and atmos_phy_cp_vars_setup().

53  character(len=H_SHORT), public :: ATMOS_PHY_CP_RESTART_OUT_DTYPE = 'DEFAULT'

◆ atmos_phy_cp_dens_t

real(rp), dimension(:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_dens_t

Definition at line 55 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_atmos_phy_cp_driver::atmos_phy_cp_driver(), atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

55  real(RP), public, allocatable :: ATMOS_PHY_CP_DENS_t(:,:,:) ! tendency DENS [kg/m3/s]

◆ atmos_phy_cp_momz_t

real(rp), dimension(:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_momz_t

Definition at line 56 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_atmos_phy_cp_driver::atmos_phy_cp_driver(), and atmos_phy_cp_vars_setup().

56  real(RP), public, allocatable :: ATMOS_PHY_CP_MOMZ_t(:,:,:) ! tendency MOMZ [kg/m2/s2]

◆ atmos_phy_cp_momx_t

real(rp), dimension(:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_momx_t

Definition at line 57 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_atmos_phy_cp_driver::atmos_phy_cp_driver(), and atmos_phy_cp_vars_setup().

57  real(RP), public, allocatable :: ATMOS_PHY_CP_MOMX_t(:,:,:) ! tendency MOMX [kg/m2/s2]

◆ atmos_phy_cp_momy_t

real(rp), dimension(:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_momy_t

Definition at line 58 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_atmos_phy_cp_driver::atmos_phy_cp_driver(), and atmos_phy_cp_vars_setup().

58  real(RP), public, allocatable :: ATMOS_PHY_CP_MOMY_t(:,:,:) ! tendency MOMY [kg/m2/s2]

◆ atmos_phy_cp_rhot_t

real(rp), dimension(:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_rhot_t

Definition at line 59 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_atmos_phy_cp_driver::atmos_phy_cp_driver(), atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

59  real(RP), public, allocatable :: ATMOS_PHY_CP_RHOT_t(:,:,:) ! tendency RHOT [K*kg/m3/s]

◆ atmos_phy_cp_rhoq_t

real(rp), dimension(:,:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_rhoq_t

Definition at line 60 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_atmos_phy_cp_driver::atmos_phy_cp_driver(), atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

60  real(RP), public, allocatable :: ATMOS_PHY_CP_RHOQ_t(:,:,:,:) ! tendency rho*QTRC [kg/kg/s]

◆ atmos_phy_cp_mflx_cloudbase

real(rp), dimension(:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_mflx_cloudbase

Definition at line 62 of file mod_atmos_phy_cp_vars.f90.

Referenced by mod_atmos_phy_cp_driver::atmos_phy_cp_driver(), atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

62  real(RP), public, allocatable :: ATMOS_PHY_CP_MFLX_cloudbase(:,:) ! cloud base mass flux [kg/m2/s]

◆ atmos_phy_cp_sflx_rain

real(rp), dimension (:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_sflx_rain

◆ atmos_phy_cp_cloudtop

real(rp), dimension (:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_cloudtop

Definition at line 64 of file mod_atmos_phy_cp_vars.f90.

Referenced by atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

64  real(RP), public, allocatable :: ATMOS_PHY_CP_cloudtop (:,:) ! cloud top height [m]

◆ atmos_phy_cp_cloudbase

real(rp), dimension (:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_cloudbase

Definition at line 65 of file mod_atmos_phy_cp_vars.f90.

Referenced by atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

65  real(RP), public, allocatable :: ATMOS_PHY_CP_cloudbase (:,:) ! cloud base height [m]

◆ atmos_phy_cp_cldfrac_dp

real(rp), dimension (:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_cldfrac_dp

Definition at line 66 of file mod_atmos_phy_cp_vars.f90.

Referenced by atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

66  real(RP), public, allocatable :: ATMOS_PHY_CP_cldfrac_dp (:,:,:) ! cloud fraction (deep convection) (0-1)

◆ atmos_phy_cp_cldfrac_sh

real(rp), dimension (:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_cldfrac_sh

Definition at line 67 of file mod_atmos_phy_cp_vars.f90.

Referenced by atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

67  real(RP), public, allocatable :: ATMOS_PHY_CP_cldfrac_sh (:,:,:) ! cloud fraction (shallow convection) (0-1)

◆ atmos_phy_cp_kf_nca

real(rp), dimension (:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_kf_nca

Definition at line 69 of file mod_atmos_phy_cp_vars.f90.

Referenced by atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

69  real(RP), public, allocatable :: ATMOS_PHY_CP_kf_nca (:,:) ! advection/cumulus convection timescale/dt for KF[step]

◆ atmos_phy_cp_kf_w0avg

real(rp), dimension (:,:,:), allocatable, public mod_atmos_phy_cp_vars::atmos_phy_cp_kf_w0avg

Definition at line 70 of file mod_atmos_phy_cp_vars.f90.

Referenced by atmos_phy_cp_vars_fillhalo(), atmos_phy_cp_vars_restart_read(), atmos_phy_cp_vars_restart_write(), and atmos_phy_cp_vars_setup().

70  real(RP), public, allocatable :: ATMOS_PHY_CP_kf_w0avg (:,:,:) ! running mean vertical wind velocity for KF[m/s]