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 logical,
private :: atmos_refstate_in_check_coordinates = .true.
66 character(len=H_LONG),
private :: atmos_refstate_out_basename =
'' 67 character(len=H_MID),
private :: atmos_refstate_out_title =
'SCALE-RM RefState' 68 character(len=H_SHORT),
private :: atmos_refstate_out_dtype =
'DEFAULT' 70 character(len=H_SHORT),
private :: atmos_refstate_type =
'UNIFORM' 71 real(RP),
private :: atmos_refstate_temp_sfc = 300.0_rp
72 real(RP),
private :: atmos_refstate_rh = 0.0_rp
73 real(RP),
private :: atmos_refstate_pott_uniform = 300.0_rp
74 real(DP),
private :: atmos_refstate_update_dt = 0.0_dp
76 real(DP),
private :: last_updated
78 real(RP),
private,
allocatable :: atmos_refstate1d_pres(:)
79 real(RP),
private,
allocatable :: atmos_refstate1d_temp(:)
80 real(RP),
private,
allocatable :: atmos_refstate1d_dens(:)
81 real(RP),
private,
allocatable :: atmos_refstate1d_pott(:)
82 real(RP),
private,
allocatable :: atmos_refstate1d_qv (:)
93 namelist / param_atmos_refstate / &
94 atmos_refstate_in_basename, &
95 atmos_refstate_out_basename, &
96 atmos_refstate_out_title, &
97 atmos_refstate_out_dtype, &
98 atmos_refstate_type, &
99 atmos_refstate_temp_sfc, &
101 atmos_refstate_pott_uniform, &
103 atmos_refstate_update_dt
109 if(
io_l )
write(
io_fid_log,*)
'++++++ Module[REFSTATE] / Categ[ATMOS SHARE] / Origin[SCALElib]' 117 allocate( atmos_refstate1d_pres(
ka) )
118 allocate( atmos_refstate1d_temp(
ka) )
119 allocate( atmos_refstate1d_dens(
ka) )
120 allocate( atmos_refstate1d_pott(
ka) )
121 allocate( atmos_refstate1d_qv(
ka) )
125 read(
io_fid_conf,nml=param_atmos_refstate,iostat=ierr)
127 if(
io_l )
write(
io_fid_log,*)
'*** Not found namelist. Default used.' 128 elseif( ierr > 0 )
then 129 write(*,*)
'xxx Not appropriate names in namelist PARAM_ATMOS_REFSTATE. Check!' 135 if ( atmos_refstate_in_basename /=
'' )
then 136 if(
io_l )
write(
io_fid_log,*)
'*** Input file of reference state : ', trim(atmos_refstate_in_basename)
138 if(
io_l )
write(
io_fid_log,*)
'*** Input file of reference state : Nothing, generate internally' 142 if ( atmos_refstate_in_basename /=
'' )
then 145 if ( atmos_refstate_type ==
'ISA' )
then 148 if(
io_l )
write(
io_fid_log,*)
'*** Surface temperature [K] : ', atmos_refstate_temp_sfc
149 if(
io_l )
write(
io_fid_log,*)
'*** Surface & environment RH [%] : ', atmos_refstate_rh
150 call atmos_refstate_generate_isa
153 elseif ( atmos_refstate_type ==
'UNIFORM' )
then 155 if(
io_l )
write(
io_fid_log,*)
'*** Reference type : UNIFORM POTT' 156 if(
io_l )
write(
io_fid_log,*)
'*** Potential temperature : ', atmos_refstate_pott_uniform
157 call atmos_refstate_generate_uniform
160 elseif ( atmos_refstate_type ==
'ZERO' )
then 163 call atmos_refstate_generate_zero
166 elseif ( atmos_refstate_type ==
'INIT' )
then 168 if(
io_l )
write(
io_fid_log,*)
'*** Reference type : Generate from initial data' 170 if(
io_l )
write(
io_fid_log,*)
'*** Update interval [sec] : ', atmos_refstate_update_dt
173 write(*,*)
'xxx ATMOS_REFSTATE_TYPE must be "ISA" or "UNIFORM". Check! : ', trim(atmos_refstate_type)
192 real(RP),
intent(in) :: dens(
ka,
ia,
ja)
193 real(RP),
intent(in) :: rhot(
ka,
ia,
ja)
194 real(RP),
intent(in) :: qtrc(
ka,
ia,
ja,
qa)
199 if ( atmos_refstate_in_basename ==
'' )
then 201 if ( atmos_refstate_type ==
'INIT' )
then 203 if(
io_l )
write(
io_fid_log,*)
'*** Reference type : make from initial data' 205 if(
io_l )
write(
io_fid_log,*)
'*** Update interval [sec] : ', atmos_refstate_update_dt
206 call atmos_refstate_generate_frominit( dens, rhot, qtrc )
211 if(
io_l )
write(
io_fid_log,*)
'###### Generated Reference State of Atmosphere ######' 212 if(
io_l )
write(
io_fid_log,*)
' z*-coord.: pressure: temperature: density: pot.temp.: water vapor' 215 atmos_refstate1d_pres(k), &
216 atmos_refstate1d_temp(k), &
217 atmos_refstate1d_dens(k), &
218 atmos_refstate1d_pott(k), &
219 atmos_refstate1d_qv(k)
221 if(
io_l )
write(
io_fid_log,*)
'####################################################' 224 if ( atmos_refstate_out_basename /=
'' )
then 225 if(
io_l )
write(
io_fid_log,*)
'*** Reference state output? : ', trim(atmos_refstate_out_basename)
241 fileio_check_coordinates, &
252 if(
io_l )
write(
io_fid_log,*)
'*** Input reference state profile ***' 254 if ( atmos_refstate_in_basename /=
'' )
then 256 call fileio_open( fid, atmos_refstate_in_basename )
258 if ( atmos_refstate_in_check_coordinates )
then 259 call fileio_check_coordinates( fid, atmos=.true. )
263 call fileio_read( atmos_refstate1d_pres(:), fid,
'PRES_ref',
'Z', step=1 )
264 call fileio_read( atmos_refstate1d_temp(:), fid,
'TEMP_ref',
'Z', step=1 )
265 call fileio_read( atmos_refstate1d_dens(:), fid,
'DENS_ref',
'Z', step=1 )
266 call fileio_read( atmos_refstate1d_pott(:), fid,
'POTT_ref',
'Z', step=1 )
267 call fileio_read( atmos_refstate1d_qv(:), fid,
'QV_ref',
'Z', step=1 )
277 write(*,*)
'xxx [ATMOS_REFSTATE_read] refstate file is not specified.' 295 if ( atmos_refstate_out_basename /=
'' )
then 298 if(
io_l )
write(
io_fid_log,*)
'*** Output reference state profile ***' 301 call fileio_write( atmos_refstate1d_pres(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
302 'PRES_ref',
'Reference profile of pres.',
'Pa',
'Z', atmos_refstate_out_dtype )
303 call fileio_write( atmos_refstate1d_temp(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
304 'TEMP_ref',
'Reference profile of temp.',
'K',
'Z', atmos_refstate_out_dtype )
305 call fileio_write( atmos_refstate1d_dens(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
306 'DENS_ref',
'Reference profile of rho',
'kg/m3',
'Z', atmos_refstate_out_dtype )
307 call fileio_write( atmos_refstate1d_pott(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
308 'POTT_ref',
'Reference profile of theta',
'K',
'Z', atmos_refstate_out_dtype )
309 call fileio_write( atmos_refstate1d_qv(:), atmos_refstate_out_basename, atmos_refstate_out_title, &
310 'QV_ref',
'Reference profile of qv',
'kg/kg',
'Z', atmos_refstate_out_dtype )
313 call fileio_write(
atmos_refstate_pres(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
314 'PRES_ref3D',
'Reference profile of pres.',
'Pa',
'ZXY', atmos_refstate_out_dtype )
315 call fileio_write(
atmos_refstate_temp(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
316 'TEMP_ref3D',
'Reference profile of temp.',
'K',
'ZXY', atmos_refstate_out_dtype )
317 call fileio_write(
atmos_refstate_dens(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
318 'DENS_ref3D',
'Reference profile of rho',
'kg/m3',
'ZXY', atmos_refstate_out_dtype )
319 call fileio_write(
atmos_refstate_pott(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
320 'POTT_ref3D',
'Reference profile of theta',
'K',
'ZXY', atmos_refstate_out_dtype )
321 call fileio_write(
atmos_refstate_qv(:,:,:), atmos_refstate_out_basename, atmos_refstate_out_title, &
322 'QV_ref3D',
'Reference profile of qv',
'kg/kg',
'ZXY', atmos_refstate_out_dtype )
331 subroutine atmos_refstate_generate_isa
340 profile_isa => atmos_profile_isa
342 hydrostatic_buildrho => atmos_hydrostatic_buildrho
344 saturation_psat_all => atmos_saturation_psat_all, &
345 saturation_dens2qsat_all => atmos_saturation_dens2qsat_all
369 pott_sfc = atmos_refstate_temp_sfc
374 call profile_isa(
ka,
ks,
ke, &
386 call hydrostatic_buildrho( dens(:), &
399 call saturation_psat_all( psat_sfc, temp_sfc )
400 call saturation_dens2qsat_all( qsat(:), temp(:), dens(:) )
402 psat_sfc = atmos_refstate_rh * 1.e-2_rp * psat_sfc
403 qv_sfc = epsvap * psat_sfc / ( pres_sfc - (1.0_rp-epsvap) * psat_sfc )
405 qv(k) = atmos_refstate_rh * 1.e-2_rp * qsat(k)
409 call hydrostatic_buildrho( dens(:), &
421 atmos_refstate1d_pres(:) = pres(:)
422 atmos_refstate1d_temp(:) = temp(:)
423 atmos_refstate1d_dens(:) = dens(:)
424 atmos_refstate1d_pott(:) = pott(:)
425 atmos_refstate1d_qv(:) = qv(:)
430 end subroutine atmos_refstate_generate_isa
434 subroutine atmos_refstate_generate_uniform
439 hydrostatic_buildrho => atmos_hydrostatic_buildrho
441 saturation_psat_all => atmos_saturation_psat_all, &
442 saturation_dens2qsat_all => atmos_saturation_dens2qsat_all
465 pott_sfc = atmos_refstate_temp_sfc
470 pott(k) = atmos_refstate_pott_uniform
476 call hydrostatic_buildrho( dens(:), &
489 call saturation_psat_all( psat_sfc, temp_sfc )
490 call saturation_dens2qsat_all( qsat(:), temp(:), pres(:) )
492 psat_sfc = atmos_refstate_rh * 1.e-2_rp * psat_sfc
493 qv_sfc = epsvap * psat_sfc / ( pres_sfc - (1.0_rp - epsvap) * psat_sfc )
495 qv(k) = atmos_refstate_rh * 1.e-2_rp * qsat(k)
499 call hydrostatic_buildrho( dens(:), &
511 atmos_refstate1d_pres(:) = pres(:)
512 atmos_refstate1d_temp(:) = temp(:)
513 atmos_refstate1d_dens(:) = dens(:)
514 atmos_refstate1d_pott(:) = pott(:)
515 atmos_refstate1d_qv(:) = qv(:)
520 end subroutine atmos_refstate_generate_uniform
524 subroutine atmos_refstate_generate_zero
543 end subroutine atmos_refstate_generate_zero
547 subroutine atmos_refstate_generate_frominit( &
553 real(RP),
intent(in) :: dens(
ka,
ia,
ja)
554 real(RP),
intent(in) :: rhot(
ka,
ia,
ja)
555 real(RP),
intent(in) :: qtrc(
ka,
ia,
ja,
qa)
558 last_updated =
time_nowsec - atmos_refstate_update_dt
563 end subroutine atmos_refstate_generate_frominit
576 thermodyn_temp_pres => atmos_thermodyn_temp_pres
580 real(RP),
intent(in) :: dens(
ka,
ia,
ja)
581 real(RP),
intent(in) :: rhot(
ka,
ia,
ja)
582 real(RP),
intent(in) :: qtrc(
ka,
ia,
ja,
qa)
584 real(RP) :: temp(
ka,
ia,
ja)
585 real(RP) :: pres(
ka,
ia,
ja)
586 real(RP) :: pott(
ka,
ia,
ja)
587 real(RP) :: work(
ka,
ia,
ja)
592 if (
time_nowsec - last_updated >= atmos_refstate_update_dt )
then 594 if(
io_l )
write(
io_fid_log,*)
'*** [REFSTATE] update reference state' 596 call thermodyn_temp_pres( temp, &
608 pott(k,i,j) = rhot(k,i,j) / dens(k,i,j)
639 atmos_refstate1d_qv(:) = 0.0_rp
643 if( atmos_refstate1d_dens(k) <= 0.0_rp ) atmos_refstate1d_dens(k) = atmos_refstate1d_dens(k+1)
644 if( atmos_refstate1d_temp(k) <= 0.0_rp ) atmos_refstate1d_temp(k) = atmos_refstate1d_temp(k+1)
645 if( atmos_refstate1d_pres(k) <= 0.0_rp ) atmos_refstate1d_pres(k) = atmos_refstate1d_pres(k+1)
646 if( atmos_refstate1d_pott(k) <= 0.0_rp ) atmos_refstate1d_pott(k) = atmos_refstate1d_pott(k+1)
647 if( atmos_refstate1d_qv(k) <= 0.0_rp ) atmos_refstate1d_qv(k) = atmos_refstate1d_qv(k+1)
649 call smoothing( atmos_refstate1d_pott(:) )
688 real(RP) :: dens(KA,IA,JA)
689 real(RP) :: temp(KA,IA,JA)
690 real(RP) :: pres(KA,IA,JA)
691 real(RP) :: pott(KA,IA,JA)
692 real(RP) :: qv (KA,IA,JA)
693 real(RP) :: qc (KA,IA,JA)
694 real(RP) :: dz (KA,IA,JA)
696 real(RP) :: dens_toa_1D
697 real(RP) :: temp_toa_1D
698 real(RP) :: pres_toa_1D
702 real(RP) :: work(KA,IA,JA)
712 work(:,i,j) = atmos_refstate1d_pott(:)
722 work(:,i,j) = atmos_refstate1d_qv(:)
735 call hydrostatic_buildrho_atmos_0d( dens_toa_1d, &
738 atmos_refstate1d_pott(
ke), &
739 atmos_refstate1d_qv(
ke), &
741 atmos_refstate1d_dens(
ke), &
742 atmos_refstate1d_pott(
ke), &
743 atmos_refstate1d_qv(
ke), &
761 dens(
ke+1,i,j) = dens_toa_1d
762 temp(
ke+1,i,j) = temp_toa_1d
763 pres(
ke+1,i,j) = pres_toa_1d
764 pott(
ke+1,i,j) = pott(
ke,i,j)
765 qv(
ke+1,i,j) = qv(
ke,i,j)
771 pott(
ks-1,i,j) = pott(
ks,i,j)
772 qv(
ks-1,i,j) = qv(
ks,i,j)
778 call hydrostatic_buildrho_atmos_rev_2d( dens(
ke ,:,:), &
791 call hydrostatic_buildrho_atmos_rev_3d( dens(:,:,:), &
878 real(RP),
intent(inout) :: phi(KA)
884 integer,
parameter :: iter_max = 100
885 real(RP) :: sig0, sig1, zerosw
893 flux(
ks-1:
ks+1) = 0.0_rp
894 flux(
ke-1:
ke+1) = 0.0_rp
896 fact(
ks-1:
ks+1) = 0.0_rp
897 fact(
ke-1:
ke+1) = 0.0_rp
899 do iter = 1, iter_max
903 dev(k) = phi(k) - ( fdz(k-1)*phi(k+1) + fdz(k)*phi(k-1) ) / ( fdz(k) + fdz(k-1) )
907 sig0 = dev(k) * dev(k-1)
908 sig1 = dev(k) * dev(k+1)
911 / ( 2.0_rp*rcdz(k) + ( fdz(k-1)*rcdz(k+1) + fdz(k)*rcdz(k-1) ) / ( fdz(k) + fdz(k-1) ) ) &
912 * ( sign(0.5_rp ,sig0) + sign(0.5_rp ,sig1) ) &
913 * ( sign(0.25_rp,sig0) + sign(0.25_rp,sig1) - 0.5_rp )
914 updated = updated .OR. ( sig0 < -eps .AND. sig1 < -eps )
917 sig1 = dev(
ks+1) * dev(
ks+2)
918 flux(
ks+1) = dev(
ks+1) &
919 / ( 2.0_rp*rcdz(
ks+1) + (fdz(
ks)*rcdz(
ks+2)+fdz(
ks+1)*rcdz(
ks))/(fdz(
ks+1)+fdz(
ks)) ) &
920 * ( 0.5_rp - sign(0.5_rp ,sig1) )
921 updated = updated .OR. ( sig1 < -eps )
923 sig0 = dev(
ke-1) * dev(
ke-2)
924 flux(
ke-1) = dev(
ke-1) &
925 / ( 2.0_rp*rcdz(
ke-1) + (fdz(
ke-2)*rcdz(
ke)+fdz(
ke-1)*rcdz(
ke-2))/(fdz(
ke-1)+fdz(
ke-2)) ) &
926 * ( 0.5_rp - sign(0.5_rp ,sig0) )
927 updated = updated .OR. ( sig0 < -eps )
929 if ( .NOT. updated )
exit 932 zerosw = 0.5_rp - sign( 0.5_rp, abs(flux(k))-eps )
933 fact(k) = flux(k) / ( flux(k) - flux(k+1) - flux(k-1) + zerosw )
937 phi(k) = phi(k) + ( flux(k+1) * fact(k+1) &
938 - flux(k ) * fact(k ) * 2.0_rp &
939 + flux(k-1) * fact(k-1) ) * rcdz(k)
942 if ( iter == iter_max )
then 943 if(
io_l )
write(
io_fid_log,*)
"*** [scale_atmos_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)
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), dimension(qa_max), public tracer_cv
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
real(rp), public const_undef
real(rp), dimension(qa_max), public tracer_cp
logical, public io_nml
output log or not? (for namelist, this process)
module ATMOSPHERE / Typical vertical profile
integer, public ia
of whole cells: x, 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 whole cells: z, 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]
subroutine, public fileio_open(fid, basename)
open a netCDF file for read
subroutine, public fileio_close(fid)
Close a netCDF file.
subroutine, public interp_vertical_z2xi(var, var_Xi)
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)
integer, public io_fid_nml
Log file ID (only for output namelist)
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)
real(rp), dimension(qa_max), public tracer_mass
integer, public ja
of whole cells: y, local, with HALO