55 private :: atmos_refstate_generate_isa
56 private :: atmos_refstate_generate_uniform
57 private :: atmos_refstate_generate_zero
58 private :: atmos_refstate_generate_frominit
64 character(len=H_LONG),
private :: atmos_refstate_in_basename =
'' 65 character(len=H_LONG),
private :: atmos_refstate_out_basename =
'' 66 character(len=H_MID) ,
private :: atmos_refstate_out_title =
'SCALE-RM RefState' 67 character(len=H_MID) ,
private :: atmos_refstate_out_dtype =
'DEFAULT' 69 character(len=H_SHORT),
private :: atmos_refstate_type =
'UNIFORM' 70 real(RP),
private :: atmos_refstate_temp_sfc = 300.0_rp
71 real(RP),
private :: atmos_refstate_rh = 0.0_rp
72 real(RP),
private :: atmos_refstate_pott_uniform = 300.0_rp
73 real(DP),
private :: atmos_refstate_update_dt = 0.0_dp
75 real(DP),
private :: last_updated
77 real(RP),
private,
allocatable :: atmos_refstate1d_pres(:)
78 real(RP),
private,
allocatable :: atmos_refstate1d_temp(:)
79 real(RP),
private,
allocatable :: atmos_refstate1d_dens(:)
80 real(RP),
private,
allocatable :: atmos_refstate1d_pott(:)
81 real(RP),
private,
allocatable :: atmos_refstate1d_qv (:)
92 namelist / param_atmos_refstate / &
93 atmos_refstate_in_basename, &
94 atmos_refstate_out_basename, &
95 atmos_refstate_out_title, &
96 atmos_refstate_out_dtype, &
97 atmos_refstate_type, &
98 atmos_refstate_temp_sfc, &
100 atmos_refstate_pott_uniform, &
102 atmos_refstate_update_dt
108 if(
io_l )
write(
io_fid_log,*)
'++++++ Module[REFSTATE] / Categ[ATMOS SHARE] / Origin[SCALElib]' 116 allocate( atmos_refstate1d_pres(
ka) )
117 allocate( atmos_refstate1d_temp(
ka) )
118 allocate( atmos_refstate1d_dens(
ka) )
119 allocate( atmos_refstate1d_pott(
ka) )
120 allocate( atmos_refstate1d_qv(
ka) )
124 read(
io_fid_conf,nml=param_atmos_refstate,iostat=ierr)
126 if(
io_l )
write(
io_fid_log,*)
'*** Not found namelist. Default used.' 127 elseif( ierr > 0 )
then 128 write(*,*)
'xxx Not appropriate names in namelist PARAM_ATMOS_REFSTATE. Check!' 134 if ( atmos_refstate_in_basename /=
'' )
then 135 if(
io_l )
write(
io_fid_log,*)
'*** Input file of reference state : ', trim(atmos_refstate_in_basename)
137 if(
io_l )
write(
io_fid_log,*)
'*** Input file of reference state : Nothing, generate internally' 141 if ( atmos_refstate_in_basename /=
'' )
then 144 if ( atmos_refstate_type ==
'ISA' )
then 147 if(
io_l )
write(
io_fid_log,*)
'*** surface temperature [K] : ', atmos_refstate_temp_sfc
148 if(
io_l )
write(
io_fid_log,*)
'*** surface & environment RH [%] : ', atmos_refstate_rh
149 call atmos_refstate_generate_isa
152 elseif ( atmos_refstate_type ==
'UNIFORM' )
then 154 if(
io_l )
write(
io_fid_log,*)
'*** Reference type : UNIFORM POTT' 155 if(
io_l )
write(
io_fid_log,*)
'*** potential temperature : ', atmos_refstate_pott_uniform
156 call atmos_refstate_generate_uniform
159 elseif ( atmos_refstate_type ==
'ZERO' )
then 162 call atmos_refstate_generate_zero
165 elseif ( atmos_refstate_type ==
'INIT' )
then 167 if(
io_l )
write(
io_fid_log,*)
'*** Reference type : make from initial data' 169 if(
io_l )
write(
io_fid_log,*)
'*** Update interval [sec] : ', atmos_refstate_update_dt
172 write(*,*)
'xxx ATMOS_REFSTATE_TYPE must be "ISA" or "UNIFORM". Check! : ', trim(atmos_refstate_type)
191 real(RP),
intent(in) :: DENS(
ka,
ia,
ja)
192 real(RP),
intent(in) :: RHOT(
ka,
ia,
ja)
193 real(RP),
intent(in) :: QTRC(
ka,
ia,
ja,
qa)
198 if ( atmos_refstate_in_basename ==
'' )
then 200 if ( atmos_refstate_type ==
'INIT' )
then 202 if(
io_l )
write(
io_fid_log,*)
'*** Reference type : make from initial data' 204 if(
io_l )
write(
io_fid_log,*)
'*** Update interval [sec] : ', atmos_refstate_update_dt
205 call atmos_refstate_generate_frominit( dens, rhot, qtrc )
210 if(
io_l )
write(
io_fid_log,*)
'###### Generated Reference State of Atmosphere ######' 211 if(
io_l )
write(
io_fid_log,*)
' z*-coord.: pressure: temperature: density: pot.temp.: water vapor' 214 atmos_refstate1d_pres(k), &
215 atmos_refstate1d_temp(k), &
216 atmos_refstate1d_dens(k), &
217 atmos_refstate1d_pott(k), &
218 atmos_refstate1d_qv(k)
220 if(
io_l )
write(
io_fid_log,*)
'####################################################' 223 if ( atmos_refstate_out_basename /=
'' )
then 224 if(
io_l )
write(
io_fid_log,*)
'*** Reference state output? : ', trim(atmos_refstate_out_basename)
246 if(
io_l )
write(
io_fid_log,*)
'*** Input reference state profile ***' 248 if ( atmos_refstate_in_basename /=
'' )
then 251 call fileio_read( atmos_refstate1d_pres(:), &
252 atmos_refstate_in_basename,
'PRES_ref',
'Z', step=1 )
253 call fileio_read( atmos_refstate1d_temp(:), &
254 atmos_refstate_in_basename,
'TEMP_ref',
'Z', step=1 )
255 call fileio_read( atmos_refstate1d_dens(:), &
256 atmos_refstate_in_basename,
'DENS_ref',
'Z', step=1 )
257 call fileio_read( atmos_refstate1d_pott(:), &
258 atmos_refstate_in_basename,
'POTT_ref',
'Z', step=1 )
259 call fileio_read( atmos_refstate1d_qv(:), &
260 atmos_refstate_in_basename,
'QV_ref',
'Z', step=1 )
264 atmos_refstate_in_basename,
'PRES_ref3D',
'ZXY', step=1 )
266 atmos_refstate_in_basename,
'TEMP_ref3D',
'ZXY', step=1 )
268 atmos_refstate_in_basename,
'DENS_ref3D',
'ZXY', step=1 )
270 atmos_refstate_in_basename,
'POTT_ref3D',
'ZXY', step=1 )
272 atmos_refstate_in_basename,
'QV_ref3D',
'ZXY', step=1 )
275 if(
io_l )
write(*,*)
'xxx refstate file is not specified.' 293 if ( atmos_refstate_out_basename /=
'' )
then 296 if(
io_l )
write(
io_fid_log,*)
'*** Output reference state profile ***' 299 call fileio_write( atmos_refstate1d_pres(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
300 'PRES_ref',
'Reference profile of pres.',
'Pa',
'Z', atmos_refstate_out_dtype )
301 call fileio_write( atmos_refstate1d_temp(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
302 'TEMP_ref',
'Reference profile of temp.',
'K',
'Z', atmos_refstate_out_dtype )
303 call fileio_write( atmos_refstate1d_dens(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
304 'DENS_ref',
'Reference profile of rho',
'kg/m3',
'Z', atmos_refstate_out_dtype )
305 call fileio_write( atmos_refstate1d_pott(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
306 'POTT_ref',
'Reference profile of theta',
'K',
'Z', atmos_refstate_out_dtype )
307 call fileio_write( atmos_refstate1d_qv(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
308 'QV_ref',
'Reference profile of qv',
'kg/kg',
'Z', atmos_refstate_out_dtype )
311 call fileio_write(
atmos_refstate_pres(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
312 'PRES_ref3D',
'Reference profile of pres.',
'Pa',
'ZXY', atmos_refstate_out_dtype )
313 call fileio_write(
atmos_refstate_temp(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
314 'TEMP_ref3D',
'Reference profile of temp.',
'K',
'ZXY', atmos_refstate_out_dtype )
315 call fileio_write(
atmos_refstate_dens(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
316 'DENS_ref3D',
'Reference profile of rho',
'kg/m3',
'ZXY', atmos_refstate_out_dtype )
317 call fileio_write(
atmos_refstate_pott(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
318 'POTT_ref3D',
'Reference profile of theta',
'K',
'ZXY', atmos_refstate_out_dtype )
319 call fileio_write(
atmos_refstate_qv(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
320 'QV_ref3D',
'Reference profile of qv',
'kg/kg',
'ZXY', atmos_refstate_out_dtype )
329 subroutine atmos_refstate_generate_isa
338 profile_isa => atmos_profile_isa
340 hydrostatic_buildrho => atmos_hydrostatic_buildrho
342 saturation_psat_all => atmos_saturation_psat_all, &
343 saturation_dens2qsat_all => atmos_saturation_dens2qsat_all
367 pott_sfc = atmos_refstate_temp_sfc
372 call profile_isa(
ka,
ks,
ke, &
384 call hydrostatic_buildrho( dens(:), &
397 call saturation_psat_all( psat_sfc, temp_sfc )
398 call saturation_dens2qsat_all( qsat(:), temp(:), dens(:) )
400 psat_sfc = atmos_refstate_rh * 1.e-2_rp * psat_sfc
401 qv_sfc = epsvap * psat_sfc / ( pres_sfc - (1.0_rp-epsvap) * psat_sfc )
403 qv(k) = atmos_refstate_rh * 1.e-2_rp * qsat(k)
407 call hydrostatic_buildrho( dens(:), &
419 atmos_refstate1d_pres(:) = pres(:)
420 atmos_refstate1d_temp(:) = temp(:)
421 atmos_refstate1d_dens(:) = dens(:)
422 atmos_refstate1d_pott(:) = pott(:)
423 atmos_refstate1d_qv(:) = qv(:)
428 end subroutine atmos_refstate_generate_isa
432 subroutine atmos_refstate_generate_uniform
437 hydrostatic_buildrho => atmos_hydrostatic_buildrho
439 saturation_psat_all => atmos_saturation_psat_all, &
440 saturation_dens2qsat_all => atmos_saturation_dens2qsat_all
463 pott_sfc = atmos_refstate_temp_sfc
468 pott(k) = atmos_refstate_pott_uniform
474 call hydrostatic_buildrho( dens(:), &
487 call saturation_psat_all( psat_sfc, temp_sfc )
488 call saturation_dens2qsat_all( qsat(:), temp(:), pres(:) )
490 psat_sfc = atmos_refstate_rh * 1.e-2_rp * psat_sfc
491 qv_sfc = epsvap * psat_sfc / ( pres_sfc - (1.0_rp - epsvap) * psat_sfc )
493 qv(k) = atmos_refstate_rh * 1.e-2_rp * qsat(k)
497 call hydrostatic_buildrho( dens(:), &
509 atmos_refstate1d_pres(:) = pres(:)
510 atmos_refstate1d_temp(:) = temp(:)
511 atmos_refstate1d_dens(:) = dens(:)
512 atmos_refstate1d_pott(:) = pott(:)
513 atmos_refstate1d_qv(:) = qv(:)
518 end subroutine atmos_refstate_generate_uniform
522 subroutine atmos_refstate_generate_zero
541 end subroutine atmos_refstate_generate_zero
545 subroutine atmos_refstate_generate_frominit( &
551 real(RP),
intent(in) :: DENS(
ka,
ia,
ja)
552 real(RP),
intent(in) :: RHOT(
ka,
ia,
ja)
553 real(RP),
intent(in) :: QTRC(
ka,
ia,
ja,
qa)
556 last_updated =
time_nowsec - atmos_refstate_update_dt
561 end subroutine atmos_refstate_generate_frominit
574 thermodyn_temp_pres => atmos_thermodyn_temp_pres
576 real(RP),
intent(in) :: DENS(
ka,
ia,
ja)
577 real(RP),
intent(in) :: RHOT(
ka,
ia,
ja)
578 real(RP),
intent(in) :: QTRC(
ka,
ia,
ja,
qa)
580 real(RP) :: temp(
ka,
ia,
ja)
581 real(RP) :: pres(
ka,
ia,
ja)
582 real(RP) :: pott(
ka,
ia,
ja)
583 real(RP) :: work(
ka,
ia,
ja)
588 if (
time_nowsec - last_updated >= atmos_refstate_update_dt )
then 590 if(
io_l )
write(
io_fid_log,*)
'*** [REFSTATE] update reference state' 592 call thermodyn_temp_pres( temp(:,:,:), &
601 pott(k,i,j) = rhot(k,i,j) / dens(k,i,j)
632 if( atmos_refstate1d_dens(k) <= 0.0_rp ) atmos_refstate1d_dens(k) = atmos_refstate1d_dens(k+1)
633 if( atmos_refstate1d_temp(k) <= 0.0_rp ) atmos_refstate1d_temp(k) = atmos_refstate1d_temp(k+1)
634 if( atmos_refstate1d_pres(k) <= 0.0_rp ) atmos_refstate1d_pres(k) = atmos_refstate1d_pres(k+1)
635 if( atmos_refstate1d_pott(k) <= 0.0_rp ) atmos_refstate1d_pott(k) = atmos_refstate1d_pott(k+1)
636 if( atmos_refstate1d_qv(k) <= 0.0_rp ) atmos_refstate1d_qv(k) = atmos_refstate1d_qv(k+1)
638 call smoothing( atmos_refstate1d_pott(:) )
677 real(RP) :: dens(
ka,
ia,
ja)
678 real(RP) :: temp(
ka,
ia,
ja)
679 real(RP) :: pres(
ka,
ia,
ja)
680 real(RP) :: pott(
ka,
ia,
ja)
685 real(RP) :: dens_toa_1D
686 real(RP) :: temp_toa_1D
687 real(RP) :: pres_toa_1D
691 real(RP) :: work(
ka,
ia,
ja)
701 work(:,i,j) = atmos_refstate1d_pott(:)
711 work(:,i,j) = atmos_refstate1d_qv(:)
724 call hydrostatic_buildrho_atmos_0d( dens_toa_1d, &
727 atmos_refstate1d_pott(
ke), &
728 atmos_refstate1d_qv(
ke), &
730 atmos_refstate1d_dens(
ke), &
731 atmos_refstate1d_pott(
ke), &
732 atmos_refstate1d_qv(
ke), &
750 dens(
ke+1,i,j) = dens_toa_1d
751 temp(
ke+1,i,j) = temp_toa_1d
752 pres(
ke+1,i,j) = pres_toa_1d
753 pott(
ke+1,i,j) = pott(
ke,i,j)
754 qv(
ke+1,i,j) = qv(
ke,i,j)
760 pott(
ks-1,i,j) = pott(
ks,i,j)
761 qv(
ks-1,i,j) = qv(
ks,i,j)
767 call hydrostatic_buildrho_atmos_rev_2d( dens(
ke ,:,:), &
780 call hydrostatic_buildrho_atmos_rev_3d( dens(:,:,:), &
867 real(RP),
intent(inout) :: phi(
ka)
873 integer,
parameter :: iter_max = 100
874 real(RP) :: sig0, sig1, zerosw
882 flux(
ks-1:
ks+1) = 0.0_rp
883 flux(
ke-1:
ke+1) = 0.0_rp
885 fact(
ks-1:
ks+1) = 0.0_rp
886 fact(
ke-1:
ke+1) = 0.0_rp
888 do iter = 1, iter_max
892 dev(k) = phi(k) - ( fdz(k-1)*phi(k+1) + fdz(k)*phi(k-1) ) / ( fdz(k) + fdz(k-1) )
896 sig0 = dev(k) * dev(k-1)
897 sig1 = dev(k) * dev(k+1)
900 / ( 2.0_rp*rcdz(k) + ( fdz(k-1)*rcdz(k+1) + fdz(k)*rcdz(k-1) ) / ( fdz(k) + fdz(k-1) ) ) &
901 * ( sign(0.5_rp ,sig0) + sign(0.5_rp ,sig1) ) &
902 * ( sign(0.25_rp,sig0) + sign(0.25_rp,sig1) - 0.5_rp )
903 updated = updated .OR. ( sig0 < -eps .AND. sig1 < -eps )
906 sig1 = dev(
ks+1) * dev(
ks+2)
907 flux(
ks+1) = dev(
ks+1) &
908 / ( 2.0_rp*rcdz(
ks+1) + (fdz(
ks)*rcdz(
ks+2)+fdz(
ks+1)*rcdz(
ks))/(fdz(
ks+1)+fdz(
ks)) ) &
909 * ( 0.5_rp - sign(0.5_rp ,sig1) )
910 updated = updated .OR. ( sig1 < -eps )
912 sig0 = dev(
ke-1) * dev(
ke-2)
913 flux(
ke-1) = dev(
ke-1) &
914 / ( 2.0_rp*rcdz(
ke-1) + (fdz(
ke-2)*rcdz(
ke)+fdz(
ke-1)*rcdz(
ke-2))/(fdz(
ke-1)+fdz(
ke-2)) ) &
915 * ( 0.5_rp - sign(0.5_rp ,sig0) )
916 updated = updated .OR. ( sig0 < -eps )
918 if ( .NOT. updated )
exit 921 zerosw = 0.5_rp - sign( 0.5_rp, abs(flux(k))-eps )
922 fact(k) = flux(k) / ( flux(k) - flux(k+1) - flux(k-1) + zerosw )
926 phi(k) = phi(k) + ( flux(k+1) * fact(k+1) &
927 - flux(k ) * fact(k ) * 2.0_rp &
928 + flux(k-1) * fact(k-1) ) * rcdz(k)
931 if ( iter == iter_max )
then 932 if (
io_l)
write(
io_fid_log,*)
"*** [refstate smoothing] iteration not converged!", phi
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_temp
refernce temperature [K]
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
module ATMOSPHERE / Saturation adjustment
subroutine, public prc_mpistop
Abort MPI.
subroutine, public atmos_hydrostatic_buildrho_atmos_rev_3d(dens, temp, pres, pott, qv, qc, dz, kref_in)
Build up density from lowermost atmosphere (3D)
real(dp), public time_nowsec
subday part of current time [sec]
logical, public io_l
output log or not? (this process)
real(rp), dimension(:), allocatable, public grid_cz
center coordinate [m]: z, local=global
module ATMOSPHERE / Reference state
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_pott
refernce potential temperature [K]
integer, public ke
end point of inner domain: z, local
subroutine smoothing(phi)
real(rp), dimension(:,:,:), allocatable, public real_fz
geopotential height [m] (cell face )
subroutine, public interp_vertical_xi2z(var, var_Z)
Reset random seed.
real(rp), dimension(:,:,:), allocatable, public real_cz
geopotential height [m] (cell center)
real(rp), dimension(:), allocatable, public grid_rcdz
reciprocal of center-dz
subroutine, public atmos_refstate_write
Write reference state profile.
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
real(rp), public const_undef
module ATMOSPHERE / Typical vertical profile
integer, public ia
of x whole cells (local, with HALO)
logical, public atmos_refstate_update_flag
subroutine, public comm_horizontal_mean(varmean, var)
calculate horizontal mean (global total with communication)
real(rp), dimension(:), allocatable, public grid_fdz
z-length of grid(k+1) to grid(k) [m]
integer, public ka
of z whole cells (local, with HALO)
subroutine, public atmos_refstate_update(DENS, RHOT, QTRC)
Update reference state profile (Horizontal average)
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_dens
refernce density [kg/m3]
subroutine, public atmos_refstate_setup
Setup.
real(rp), public const_pre00
pressure reference [Pa]
real(rp), dimension(:), allocatable, public grid_fz
face coordinate [m]: z, local=global
module ATMOSPHERE / Hydrostatic barance
real(rp), public const_epsvap
Rdry / Rvap.
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_pres
refernce pressure [Pa]
integer, public ks
start point of inner domain: z, local
subroutine, public atmos_refstate_read
Read reference state profile.
real(rp), public const_eps
small number
real(rp), dimension(:,:,:), allocatable, public real_phi
geopotential [m2/s2] (cell center)
module ATMOSPHERE / Thermodynamics
real(rp), dimension(:,:,:), allocatable, public atmos_refstate_qv
refernce vapor [kg/kg]
logical, public io_lnml
output log or not? (for namelist, this process)
subroutine, public interp_vertical_z2xi(var, var_Xi)
Reset random seed.
subroutine atmos_refstate_calc3d
apply 1D reference to 3D (terrain-following) with re-calc hydrostatic balance
integer, public io_fid_conf
Config file ID.
subroutine, public atmos_refstate_resume(DENS, RHOT, QTRC)
Resume.
integer, public io_fid_log
Log file ID.
subroutine, public atmos_hydrostatic_buildrho_atmos_rev_2d(dens_L1, temp_L1, pres_L1, pott_L1, qv_L1, qc_L1, dens_L2, pott_L2, qv_L2, qc_L2, dz, k)
Build up density (2D)
real(rp), public const_pstd
standard pressure [Pa]
subroutine, public atmos_hydrostatic_buildrho_atmos_0d(dens_L2, temp_L2, pres_L2, pott_L2, qv_L2, qc_L2, dens_L1, pott_L1, qv_L1, qc_L1, dz, k)
Build up density (0D)
integer, public ja
of y whole cells (local, with HALO)