54 profile_isa => atmos_profile_isa
56 hydrometeor_lhv => atmos_hydrometeor_lhv
58 hydrostatic_buildrho => atmos_hydrostatic_buildrho, &
59 hydrostatic_buildrho_atmos => atmos_hydrostatic_buildrho_atmos, &
60 hydrostatic_buildrho_bytemp => atmos_hydrostatic_buildrho_bytemp
62 saturation_psat_all => atmos_saturation_psat_all, &
63 saturation_pres2qsat_all => atmos_saturation_pres2qsat_all, &
64 saturation_pres2qsat_liq => atmos_saturation_pres2qsat_liq
107 integer,
public,
parameter ::
i_rico = 15
122 integer,
public,
parameter ::
i_real = 25
136 private :: bubble_setup
137 private :: sbmaero_setup
138 private :: aerosol_setup
140 private :: mkinit_planestate
141 private :: mkinit_tracerbubble
142 private :: mkinit_coldbubble
143 private :: mkinit_lambwave
144 private :: mkinit_gravitywave
145 private :: mkinit_khwave
146 private :: mkinit_turbulence
147 private :: mkinit_cavityflow
148 private :: mkinit_mountainwave
149 private :: mkinit_barocwave
151 private :: mkinit_warmbubble
152 private :: mkinit_supercell
153 private :: mkinit_squallline
154 private :: mkinit_wk1982
155 private :: mkinit_dycoms2_rf01
156 private :: mkinit_dycoms2_rf02
157 private :: mkinit_rico
158 private :: mkinit_bomex
160 private :: mkinit_landcouple
161 private :: mkinit_oceancouple
162 private :: mkinit_urbancouple
163 private :: mkinit_seabreeze
164 private :: mkinit_heatisland
166 private :: mkinit_dycoms2_rf02_dns
168 private :: mkinit_real
170 private :: mkinit_grayzone
172 private :: mkinit_boxaero
173 private :: mkinit_warmbubbleaero
179 real(RP),
private,
parameter :: thetastd = 300.0_rp
181 real(RP),
private,
allocatable :: pres (:,:,:)
182 real(RP),
private,
allocatable :: temp (:,:,:)
183 real(RP),
private,
allocatable :: pott (:,:,:)
184 real(RP),
private,
allocatable :: qdry (:,:,:)
185 real(RP),
private,
allocatable :: qsat (:,:,:)
186 real(RP),
private,
allocatable :: qv (:,:,:)
187 real(RP),
private,
allocatable :: qc (:,:,:)
188 real(RP),
private,
allocatable :: nc (:,:,:)
189 real(RP),
private,
allocatable :: velx (:,:,:)
190 real(RP),
private,
allocatable :: vely (:,:,:)
192 real(RP),
private,
allocatable :: pres_sfc(:,:)
193 real(RP),
private,
allocatable :: temp_sfc(:,:)
194 real(RP),
private,
allocatable :: pott_sfc(:,:)
195 real(RP),
private,
allocatable :: psat_sfc(:,:)
196 real(RP),
private,
allocatable :: qsat_sfc(:,:)
197 real(RP),
private,
allocatable :: qv_sfc (:,:)
198 real(RP),
private,
allocatable :: qc_sfc (:,:)
200 real(RP),
private,
allocatable :: rndm (:,:,:)
201 real(RP),
private,
allocatable,
target :: bubble (:,:,:)
202 real(RP),
private,
allocatable,
target :: rect (:,:,:)
203 real(RP),
private,
allocatable :: gan (:)
212 character(len=H_SHORT) :: MKINIT_initname =
'NONE' 214 namelist / param_mkinit / &
221 log_info(
"MKINIT_setup",*)
'Setup' 227 log_info(
"MKINIT_setup",*)
'Not found namelist. Default used.' 228 elseif( ierr > 0 )
then 229 log_error(
"MKINIT_setup",*)
'Not appropriate names in namelist PARAM_MKINIT. Check!' 232 log_nml(param_mkinit)
234 allocate( pres(
ka,
ia,
ja) )
235 allocate( temp(
ka,
ia,
ja) )
236 allocate( pott(
ka,
ia,
ja) )
237 allocate( qdry(
ka,
ia,
ja) )
238 allocate( qsat(
ka,
ia,
ja) )
242 allocate( velx(
ka,
ia,
ja) )
243 allocate( vely(
ka,
ia,
ja) )
245 allocate( pres_sfc(
ia,
ja) )
246 allocate( temp_sfc(
ia,
ja) )
247 allocate( pott_sfc(
ia,
ja) )
248 allocate( psat_sfc(
ia,
ja) )
249 allocate( qsat_sfc(
ia,
ja) )
250 allocate( qv_sfc(
ia,
ja) )
251 allocate( qc_sfc(
ia,
ja) )
253 allocate( rndm(
ka,
ia,
ja) )
254 allocate( bubble(
ka,
ia,
ja) )
255 allocate( rect(
ka,
ia,
ja) )
258 select case(trim(mkinit_initname))
300 case(
'INTERPORATION')
317 case(
'DYCOMS2_RF02_DNS')
325 case(
'WARMBUBBLEAERO')
333 log_error(
"MKINIT_setup",*)
'Unsupported TYPE:', trim(mkinit_initname)
342 subroutine mkinit( output )
357 logical,
intent(out) :: output
362 logical :: convert_qtrc
367 log_progress(*)
'skip making initial data' 371 log_progress(*)
'start making initial data' 396 qtrc(:,:,:,:) = 0.0_rp
398 qhyd(:,:,:,:) = 0.0_rp
400 qnum(:,:,:,:) = 0.0_rp
404 convert_qtrc = .true.
408 call mkinit_planestate
410 call mkinit_tracerbubble
412 call mkinit_coldbubble
416 call mkinit_gravitywave
420 call mkinit_turbulence
422 call mkinit_mountainwave
424 call mkinit_warmbubble
426 call mkinit_supercell
428 call mkinit_squallline
432 call mkinit_dycoms2_rf01
434 call mkinit_dycoms2_rf02
440 call mkinit_planestate
441 call mkinit_oceancouple
443 call mkinit_planestate
444 call mkinit_landcouple
446 call mkinit_planestate
447 call mkinit_urbancouple
449 call mkinit_planestate
450 call mkinit_oceancouple
451 call mkinit_landcouple
452 call mkinit_urbancouple
454 call mkinit_planestate
455 call mkinit_warmbubble
456 call mkinit_oceancouple
457 call mkinit_landcouple
458 call mkinit_urbancouple
460 call mkinit_planestate
461 call mkinit_seabreeze
463 call mkinit_planestate
464 call mkinit_heatisland
466 call mkinit_dycoms2_rf02_dns
469 convert_qtrc = .false.
475 call mkinit_warmbubbleaero
477 call mkinit_cavityflow
479 call mkinit_barocwave
481 log_error(
"MKINIT",*)
'Unsupported TYPE:',
mkinit_type 489 call sbmaero_setup( convert_qtrc )
491 if (
qa_mp > 0 .AND. convert_qtrc )
then 493 qhyd(:,:,:,
i_hc) = qc(:,:,:)
495 qnum(:,:,:,
i_hc) = nc(:,:,:)
497 qv(:,:,:), qhyd(:,:,:,:), &
504 log_progress(*)
'end making initial data' 515 subroutine bubble_setup
521 logical :: BBL_eachnode = .false.
522 real(RP) :: BBL_CZ = 2.e3_rp
523 real(RP) :: BBL_CX = 2.e3_rp
524 real(RP) :: BBL_CY = 2.e3_rp
525 real(RP) :: BBL_RZ = 0.0_rp
526 real(RP) :: BBL_RX = 0.0_rp
527 real(RP) :: BBL_RY = 0.0_rp
529 namelist / param_bubble / &
538 real(RP) :: CZ_offset
539 real(RP) :: CX_offset
540 real(RP) :: CY_offset
541 real(RP) :: distx, disty, distz
543 real(RP) :: Domain_RX, Domain_RY
550 log_info(
"BUBBLE_setup",*)
'Setup' 556 log_info(
"BUBBLE_setup",*)
'Not found namelist. Default used.' 557 elseif( ierr > 0 )
then 558 log_error(
"BUBBLE_setup",*)
'Not appropriate names in namelist PARAM_BUBBLE. Check!' 561 log_nml(param_bubble)
563 if ( abs(bbl_rz*bbl_rx*bbl_ry) <= 0.0_rp )
then 564 log_info(
"BUBBLE_setup",*)
'no bubble' 565 bubble(:,:,:) = 0.0_rp
570 if ( bbl_eachnode )
then 574 domain_rx = fx(
ie) - fx(
is-1)
575 domain_ry = fy(
je) - fy(
js-1)
589 distz = ( (cz(k)-cz_offset-bbl_cz)/bbl_rz )**2
591 distx = min( ( (cx(i)-cx_offset-bbl_cx )/bbl_rx )**2, &
592 ( (cx(i)-cx_offset-bbl_cx-domain_rx)/bbl_rx )**2, &
593 ( (cx(i)-cx_offset-bbl_cx+domain_rx)/bbl_rx )**2 )
595 disty = min( ( (cy(j)-cy_offset-bbl_cy )/bbl_ry )**2, &
596 ( (cy(j)-cy_offset-bbl_cy-domain_ry)/bbl_ry )**2, &
597 ( (cy(j)-cy_offset-bbl_cy+domain_ry)/bbl_ry )**2 )
599 bubble(k,i,j) = cos( 0.5_rp*pi*sqrt( min(distz+distx+disty,1.0_rp) ) )**2
607 end subroutine bubble_setup
617 logical :: RCT_eachnode = .false.
618 real(RP) :: RCT_CZ = 2.e3_rp
619 real(RP) :: RCT_CX = 2.e3_rp
620 real(RP) :: RCT_CY = 2.e3_rp
621 real(RP) :: RCT_RZ = 2.e3_rp
622 real(RP) :: RCT_RX = 2.e3_rp
623 real(RP) :: RCT_RY = 2.e3_rp
625 namelist / param_rect / &
634 real(RP) :: CZ_offset
635 real(RP) :: CX_offset
636 real(RP) :: CY_offset
644 log_info(
"RECT_setup",*)
'Setup' 650 log_error(
"RECT_setup",*)
'Not found namelist. Check!' 652 elseif( ierr > 0 )
then 653 log_error(
"RECT_setup",*)
'Not appropriate names in namelist PARAM_RECT. Check!' 660 if ( rct_eachnode )
then 675 dist = 2.0_rp * max( &
676 abs(cz(k) - cz_offset - rct_cz)/rct_rz, &
677 abs(cx(i) - cx_offset - rct_cx)/rct_rx, &
678 abs(cy(j) - cy_offset - rct_cy)/rct_ry &
680 if ( dist <= 1.0_rp )
then 694 subroutine aerosol_setup
705 real(RP),
parameter :: d_min_def = 1.e-9_rp
706 real(RP),
parameter :: d_max_def = 1.e-5_rp
707 integer,
parameter :: n_kap_def = 1
708 real(RP),
parameter :: k_min_def = 0.e0_rp
709 real(RP),
parameter :: k_max_def = 1.e0_rp
711 real(RP) :: m0_init = 0.0_rp
712 real(RP) :: dg_init = 80.e-9_rp
713 real(RP) :: sg_init = 1.6_rp
715 real(RP) :: d_min_inp(3) = d_min_def
716 real(RP) :: d_max_inp(3) = d_max_def
717 real(RP) :: k_min_inp(3) = k_min_def
718 real(RP) :: k_max_inp(3) = k_max_def
719 integer :: n_kap_inp(3) = n_kap_def
721 namelist / param_aero / &
737 log_info(
"AEROSOL_setup",*)
'Setup' 743 log_info(
"AEROSOL_setup",*)
'Not found namelist. Default used!' 744 elseif( ierr > 0 )
then 745 log_error(
"AEROSOL_setup",*)
'Not appropriate names in namelist PARAM_AERO. Check!' 750 qdry(:,:,:) = 1.0_rp - qv(:,:,:) - qc(:,:,:)
770 end subroutine aerosol_setup
774 subroutine sbmaero_setup( convert_qtrc )
785 logical,
intent(inout) :: convert_qtrc
787 real(RP),
allocatable :: xabnd(:), xactr(:)
789 integer :: iq, i, j, k
798 qtrc(k,i,j,
i_qv) = qv(k,i,j) + qc(k,i,j)
804 if (
nccn /= 0 )
then 819 convert_qtrc = .false.
822 end subroutine sbmaero_setup
825 function faero( f0,r0,x,alpha,rhoa )
830 real(RP),
intent(in) :: x, f0, r0, alpha, rhoa
835 rad = ( exp(x) * 3.0_rp / 4.0_rp / pi / rhoa )**(1.0_rp/3.0_rp)
837 faero = f0 * (rad/r0)**(-alpha)
861 real(RP) :: FLX_rain = 0.0_rp
862 real(RP) :: FLX_snow = 0.0_rp
863 real(RP) :: FLX_IR_dn = 0.0_rp
864 real(RP) :: FLX_NIR_dn = 0.0_rp
865 real(RP) :: FLX_VIS_dn = 0.0_rp
867 namelist / param_mkinit_flux / &
880 read(
io_fid_conf,nml=param_mkinit_flux,iostat=ierr)
882 log_info(
"flux_setup",*)
'Not found namelist. Default used.' 883 elseif( ierr > 0 )
then 884 log_error(
"flux_setup",*)
'Not appropriate names in namelist PARAM_MKINIT_FLUX. Check!' 887 log_nml(param_mkinit_flux)
891 sflx_rain(i,j) = flx_rain
892 sflx_snow(i,j) = flx_snow
894 sflx_lw_up(i,j) = 0.0_rp
895 sflx_lw_dn(i,j) = flx_ir_dn
896 sflx_sw_up(i,j) = 0.0_rp
897 sflx_sw_dn(i,j) = flx_nir_dn + flx_vis_dn
899 toaflx_lw_up(i,j) = 0.0_rp
900 toaflx_lw_dn(i,j) = 0.0_rp
901 toaflx_sw_up(i,j) = 0.0_rp
902 toaflx_sw_dn(i,j) = 0.0_rp
927 real(RP) :: LND_WATER = 0.15_rp
929 real(RP) :: SFC_albedo_LW = 0.01_rp
930 real(RP) :: SFC_albedo_SW = 0.20_rp
932 namelist / param_mkinit_land / &
947 read(
io_fid_conf,nml=param_mkinit_land,iostat=ierr)
949 log_info(
"land_setup",*)
'Not found namelist. Default used.' 950 elseif( ierr > 0 )
then 951 log_error(
"land_setup",*)
'Not appropriate names in namelist PARAM_MKINIT_LAND. Check!' 954 log_nml(param_mkinit_land)
986 real(RP) :: OCN_SALT = 0.0_rp
987 real(RP) :: OCN_UVEL = 0.0_rp
988 real(RP) :: OCN_VVEL = 0.0_rp
990 real(RP) :: ICE_MASS = 0.0_rp
992 real(RP) :: SFC_albedo_LW = 0.04_rp
993 real(RP) :: SFC_albedo_SW = 0.05_rp
994 real(RP) :: SFC_Z0M = 1.e-4_rp
995 real(RP) :: SFC_Z0H = 1.e-4_rp
996 real(RP) :: SFC_Z0E = 1.e-4_rp
998 namelist / param_mkinit_ocean / &
1016 ice_temp = 271.35_rp
1021 read(
io_fid_conf,nml=param_mkinit_ocean,iostat=ierr)
1023 log_info(
"ocean_setup",*)
'Not found namelist. Default used.' 1024 elseif( ierr > 0 )
then 1025 log_error(
"ocean_setup",*)
'Not appropriate names in namelist PARAM_MKINIT_OCEAN. Check!' 1028 log_nml(param_mkinit_ocean)
1070 real(RP) :: URB_ROOF_TEMP
1071 real(RP) :: URB_BLDG_TEMP
1072 real(RP) :: URB_GRND_TEMP
1073 real(RP) :: URB_CNPY_TEMP
1074 real(RP) :: URB_CNPY_HMDT = 0.0_rp
1075 real(RP) :: URB_CNPY_WIND = 0.0_rp
1076 real(RP) :: URB_ROOF_LAYER_TEMP
1077 real(RP) :: URB_BLDG_LAYER_TEMP
1078 real(RP) :: URB_GRND_LAYER_TEMP
1079 real(RP) :: URB_ROOF_RAIN = 0.0_rp
1080 real(RP) :: URB_BLDG_RAIN = 0.0_rp
1081 real(RP) :: URB_GRND_RAIN = 0.0_rp
1082 real(RP) :: URB_RUNOFF = 0.0_rp
1083 real(RP) :: URB_SFC_TEMP
1084 real(RP) :: URB_ALB_LW = 0.10_rp
1085 real(RP) :: URB_ALB_SW = 0.20_rp
1087 namelist / param_mkinit_urban / &
1094 urb_roof_layer_temp, &
1095 urb_bldg_layer_temp, &
1096 urb_grnd_layer_temp, &
1108 urb_roof_temp = thetastd
1109 urb_bldg_temp = thetastd
1110 urb_grnd_temp = thetastd
1111 urb_cnpy_temp = thetastd
1112 urb_roof_layer_temp = thetastd
1113 urb_bldg_layer_temp = thetastd
1114 urb_grnd_layer_temp = thetastd
1115 urb_sfc_temp = thetastd
1119 read(
io_fid_conf,nml=param_mkinit_urban,iostat=ierr)
1121 log_info(
"urban_setup",*)
'Not found namelist. Default used.' 1122 elseif( ierr > 0 )
then 1123 log_error(
"urban_setup",*)
'Not appropriate names in namelist PARAM_MKINIT_URBAN. Check!' 1126 log_nml(param_mkinit_urban)
1162 real(RP) :: TKE_CONST
1164 namelist / param_mkinit_tke / &
1175 read(
io_fid_conf,nml=param_mkinit_tke,iostat=ierr)
1177 log_info(
"tke_setup",*)
'Not found namelist. Default used.' 1178 elseif( ierr > 0 )
then 1179 log_error(
"tke_setup",*)
'Not appropriate names in namelist PARAM_MKINIT_TKE. Check!' 1182 log_nml(param_mkinit_tke)
1184 if (
i_tke > 0 )
then 1193 if ( qs_bl > 0 )
then 1197 qtrc(k,i,j,qs_bl) = tke_const
1198 qtrc(k,i,j,qs_bl+1:qe_bl) = 0.0_rp
1210 DENS, VELX, VELY, POTT, QV )
1215 real(RP),
intent(out) :: DENS(
ka)
1216 real(RP),
intent(out) :: VELX(
ka)
1217 real(RP),
intent(out) :: VELY(
ka)
1218 real(RP),
intent(out) :: POTT(
ka)
1219 real(RP),
intent(out) :: QV (
ka)
1221 real(RP) :: TEMP(
ka)
1222 real(RP) :: PRES(
ka)
1225 character(len=H_LONG) :: ENV_IN_SOUNDING_file =
'' 1227 integer,
parameter :: EXP_klim = 100
1230 real(RP) :: SFC_THETA
1231 real(RP) :: SFC_PRES
1234 real(RP) :: EXP_z (exp_klim+1)
1235 real(RP) :: EXP_pott(exp_klim+1)
1236 real(RP) :: EXP_qv (exp_klim+1)
1237 real(RP) :: EXP_u (exp_klim+1)
1238 real(RP) :: EXP_v (exp_klim+1)
1240 real(RP) :: fact1, fact2
1245 namelist / param_mkinit_sounding / &
1246 env_in_sounding_file
1250 read(
io_fid_conf,nml=param_mkinit_sounding,iostat=ierr)
1253 log_info(
"read_sounding",*)
'Not found namelist. Default used.' 1254 elseif( ierr > 0 )
then 1255 log_error(
"read_sounding",*)
'Not appropriate names in namelist PARAM_MKINIT_SOUNDING. Check!' 1258 log_nml(param_mkinit_sounding)
1261 log_info(
"read_sounding",*)
'Input sounding file:', trim(env_in_sounding_file)
1264 file = trim(env_in_sounding_file), &
1265 form =
'formatted', &
1269 if ( ierr /= 0 )
then 1270 log_error(
"read_sounding",*)
'[mod_mkinit/read_sounding] Input file not found!' 1274 read(fid,*) sfc_pres, sfc_theta, sfc_qv
1276 log_info(
"read_sounding",*)
'+ Surface pressure [hPa]', sfc_pres
1277 log_info(
"read_sounding",*)
'+ Surface pot. temp [K]', sfc_theta
1278 log_info(
"read_sounding",*)
'+ Surface water vapor [g/kg]', sfc_qv
1281 read(fid,*,iostat=ierr) exp_z(k), exp_pott(k), exp_qv(k), exp_u(k), exp_v(k)
1282 if ( ierr /= 0 )
exit 1290 exp_pott(1) = sfc_theta
1294 exp_z(exp_kmax+1) = 100.e3_rp
1295 exp_pott(exp_kmax+1) = exp_pott(exp_kmax)
1296 exp_qv(exp_kmax+1) = exp_qv(exp_kmax)
1297 exp_u(exp_kmax+1) = exp_u(exp_kmax)
1298 exp_v(exp_kmax+1) = exp_v(exp_kmax)
1300 do k = 1, exp_kmax+1
1301 exp_qv(k) = exp_qv(k) * 1.e-3_rp
1305 pres_sfc(:,:) = sfc_pres * 1.e2_rp
1306 pott_sfc(:,:) = sfc_theta
1308 qv_sfc(:,:) = sfc_qv * 1.e-3_rp
1313 do kref = 2, exp_kmax+1
1314 if ( cz(k) > exp_z(kref-1) &
1315 .AND. cz(k) <= exp_z(kref ) )
then 1317 fact1 = ( exp_z(kref) - cz(k) ) / ( exp_z(kref)-exp_z(kref-1) )
1318 fact2 = ( cz(k) - exp_z(kref-1) ) / ( exp_z(kref)-exp_z(kref-1) )
1320 pott(k) = exp_pott(kref-1) * fact1 &
1321 + exp_pott(kref ) * fact2
1322 qv(k) = exp_qv(kref-1) * fact1 &
1323 + exp_qv(kref ) * fact2
1324 velx(k) = exp_u(kref-1) * fact1 &
1325 + exp_u(kref ) * fact2
1326 vely(k) = exp_v(kref-1) * fact1 &
1327 + exp_v(kref ) * fact2
1336 call hydrostatic_buildrho(
ka,
ks,
ke, &
1337 pott(:), qv(:), qc(:), &
1338 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
1340 dens(:), temp(:), pres(:), temp_sfc(1,1) )
1347 subroutine mkinit_planestate
1353 real(RP) :: SFC_THETA
1354 real(RP) :: SFC_PRES
1355 real(RP) :: SFC_RH = 0.0_rp
1357 real(RP) :: ENV_THETA
1358 real(RP) :: ENV_TLAPS = 0.0_rp
1359 real(RP) :: ENV_U = 0.0_rp
1360 real(RP) :: ENV_V = 0.0_rp
1361 real(RP) :: ENV_RH = 0.0_rp
1363 real(RP) :: RANDOM_THETA = 0.0_rp
1364 real(RP) :: RANDOM_U = 0.0_rp
1365 real(RP) :: RANDOM_V = 0.0_rp
1366 real(RP) :: RANDOM_RH = 0.0_rp
1368 namelist / param_mkinit_planestate / &
1387 log_info(
"MKINIT_planestate",*)
'Setup initial state' 1389 sfc_theta = thetastd
1391 env_theta = thetastd
1395 read(
io_fid_conf,nml=param_mkinit_planestate,iostat=ierr)
1398 log_info(
"MKINIT_planestate",*)
'Not found namelist. Default used.' 1399 elseif( ierr > 0 )
then 1400 log_error_cont(*)
'Not appropriate names in namelist PARAM_MKINIT_PLANESTATE. Check!' 1403 log_nml(param_mkinit_planestate)
1408 pott_sfc(i,j) = sfc_theta
1409 pres_sfc(i,j) = sfc_pres
1413 if ( env_theta < 0.0_rp )
then 1415 call profile_isa(
ka,
ks,
ke, &
1428 pott(k,i,j) = env_theta + env_tlaps * real_cz(k,i,j)
1437 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
1438 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
1439 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
1440 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
1447 qdry(:,:,:) = 1.0_rp - qv(:,:,:) - qc(:,:,:)
1449 temp(:,:,:), pres(:,:,:), qdry(:,:,:), &
1455 qsat_sfc(i,j) = epsvap * psat_sfc(i,j) / ( pres_sfc(i,j) - ( 1.0_rp-epsvap ) * psat_sfc(i,j) )
1456 qv_sfc(i,j) = ( sfc_rh + rndm(
ks-1,i,j) * random_rh ) * 1.e-2_rp * qsat_sfc(i,j)
1459 qv(k,i,j) = ( env_rh + rndm(k,i,j) * random_rh ) * 1.e-2_rp * qsat(k,i,j)
1468 pott_sfc(i,j) = pott_sfc(i,j) + rndm(
ks-1,i,j) * random_theta
1471 pott(k,i,j) = pott(k,i,j) + rndm(k,i,j) * random_theta
1478 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
1479 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
1480 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
1481 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
1483 call comm_vars8(
dens(:,:,:), 1 )
1484 call comm_wait (
dens(:,:,:), 1 )
1490 momx(k,i,j) = ( env_u + ( rndm(k,i,j) - 0.5_rp ) * 2.0_rp * random_u ) &
1491 * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
1500 momy(k,i,j) = ( env_v + ( rndm(k,i,j) - 0.5_rp ) * 2.0_rp * random_v ) &
1501 * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
1509 momz(k,i,j) = 0.0_rp
1510 rhot(k,i,j) = pott(k,i,j) *
dens(k,i,j)
1518 end subroutine mkinit_planestate
1522 subroutine mkinit_tracerbubble
1527 real(RP) :: SFC_THETA
1528 real(RP) :: SFC_PRES
1530 real(RP) :: ENV_THETA
1531 real(RP) :: ENV_U = 0.0_rp
1532 real(RP) :: ENV_V = 0.0_rp
1534 character(len=H_SHORT) :: SHAPE_NC =
'BUBBLE' 1535 real(RP) :: BBL_NC = 1.0_rp
1537 namelist / param_mkinit_tracerbubble / &
1546 real(RP),
pointer :: shapeFac(:,:,:) => null()
1553 log_info(
"MKINIT_tracerbubble",*)
'Setup initial state' 1555 sfc_theta = thetastd
1557 env_theta = thetastd
1561 read(
io_fid_conf,nml=param_mkinit_tracerbubble,iostat=ierr)
1564 log_info(
"MKINIT_tracerbubble",*)
'Not found namelist. Default used.' 1565 elseif( ierr > 0 )
then 1566 log_error(
"MKINIT_tracerbubble",*)
'Not appropriate names in namelist PARAM_MKINIT_TRACERBUBBLE. Check!' 1569 log_nml(param_mkinit_tracerbubble)
1572 pres_sfc(1,1) = sfc_pres
1573 pott_sfc(1,1) = sfc_theta
1576 pott(k,1,1) = env_theta
1580 call hydrostatic_buildrho(
ka,
ks,
ke, &
1581 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
1582 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
1584 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
1590 momz(k,i,j) = 0.0_rp
1593 rhot(k,i,j) = pott(k,1,1) *
dens(k,1,1)
1599 select case(shape_nc)
1607 log_error(
"MKINIT_tracerbubble",*)
'SHAPE_NC=', trim(shape_nc),
' cannot be used on advect. Check!' 1614 nc(k,i,j) = bbl_nc * shapefac(k,i,j)
1622 end subroutine mkinit_tracerbubble
1634 subroutine mkinit_coldbubble
1638 real(RP) :: SFC_THETA
1639 real(RP) :: SFC_PRES
1641 real(RP) :: ENV_THETA
1643 real(RP) :: BBL_TEMP = -15.0_rp
1645 namelist / param_mkinit_coldbubble / &
1658 log_info(
"MKINIT_coldbubble",*)
'Setup initial state' 1660 sfc_theta = thetastd
1662 env_theta = thetastd
1666 read(
io_fid_conf,nml=param_mkinit_coldbubble,iostat=ierr)
1669 log_info(
"MKINIT_coldbubble",*)
'Not found namelist. Default used.' 1670 elseif( ierr > 0 )
then 1671 log_error(
"MKINIT_coldbubble",*)
'Not appropriate names in namelist PARAM_MKINIT_COLDBUBBLE. Check!' 1674 log_nml(param_mkinit_coldbubble)
1676 rovcp = rdry / cpdry
1679 pres_sfc(1,1) = sfc_pres
1680 pott_sfc(1,1) = sfc_theta
1683 pott(k,1,1) = env_theta
1687 call hydrostatic_buildrho(
ka,
ks,
ke, &
1688 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
1689 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
1691 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
1697 momz(k,i,j) = 0.0_rp
1698 momx(k,i,j) = 0.0_rp
1699 momy(k,i,j) = 0.0_rp
1702 rhot(k,i,j) =
dens(k,1,1) * ( pott(k,1,1) &
1703 + bbl_temp * ( p00/pres(k,1,1) )**rovcp * bubble(k,i,j) )
1709 end subroutine mkinit_coldbubble
1713 subroutine mkinit_lambwave
1717 real(RP) :: SFC_PRES
1719 real(RP) :: ENV_U = 0.0_rp
1720 real(RP) :: ENV_V = 0.0_rp
1721 real(RP) :: ENV_TEMP = 300.0_rp
1723 real(RP) :: BBL_PRES = 100._rp
1725 namelist / param_mkinit_lambwave / &
1739 log_info(
"MKINIT_lambwave",*)
'Setup initial state' 1745 read(
io_fid_conf,nml=param_mkinit_lambwave,iostat=ierr)
1748 log_info(
"MKINIT_lambwave",*)
'Not found namelist. Default used.' 1749 elseif( ierr > 0 )
then 1750 log_error(
"MKINIT_lambwave",*)
'Not appropriate names in namelist PARAM_MKINIT_LAMBWAVE. Check!' 1753 log_nml(param_mkinit_lambwave)
1755 rovcp = rdry / cpdry
1760 dens(k,i,j) = sfc_pres/(rdry*env_temp) * exp( - grav/(rdry*env_temp) * cz(k) )
1761 momz(k,i,j) = 0.0_rp
1766 pres(k,i,j) =
dens(k,i,j) * env_temp * rdry + bbl_pres * bubble(k,i,j)
1768 rhot(k,i,j) =
dens(k,i,j) * env_temp * ( p00/pres(k,i,j) )**rovcp
1774 end subroutine mkinit_lambwave
1779 subroutine mkinit_gravitywave
1783 real(RP) :: SFC_THETA
1784 real(RP) :: SFC_PRES
1786 real(RP) :: ENV_U = 20.0_rp
1787 real(RP) :: ENV_V = 0.0_rp
1788 real(RP) :: ENV_BVF = 0.01_rp
1790 real(RP) :: BBL_THETA = 0.01_rp
1792 namelist / param_mkinit_gravitywave / &
1805 log_info(
"MKINIT_gravitywave",*)
'Setup initial state' 1807 sfc_theta = thetastd
1812 read(
io_fid_conf,nml=param_mkinit_gravitywave,iostat=ierr)
1815 log_info(
"MKINIT_gravitywave",*)
'Not found namelist. Default used.' 1816 elseif( ierr > 0 )
then 1817 log_error(
"MKINIT_gravitywave",*)
'Not appropriate names in namelist PARAM_MKINIT_GRAVITYWAVE. Check!' 1820 log_nml(param_mkinit_gravitywave)
1823 pres_sfc(1,1) = sfc_pres
1824 pott_sfc(1,1) = sfc_theta
1827 pott(k,1,1) = sfc_theta * exp( env_bvf*env_bvf / grav * cz(k) )
1831 call hydrostatic_buildrho(
ka,
ks,
ke, &
1832 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
1833 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
1835 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
1841 momz(k,i,j) = 0.0_rp
1846 rhot(k,i,j) =
dens(k,1,1) * ( pott(k,1,1) + bbl_theta * bubble(k,i,j) )
1853 end subroutine mkinit_gravitywave
1857 subroutine mkinit_khwave
1861 real(RP) :: SFC_THETA
1862 real(RP) :: SFC_PRES
1864 real(RP) :: ENV_L1_ZTOP = 1900.0_rp
1865 real(RP) :: ENV_L3_ZBOTTOM = 2100.0_rp
1866 real(RP) :: ENV_L1_THETA = 300.0_rp
1867 real(RP) :: ENV_L3_THETA = 301.0_rp
1868 real(RP) :: ENV_L1_U = 0.0_rp
1869 real(RP) :: ENV_L3_U = 20.0_rp
1871 real(RP) :: RANDOM_U = 0.0_rp
1873 namelist / param_mkinit_khwave / &
1891 log_info(
"MKINIT_khwave",*)
'Setup initial state' 1893 sfc_theta = thetastd
1898 read(
io_fid_conf,nml=param_mkinit_khwave,iostat=ierr)
1901 log_info(
"MKINIT_khwave",*)
'Not found namelist. Default used.' 1902 elseif( ierr > 0 )
then 1903 log_error(
"MKINIT_khwave",*)
'Not appropriate names in namelist PARAM_MKINIT_KHWAVE. Check!' 1906 log_nml(param_mkinit_khwave)
1909 pres_sfc(1,1) = sfc_pres
1910 pott_sfc(1,1) = sfc_theta
1913 fact = ( cz(k)-env_l1_ztop ) / ( env_l3_zbottom-env_l1_ztop )
1914 fact = max( min( fact, 1.0_rp ), 0.0_rp )
1916 pott(k,1,1) = env_l1_theta * ( 1.0_rp - fact ) &
1917 + env_l3_theta * ( fact )
1921 call hydrostatic_buildrho(
ka,
ks,
ke, &
1922 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
1923 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
1925 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
1931 momz(k,i,j) = 0.0_rp
1932 momy(k,i,j) = 0.0_rp
1933 rhot(k,i,j) =
dens(k,1,1) * pott(k,1,1)
1942 fact = ( cz(k)-env_l1_ztop ) / ( env_l3_zbottom-env_l1_ztop )
1943 fact = max( min( fact, 1.0_rp ), 0.0_rp )
1945 momx(k,i,j) = ( env_l1_u * ( 1.0_rp - fact ) &
1946 + env_l3_u * ( fact ) &
1947 + ( rndm(k,i,j) - 0.5_rp ) * 2.0_rp * random_u &
1954 end subroutine mkinit_khwave
1958 subroutine mkinit_turbulence
1964 real(RP) :: SFC_THETA
1965 real(RP) :: SFC_PRES
1966 real(RP) :: SFC_RH = 0.0_rp
1968 real(RP) :: ENV_THETA
1969 real(RP) :: ENV_TLAPS = 4.e-3_rp
1970 real(RP) :: ENV_U = 5.0_rp
1971 real(RP) :: ENV_V = 0.0_rp
1972 real(RP) :: ENV_RH = 0.0_rp
1974 real(RP) :: RANDOM_THETA = 1.0_rp
1975 real(RP) :: RANDOM_U = 0.0_rp
1976 real(RP) :: RANDOM_V = 0.0_rp
1977 real(RP) :: RANDOM_RH = 0.0_rp
1979 namelist / param_mkinit_turbulence / &
1998 log_info(
"MKINIT_turbulence",*)
'Setup initial state' 2000 sfc_theta = thetastd
2002 env_theta = thetastd
2006 read(
io_fid_conf,nml=param_mkinit_turbulence,iostat=ierr)
2009 log_info(
"MKINIT_turbulence",*)
'Not found namelist. Default used.' 2010 elseif( ierr > 0 )
then 2011 log_error(
"MKINIT_turbulence",*)
'Not appropriate names in namelist PARAM_MKINIT_TURBULENCE. Check!' 2014 log_nml(param_mkinit_turbulence)
2017 pres_sfc(1,1) = sfc_pres
2018 pott_sfc(1,1) = sfc_theta
2021 pott(k,1,1) = env_theta + env_tlaps * cz(k)
2025 call hydrostatic_buildrho(
ka,
ks,
ke, &
2026 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
2027 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
2029 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
2033 call saturation_psat_all( temp_sfc(1,1), &
2035 qdry(:,1,1) = 1.0_rp - qv(:,1,1) - qc(:,1,1)
2036 call saturation_pres2qsat_all(
ka,
ks,
ke, &
2037 temp(:,1,1), pres(:,1,1), qdry(:,1,1), &
2043 qsat_sfc(1,1) = epsvap * psat_sfc(i,j) / ( pres_sfc(i,j) - ( 1.0_rp-epsvap ) * psat_sfc(i,j) )
2044 qv_sfc(i,j) = ( sfc_rh + rndm(
ks-1,i,j) * random_rh ) * 1.e-2_rp * qsat_sfc(1,1)
2047 qv(k,i,j) = ( env_rh + rndm(k,i,j) * random_rh ) * 1.e-2_rp * qsat(k,1,1)
2056 pres_sfc(i,j) = sfc_pres
2057 pott_sfc(i,j) = sfc_theta + rndm(
ks-1,i,j) * random_theta
2060 pott(k,i,j) = env_theta + env_tlaps * cz(k) + rndm(k,i,j) * random_theta
2067 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
2068 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
2069 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
2070 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
2072 call comm_vars8(
dens(:,:,:), 1 )
2073 call comm_wait (
dens(:,:,:), 1 )
2079 momx(k,i,j) = ( env_u + ( rndm(k,i,j) - 0.5_rp ) * 2.0_rp * random_u ) &
2080 * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
2089 momy(k,i,j) = ( env_v + ( rndm(k,i,j) - 0.5_rp ) * 2.0_rp * random_v ) &
2090 * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
2098 momz(k,i,j) = 0.0_rp
2099 rhot(k,i,j) = pott(k,i,j) *
dens(k,i,j)
2105 end subroutine mkinit_turbulence
2109 subroutine mkinit_cavityflow
2113 real(RP) :: REYNOLDS_NUM = 1.d03
2114 real(RP) :: MACH_NUM = 3.d-2
2115 real(RP) :: Ulid = 1.d01
2116 real(RP) :: PRES0 = 1.d05
2118 namelist / param_mkinit_cavityflow / &
2134 log_info(
"MKINIT_cavityflow",*)
'Setup initial state' 2138 read(
io_fid_conf,nml=param_mkinit_cavityflow,iostat=ierr)
2141 log_info(
"MKINIT_cavityflow",*)
'Not found namelist. Default used.' 2142 elseif( ierr > 0 )
then 2143 log_error(
"MKINIT_cavityflow",*)
'Not appropriate names in namelist PARAM_MKINIT_CAVITYFLOW. Check!' 2146 log_nml(param_mkinit_cavityflow)
2148 gam = cpdry / ( cpdry - rdry )
2149 cs2 = ( ulid / mach_num )**2
2150 temp = cs2 / ( gam * rdry )
2151 dens0 = pres0 / ( rdry * temp )
2153 log_info(
"MKINIT_cavityflow",*)
"DENS = ", dens0
2154 log_info(
"MKINIT_cavityflow",*)
"PRES = ", pres0
2155 log_info(
"MKINIT_cavityflow",*)
"TEMP = ",
rhot(10,10,4)/dens0, temp
2156 log_info(
"MKINIT_cavityflow",*)
"Ulid = ", ulid
2157 log_info(
"MKINIT_cavityflow",*)
"Cs = ", sqrt(cs2)
2163 momz(k,i,j) = 0.0_rp
2164 momx(k,i,j) = 0.0_rp
2165 momy(k,i,j) = 0.0_rp
2167 rhot(k,i,j) = p00/rdry * (p00/pres0)**((rdry - cpdry)/cpdry)
2175 end subroutine mkinit_cavityflow
2179 subroutine mkinit_mountainwave
2183 real(RP) :: SFC_THETA
2184 real(RP) :: SFC_PRES
2186 real(RP) :: ENV_U = 0.0_rp
2187 real(RP) :: ENV_V = 0.0_rp
2189 real(RP) :: SCORER = 2.e-3_rp
2190 real(RP) :: BBL_NC = 0.0_rp
2192 namelist / param_mkinit_mountainwave / &
2200 real(RP) :: Ustar2, N2
2207 log_info(
"MKINIT_mountainwave",*)
'Setup initial state' 2209 sfc_theta = thetastd
2214 read(
io_fid_conf,nml=param_mkinit_mountainwave,iostat=ierr)
2217 log_info(
"MKINIT_mountainwave",*)
'Not found namelist. Default used.' 2218 elseif( ierr > 0 )
then 2219 log_error(
"MKINIT_mountainwave",*)
'Not appropriate names in namelist PARAM_MKINIT_MOUNTAINWAVE. Check!' 2222 log_nml(param_mkinit_mountainwave)
2227 pres_sfc(i,j) = sfc_pres
2228 pott_sfc(i,j) = sfc_theta
2235 ustar2 = env_u * env_u + env_v * env_v
2236 n2 = ustar2 * (scorer*scorer)
2238 pott(k,i,j) = sfc_theta * exp( n2 / grav * real_cz(k,i,j) )
2245 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
2246 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
2247 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
2248 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
2254 momz(k,i,j) = 0.0_rp
2257 rhot(k,i,j) = pott(k,i,j) *
dens(k,i,j)
2263 if ( bbl_nc > 0.0_rp )
then 2267 nc(k,i,j) = bbl_nc * bubble(k,i,j)
2274 end subroutine mkinit_mountainwave
2281 subroutine mkinit_barocwave
2299 real(RP) :: REF_TEMP = 288.e0_rp
2300 real(RP) :: REF_PRES = 1.e5_rp
2301 real(RP) :: LAPSE_RATE = 5.e-3_rp
2304 real(RP) :: Phi0Deg = 45.e0_rp
2307 real(RP) :: U0 = 35.e0_rp
2308 real(RP) :: b = 2.e0_rp
2312 real(RP) :: Up = 1.e0_rp
2313 real(RP) :: Lp = 600.e3_rp
2314 real(RP) :: Xc = 2000.e3_rp
2315 real(RP) :: Yc = 2500.e3_rp
2317 namelist / param_mkinit_barocwave / &
2318 ref_temp, ref_pres, lapse_rate, &
2323 real(RP) :: f0, beta0
2325 real(RP) :: geopot(
ka,
ia,
ja)
2326 real(RP) :: eta(
ka,
ia,
ja)
2327 real(RP) :: temp(
ka,
ia,
ja)
2333 real(RP) :: temp_vfunc
2334 real(RP) :: geopot_hvari
2341 integer,
parameter :: ITRMAX = 1000
2342 real(RP),
parameter :: CONV_EPS = 1e-15_rp
2346 log_info(
"MKINIT_barocwave",*)
'Setup initial state' 2350 read(
io_fid_conf,nml=param_mkinit_barocwave,iostat=ierr)
2353 log_info(
"MKINIT_barocwave",*)
'Not found namelist. Default used.' 2354 elseif( ierr > 0 )
then 2355 log_error(
"MKINIT_barocwave",*)
'Not appropriate names in namelist PARAM_MKINIT_BAROCWAVE. Check!' 2358 log_nml(param_mkinit_barocwave)
2363 f0 = 2.0_rp*ohm*sin(phi0deg*pi/180.0_rp)
2364 beta0 = (2.0_rp*ohm/rplanet)*cos(phi0deg*pi/180.0_rp)
2369 eta(:,:,:) = 1.0e-8_rp
2375 yphase = 2.0_rp*pi*y/ly
2378 geopot_hvari = 0.5_rp*u0*( &
2379 (f0 - beta0*y0)*(y - 0.5_rp*ly*(1.0_rp + sin(yphase)/pi)) &
2380 + 0.5_rp*beta0*( y**2 - ly*y/pi*sin(yphase) - 0.5_rp*(ly/pi)**2*(cos(yphase) + 1.0_rp) &
2385 pres_sfc(i,j) = ref_pres
2386 pott_sfc(i,j) = ref_temp - geopot_hvari/rdry
2393 do while( abs(del_eta) > conv_eps )
2394 ln_eta = log(eta(k,i,j))
2396 temp_vfunc = eta(k,i,j)**(rdry*lapse_rate/grav)
2398 ref_temp*temp_vfunc &
2399 + geopot_hvari/rdry*(2.0_rp*(ln_eta/b)**2 - 1.0_rp)*exp(-(ln_eta/b)**2)
2401 ref_temp*grav/lapse_rate*(1.0_rp - temp_vfunc) &
2402 + geopot_hvari*ln_eta*exp(-(ln_eta/b)**2)
2404 del_eta = - ( - grav*cz(k) + geopot(k,i,j) ) &
2405 & *( - eta(k,i,j)/(rdry*temp(k,i,j)) )
2407 eta(k,i,j) = eta(k,i,j) + del_eta
2410 if ( itr > itrmax )
then 2411 log_error(
"MKINIT_barocwave",*)
"Fail the convergence of iteration. Check!" 2412 log_error_cont(*)
"* (X,Y,Z)=", cx(i), cy(j), cz(k)
2413 log_error_cont(*)
"itr=", itr,
"del_eta=", del_eta,
"eta=", eta(k,i,j),
"temp=", temp(k,i,j)
2418 pres(k,i,j) = eta(k,i,j)*ref_pres
2419 dens(k,i,j) = pres(k,i,j)/(rdry*temp(k,i,j))
2420 pott(k,i,j) = temp(k,i,j)*eta(k,i,j)**(-rdry/cpdry)
2426 call hydrostatic_buildrho(
ka,
ks,
ke, &
2427 pott(:,i,j), qv(:,i,j), qc(:,i,j), &
2428 pres_sfc(i,j), pott_sfc(i,j), qv_sfc(i,j), qc_sfc(i,j), &
2429 real_cz(:,i,j), real_fz(:,i,j), &
2430 dens(:,i,j), temp(:,i,j), pres(:,i,j), temp_sfc(i,j) )
2439 eta(k,
is,j) = pres(k,
is,j)/ref_pres
2440 ln_eta = log(eta(k,
is,j))
2441 yphase = 2.0_rp*pi*cy(j)/ly
2445 pres(k,
is:
ie,j) = pres(k,
is,j)
2446 momx(k,
is-1:
ie,j) =
dens(k,
is,j)*(-u0*sin(0.5_rp*yphase)**2*ln_eta*exp(-(ln_eta/b)**2))
2450 momy(:,:,:) = 0.0_rp
2451 momz(:,:,:) = 0.0_rp
2459 +
dens(
ks:
ke,i,j)* up*exp( - ((fx(i) - xc)**2 + (cy(j) - yc)**2)/lp**2 )
2464 end subroutine mkinit_barocwave
2468 subroutine mkinit_warmbubble
2474 real(RP) :: SFC_THETA
2475 real(RP) :: SFC_PRES
2476 real(RP) :: SFC_RH = 80.0_rp
2478 real(RP) :: ENV_U = 0.0_rp
2479 real(RP) :: ENV_V = 0.0_rp
2480 real(RP) :: ENV_RH = 80.0_rp
2481 real(RP) :: ENV_L1_ZTOP = 1.e3_rp
2482 real(RP) :: ENV_L2_ZTOP = 14.e3_rp
2483 real(RP) :: ENV_L2_TLAPS = 4.e-3_rp
2484 real(RP) :: ENV_L3_TLAPS = 3.e-2_rp
2486 real(RP) :: BBL_THETA = 1.0_rp
2488 namelist / param_mkinit_warmbubble / &
2505 log_info(
"MKINIT_warmbubble",*)
'Setup initial state' 2508 log_error(
"MKINIT_warmbubble",*)
'QV is not registered' 2512 sfc_theta = thetastd
2517 read(
io_fid_conf,nml=param_mkinit_warmbubble,iostat=ierr)
2520 log_info(
"MKINIT_warmbubble",*)
'Not found namelist. Default used.' 2521 elseif( ierr > 0 )
then 2522 log_error(
"MKINIT_warmbubble",*)
'Not appropriate names in namelist PARAM_MKINIT_WARMBUBBLE. Check!' 2525 log_nml(param_mkinit_warmbubble)
2528 pres_sfc(1,1) = sfc_pres
2529 pott_sfc(1,1) = sfc_theta
2532 if ( cz(k) <= env_l1_ztop )
then 2533 pott(k,1,1) = sfc_theta
2534 elseif( cz(k) < env_l2_ztop )
then 2535 pott(k,1,1) = pott(k-1,1,1) + env_l2_tlaps * ( cz(k)-cz(k-1) )
2537 pott(k,1,1) = pott(k-1,1,1) + env_l3_tlaps * ( cz(k)-cz(k-1) )
2542 call hydrostatic_buildrho(
ka,
ks,
ke, &
2543 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
2544 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
2546 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
2549 call saturation_psat_all( temp_sfc(1,1), &
2551 qsat_sfc(1,1) = epsvap * psat_sfc(1,1) / ( pres_sfc(1,1) - ( 1.0_rp-epsvap ) * psat_sfc(1,1) )
2552 qv_sfc(1,1) = sfc_rh * 1.e-2_rp * qsat_sfc(1,1)
2553 qdry(:,1,1) = 1.0_rp - qv(:,1,1) - qc(:,1,1)
2554 call saturation_pres2qsat_all(
ka,
ks,
ke, &
2555 temp(:,1,1), pres(:,1,1), qdry(:,1,1), &
2558 if ( cz(k) <= env_l1_ztop )
then 2559 qv(k,1,1) = env_rh * 1.e-2_rp * qsat(k,1,1)
2560 elseif( cz(k) <= env_l2_ztop )
then 2561 qv(k,1,1) = env_rh * 1.e-2_rp * qsat(k,1,1)
2568 call hydrostatic_buildrho(
ka,
ks,
ke, &
2569 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
2570 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
2572 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
2578 momz(k,i,j) = 0.0_rp
2583 rhot(k,i,j) =
dens(k,1,1) * ( pott(k,1,1) + bbl_theta * bubble(k,i,j) )
2585 qv(k,i,j) = qv(k,1,1)
2593 end subroutine mkinit_warmbubble
2597 subroutine mkinit_supercell
2603 real(RP) :: VELX(
ka)
2604 real(RP) :: VELY(
ka)
2605 real(RP) :: POTT(
ka)
2606 real(RP) :: QV1D(
ka)
2609 real(RP) :: BBL_THETA = 3.d0
2611 namelist / param_mkinit_supercell / &
2619 log_info(
"MKINIT_supercell",*)
'Setup initial state' 2622 log_error(
"MKINIT_supercell",*)
'QV is not registered' 2628 read(
io_fid_conf,nml=param_mkinit_supercell,iostat=ierr)
2631 log_info(
"MKINIT_supercell",*)
'Not found namelist. Default used.' 2632 elseif( ierr > 0 )
then 2633 log_error(
"MKINIT_supercell",*)
'Not appropriate names in namelist PARAM_MKINIT_SUPERCELL. Check!' 2636 log_nml(param_mkinit_supercell)
2643 dens(k,i,j) = rho(k)
2644 momz(k,i,j) = 0.0_rp
2645 momx(k,i,j) = rho(k) * velx(k)
2646 momy(k,i,j) = rho(k) * vely(k)
2649 rhot(k,i,j) = rho(k) * ( pott(k) + bbl_theta * bubble(k,i,j) )
2659 end subroutine mkinit_supercell
2663 subroutine mkinit_squallline
2669 real(RP) :: VELX(
ka)
2670 real(RP) :: VELY(
ka)
2671 real(RP) :: POTT(
ka)
2672 real(RP) :: QV1D(
ka)
2674 real(RP) :: RANDOM_THETA = 0.01_rp
2675 real(RP) :: OFFSET_velx = 12.0_rp
2676 real(RP) :: OFFSET_vely = -2.0_rp
2678 namelist / param_mkinit_squallline / &
2688 log_info(
"MKINIT_squallline",*)
'Setup initial state' 2691 log_error(
"MKINIT_squallline",*)
'QV is not registered' 2697 read(
io_fid_conf,nml=param_mkinit_squallline,iostat=ierr)
2700 log_info(
"MKINIT_squallline",*)
'Not found namelist. Default used.' 2701 elseif( ierr > 0 )
then 2702 log_error(
"MKINIT_squallline",*)
'Not appropriate names in namelist PARAM_MKINIT_SQUALLLINE. Check!' 2705 log_nml(param_mkinit_squallline)
2713 dens(k,i,j) = rho(k)
2714 momz(k,i,j) = 0.0_rp
2715 momx(k,i,j) = ( velx(k) - offset_velx ) * rho(k)
2716 momy(k,i,j) = ( vely(k) - offset_vely ) * rho(k)
2717 rhot(k,i,j) = rho(k) * ( pott(k) + rndm(k,i,j) * random_theta )
2726 end subroutine mkinit_squallline
2730 subroutine mkinit_wk1982
2736 real(RP) :: SFC_THETA = 300.0_rp
2737 real(RP) :: SFC_PRES
2739 real(RP) :: TR_Z = 12000.0_rp
2740 real(RP) :: TR_THETA = 343.0_rp
2741 real(RP) :: TR_TEMP = 213.0_rp
2742 real(RP) :: SHEAR_Z = 3000.0_rp
2743 real(RP) :: SHEAR_U = 15.0_rp
2744 real(RP) :: QV0 = 14.0_rp
2746 real(RP) :: BBL_THETA = 3.d0
2748 namelist / param_mkinit_wk1982 / &
2759 real(RP) :: rh (
ka,
ia,
ja)
2760 real(RP) :: rh_sfc(
ia,
ja)
2767 log_info(
"MKINIT_wk1982",*)
'Setup initial state' 2770 log_error(
"MKINIT_wk1982",*)
'QV is not registered' 2777 read(
io_fid_conf,nml=param_mkinit_wk1982,iostat=ierr)
2779 log_info(
"MKINIT_wk1982",*)
'Not found namelist. Default used.' 2780 elseif( ierr > 0 )
then 2781 log_error(
"MKINIT_wk1982",*)
'Not appropriate names in namelist PARAM_MKINIT_WK1982. Check!' 2784 log_nml(param_mkinit_wk1982)
2789 pres_sfc(i,j) = sfc_pres
2790 pott_sfc(i,j) = sfc_theta
2793 if ( real_cz(k,i,j) <= tr_z )
then 2794 pott(k,i,j) = pott_sfc(i,j) &
2795 + ( tr_theta - pott_sfc(i,j) ) * ( real_cz(k,i,j) / tr_z )**1.25_rp
2797 pott(k,i,j) = tr_theta * exp( grav * ( real_cz(k,i,j) - tr_z ) / cpdry / tr_temp )
2805 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
2806 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
2807 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
2808 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
2813 rh_sfc(i,j) = 1.0_rp - 0.75_rp * ( real_fz(
ks-1,i,j) / tr_z )**1.25_rp
2816 if ( real_cz(k,i,j) <= tr_z )
then 2817 rh(k,i,j) = 1.0_rp - 0.75_rp * ( real_cz(k,i,j) / tr_z )**1.25_rp
2828 qdry(:,:,:) = 1.0_rp - qv(:,:,:) - qc(:,:,:)
2830 temp(:,:,:), pres(:,:,:), qdry(:,:,:), &
2834 qv0 = qv0 / ( 1.0_rp + qv0 )
2838 qsat_sfc(i,j) = epsvap * psat_sfc(i,j) / ( pres_sfc(i,j) - ( 1.0_rp-epsvap ) * psat_sfc(i,j) )
2839 qv_sfc(i,j) = min( rh_sfc(i,j) * qsat_sfc(i,j), qv0 )
2841 qv(k,i,j) = min( rh(k,i,j) * qsat(k,i,j), qv0 )
2848 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
2849 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
2850 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
2851 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
2854 log_info(
"MKINIT_wk1982",*) k, real_cz(k,
is,
js), pres(k,
is,
js), pott(k,
is,
js), rh(k,
is,
js), qv(k,
is,
js)*1000
2857 call comm_vars8(
dens(:,:,:), 1 )
2858 call comm_wait (
dens(:,:,:), 1 )
2863 momx(k,i,j) = shear_u * tanh( real_cz(k,i,j) / shear_z ) &
2864 * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
2872 momy(k,i,j) = 0.0_rp
2873 momz(k,i,j) = 0.0_rp
2874 rhot(k,i,j) = pott(k,i,j) *
dens(k,i,j)
2877 rhot(k,i,j) =
dens(k,i,j) * ( pott(k,i,j) + bbl_theta * bubble(k,i,j) )
2885 end subroutine mkinit_wk1982
2889 subroutine mkinit_dycoms2_rf01
2895 real(RP) :: PERTURB_AMP = 0.0_rp
2896 integer :: RANDOM_LIMIT = 5
2897 integer :: RANDOM_FLAG = 0
2900 logical :: USE_LWSET = .false.
2902 namelist / param_mkinit_rf01 / &
2908 real(RP) :: potl(
ka,
ia,
ja)
2909 real(RP) :: LHV (
ka,
ia,
ja)
2921 pi2 = atan(1.0_rp) * 2.0_rp
2924 log_info(
"MKINIT_DYCOMS2_RF01",*)
'Setup initial state' 2929 log_error(
"MKINIT_DYCOMS2_RF01",*)
'QV is not registered' 2933 read(
io_fid_conf,nml=param_mkinit_rf01,iostat=ierr)
2935 log_info(
"MKINIT_DYCOMS2_RF01",*)
'Not found namelist. Default used.' 2936 elseif( ierr > 0 )
then 2937 log_error(
"MKINIT_DYCOMS2_RF01",*)
'Not appropriate names in namelist PARAM_MKINIT_RF01. Check!' 2940 log_nml(param_mkinit_rf01)
2942 if ( use_lwset )
then 2952 pres_sfc(i,j) = 1017.8e2_rp
2953 pott_sfc(i,j) = 289.0_rp
2956 velx(k,i,j) = 7.0_rp
2957 vely(k,i,j) = -5.5_rp
2958 if ( cz(k) < 820.0_rp )
then 2959 potl(k,i,j) = 289.0_rp - grav / cpdry * cz(k) * geop_sw
2960 elseif( cz(k) <= 860.0_rp )
then 2961 sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
2962 potl(k,i,j) = ( 289.0_rp - grav / cpdry * cz(k) * geop_sw ) * (0.5_rp-sint) &
2963 + ( 297.5_rp+sign(abs(cz(k)-840.0_rp)**(1.0_rp/3.0_rp),cz(k)-840.0_rp) &
2964 - grav / cpdry * cz(k) * geop_sw ) * (0.5_rp+sint)
2966 potl(k,i,j) = 297.5_rp + ( cz(k)-840.0_rp )**(1.0_rp/3.0_rp) &
2967 - grav / cpdry * cz(k) * geop_sw
2976 potl(:,:,:), qv(:,:,:), qc(:,:,:), &
2977 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
2978 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
2979 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
2984 qv_sfc(i,j) = 9.0e-3_rp
2987 if ( cz(k) < 820.0_rp )
then 2989 elseif( cz(k) <= 860.0_rp )
then 2990 sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
2991 qall = 9.0e-3_rp * (0.5_rp-sint) &
2992 + 1.5e-3_rp * (0.5_rp+sint)
2993 elseif( cz(k) <= 5000.0_rp )
then 2999 if ( cz(k) <= 600.0_rp )
then 3001 elseif( cz(k) < 820.0_rp )
then 3002 fact = ( cz(k)-600.0_rp ) / ( 840.0_rp-600.0_rp )
3003 qc(k,i,j) = 0.45e-3_rp * fact
3004 elseif( cz(k) <= 860.0_rp )
then 3005 sint = sin( pi2 * ( cz(k)-840.0_rp ) / 20.0_rp ) * 0.5_rp
3006 fact = ( cz(k)-600.0_rp ) / ( 840.0_rp-600.0_rp )
3007 qc(k,i,j) = 0.45e-3_rp * fact * (0.5_rp-sint)
3012 qv(k,i,j) = qall - qc(k,i,j)
3019 temp(:,:,:), lhv(:,:,:) )
3024 temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
3031 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
3032 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3033 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3034 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3043 call comm_vars8(
dens(:,:,:), 1 )
3044 call comm_wait (
dens(:,:,:), 1 )
3050 if ( random_flag == 2 .and. k <= random_limit )
then 3051 momz(k,i,j) = ( 2.0_rp * ( rndm(k,i,j)-0.5_rp ) * perturb_amp ) &
3052 * 0.5_rp * (
dens(k+1,i,j) +
dens(k,i,j) )
3054 momz(k,i,j) = 0.0_rp
3064 if ( random_flag == 2 .AND. k <= random_limit )
then 3065 momx(k,i,j) = ( velx(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.5_rp ) * perturb_amp ) &
3066 * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
3068 momx(k,i,j) = velx(k,i,j) * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
3078 if ( random_flag == 2 .AND. k <= random_limit )
then 3079 momy(k,i,j) = ( vely(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.5_rp ) * perturb_amp ) &
3080 * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
3082 momy(k,i,j) = vely(k,i,j) * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
3092 if ( random_flag == 1 .and. k <= random_limit )
then 3093 rhot(k,i,j) = ( pott(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.5_rp ) * perturb_amp ) &
3096 rhot(k,i,j) = pott(k,i,j) *
dens(k,i,j)
3105 if ( qc(k,i,j) > 0.0_rp )
then 3106 nc(k,i,j) = 120.e6_rp /
dens(k,i,j)
3114 end subroutine mkinit_dycoms2_rf01
3118 subroutine mkinit_dycoms2_rf02
3124 real(RP) :: PERTURB_AMP = 0.0_rp
3125 integer :: RANDOM_LIMIT = 5
3126 integer :: RANDOM_FLAG = 0
3130 namelist / param_mkinit_rf02 / &
3135 real(RP) :: potl(
ka,
ia,
ja)
3136 real(RP) :: LHV (
ka,
ia,
ja)
3147 pi2 = atan(1.0_rp) * 2.0_rp
3149 log_info(
"MKINIT_DYCOMS2_RF02",*)
'Setup initial state' 3152 log_error(
"MKINIT_DYCOMS2_RF02",*)
'QV is not registered' 3157 read(
io_fid_conf,nml=param_mkinit_rf02,iostat=ierr)
3159 log_info(
"MKINIT_DYCOMS2_RF02",*)
'Not found namelist. Default used.' 3160 elseif( ierr > 0 )
then 3161 log_error(
"MKINIT_DYCOMS2_RF02",*)
'Not appropriate names in namelist PARAM_MKINIT_RF02. Check!' 3164 log_nml(param_mkinit_rf02)
3171 pres_sfc(i,j) = 1017.8e2_rp
3172 pott_sfc(i,j) = 288.3_rp
3175 velx(k,i,j) = 3.0_rp + 4.3 * cz(k)*1.e-3_rp
3176 vely(k,i,j) = -9.0_rp + 5.6 * cz(k)*1.e-3_rp
3178 if ( cz(k) < 775.0_rp )
then 3179 potl(k,i,j) = 288.3_rp
3180 else if ( cz(k) <= 815.0_rp )
then 3181 sint = sin( pi2 * (cz(k) - 795.0_rp)/20.0_rp )
3182 potl(k,i,j) = 288.3_rp * (1.0_rp-sint)*0.5_rp &
3183 + ( 295.0_rp+sign(abs(cz(k)-795.0_rp)**(1.0_rp/3.0_rp),cz(k)-795.0_rp) ) &
3184 * (1.0_rp+sint)*0.5_rp
3186 potl(k,i,j) = 295.0_rp + ( cz(k)-795.0_rp )**(1.0_rp/3.0_rp)
3194 potl(:,:,:), qv(:,:,:), qc(:,:,:), &
3195 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3196 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3197 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3202 qv_sfc(i,j) = 9.45e-3_rp
3205 if ( cz(k) < 775.0_rp )
then 3207 else if ( cz(k) <= 815.0_rp )
then 3208 sint = sin( pi2 * (cz(k) - 795.0_rp)/20.0_rp )
3209 qall = 9.45e-3_rp * (1.0_rp-sint)*0.5_rp + &
3210 ( 5.e-3_rp - 3.e-3_rp * ( 1.0_rp - exp( (795.0_rp-cz(k))/500.0_rp ) ) ) * (1.0_rp+sint)*0.5_rp
3212 qall = 5.e-3_rp - 3.e-3_rp * ( 1.0_rp - exp( (795.0_rp-cz(k))/500.0_rp ) )
3215 if( cz(k) < 400.0_rp )
then 3217 elseif( cz(k) < 775.0_rp )
then 3218 fact = ( cz(k)-400.0_rp ) / ( 795.0_rp-400.0_rp )
3219 qc(k,i,j) = 0.65e-3_rp * fact
3220 elseif( cz(k) <= 815.0_rp )
then 3221 sint = sin( pi2 * ( cz(k)-795.0_rp )/20.0_rp )
3222 fact = ( cz(k)-400.0_rp ) / ( 795.0_rp-400.0_rp )
3223 qc(k,i,j) = 0.65e-3_rp * fact * (1.0_rp-sint) * 0.5_rp
3227 qv(k,i,j) = qall - qc(k,i,j)
3234 temp(:,:,:), lhv(:,:,:) )
3239 temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
3246 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
3247 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3248 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3249 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3258 call comm_vars8(
dens(:,:,:), 1 )
3259 call comm_wait (
dens(:,:,:), 1 )
3265 if( random_flag == 2 .and. k <= random_limit )
then 3266 momz(k,i,j) = ( 0.0_rp + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp ) &
3267 * 0.5_rp * (
dens(k+1,i,j) +
dens(k,i,j) )
3269 momz(k,i,j) = 0.0_rp
3279 if( random_flag == 2 .and. k <= random_limit )
then 3280 momx(k,i,j) = ( velx(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp ) &
3281 * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
3283 momx(k,i,j) = ( velx(k,i,j) ) * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
3293 if( random_flag == 2 .and. k <= random_limit )
then 3294 momy(k,i,j) = ( vely(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp ) &
3295 * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
3297 momy(k,i,j) = vely(k,i,j) * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
3307 if( random_flag == 1 .and. k <= random_limit )
then 3308 rhot(k,i,j) = ( pott(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp ) &
3311 rhot(k,i,j) = pott(k,i,j) *
dens(k,i,j)
3320 if ( qc(k,i,j) > 0.0_rp )
then 3321 nc(k,i,j) = 55.0e6_rp /
dens(k,i,j)
3329 end subroutine mkinit_dycoms2_rf02
3333 subroutine mkinit_dycoms2_rf02_dns
3339 real(RP) :: ZB = 750.0_rp
3341 real(RP) :: CONST_U = 0.0_rp
3342 real(RP) :: CONST_V = 0.0_rp
3343 real(RP) :: PRES_ZB = 93060.0_rp
3344 real(RP) :: PERTURB_AMP = 0.0_rp
3345 integer :: RANDOM_LIMIT = 5
3346 integer :: RANDOM_FLAG = 0
3350 namelist / param_mkinit_rf02_dns / &
3351 zb, const_u, const_v,pres_zb,&
3356 real(RP) :: potl(
ka,
ia,
ja)
3357 real(RP) :: LHV (
ka,
ia,
ja)
3368 pi2 = atan(1.0_rp) * 2.0_rp
3371 log_info(
"MKINIT_DYCOMS2_RF02_DNS",*)
'Setup initial state' 3374 log_error(
"MKINIT_DYCOMS2_RF02_DNS",*)
'QV is not registered' 3379 read(
io_fid_conf,nml=param_mkinit_rf02_dns,iostat=ierr)
3381 log_info(
"MKINIT_DYCOMS2_RF02_DNS",*)
'Not found namelist. Default used.' 3382 elseif( ierr > 0 )
then 3383 log_error(
"MKINIT_DYCOMS2_RF02_DNS",*)
'Not appropriate names in namelist PARAM_MKINIT_RF02_DNS. Check!' 3386 log_nml(param_mkinit_rf02_dns)
3393 pres_sfc(i,j) = pres_zb
3399 velx(k,i,j) = const_u
3400 vely(k,i,j) = const_v
3403 if ( zb+cz(k) <= 795.0_rp )
then 3404 potl(k,i,j) = 288.3_rp
3414 potl(k,i,j) = 295.0_rp + ( zb+cz(k)-795.0_rp )**(1.0_rp/3.0_rp)
3415 qall = 5.e-3_rp - 3.e-3_rp * ( 1.0_rp - exp( (795.0_rp-(zb+cz(k)))/500.0_rp ) )
3418 if( zb+cz(k) < 400.0_rp )
then 3420 elseif( zb+cz(k) <= 795.0_rp )
then 3421 fact = ( (zb+cz(k))-400.0_rp ) / ( 795.0_rp-400.0_rp )
3422 qc(k,i,j) = 0.8e-3_rp * fact
3426 qv(k,i,j) = qall - qc(k,i,j)
3435 pott_sfc(:,:) = potl(
ks,:,:)-0.5*(potl(
ks+1,:,:)-potl(
ks,:,:))
3436 qv_sfc(:,:) = qv(
ks,:,:)-0.5*(qv(
ks+1,:,:)-qv(
ks,:,:))
3437 qc_sfc(:,:) = qc(
ks,:,:)-0.5*(qc(
ks+1,:,:)-qc(
ks,:,:))
3441 potl(:,:,:), qv(:,:,:), qc(:,:,:), &
3442 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3443 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3444 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3447 temp(:,:,:), lhv(:,:,:) )
3449 rovcp = rdry / cpdry
3453 pott(k,i,j) = potl(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) * ( p00/pres(k,i,j) )**rovcp
3460 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
3461 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3462 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3463 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3472 call comm_vars8(
dens(:,:,:), 1 )
3473 call comm_wait (
dens(:,:,:), 1 )
3479 if( random_flag == 2 .and. k <= random_limit )
then 3480 momz(k,i,j) = ( 0.0_rp + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp ) &
3481 * 0.5_rp * (
dens(k+1,i,j) +
dens(k,i,j) )
3483 momz(k,i,j) = 0.0_rp
3494 if( random_flag == 2 .and. k <= random_limit )
then 3495 momx(k,i,j) = ( velx(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp ) &
3496 * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
3498 momx(k,i,j) = ( velx(k,i,j) ) * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
3509 if( random_flag == 2 .and. k <= random_limit )
then 3510 momy(k,i,j) = ( vely(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp ) &
3511 * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
3513 momy(k,i,j) = vely(k,i,j) * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
3523 if( random_flag == 1 .and. k <= random_limit )
then 3524 rhot(k,i,j) = ( pott(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp ) &
3527 rhot(k,i,j) = pott(k,i,j) *
dens(k,i,j)
3536 if ( qc(k,i,j) > 0.0_rp )
then 3537 nc(k,i,j) = 55.0e6_rp /
dens(k,i,j)
3545 end subroutine mkinit_dycoms2_rf02_dns
3549 subroutine mkinit_rico
3555 real(RP):: PERTURB_AMP_PT = 0.1_rp
3556 real(RP):: PERTURB_AMP_QV = 2.5e-5_rp
3558 namelist / param_mkinit_rico / &
3562 real(RP) :: LHV (
ka,
ia,
ja)
3563 real(RP) :: potl(
ka,
ia,
ja)
3572 log_info(
"MKINIT_RICO",*)
'Setup initial state' 3575 log_error(
"MKINIT_RICO",*)
'QV is not registered' 3580 read(
io_fid_conf,nml=param_mkinit_rico,iostat=ierr)
3582 log_info(
"MKINIT_RICO",*)
'Not found namelist. Default used.' 3583 elseif( ierr > 0 )
then 3584 log_error(
"MKINIT_RICO",*)
'Not appropriate names in namelist PARAM_MKINIT_RICO. Check!' 3587 log_nml(param_mkinit_rico)
3593 pres_sfc(i,j) = 1015.4e2_rp
3594 pott_sfc(i,j) = 297.9_rp
3598 if ( cz(k) < 740.0_rp )
then 3599 potl(k,i,j) = 297.9_rp
3601 fact = ( cz(k)-740.0_rp ) * ( 317.0_rp-297.9_rp ) / ( 4000.0_rp-740.0_rp )
3602 potl(k,i,j) = 297.9_rp + fact
3606 if ( cz(k) <= 4000.0_rp )
then 3607 fact = ( cz(k)-0.0_rp ) * ( -1.9_rp+9.9_rp ) / ( 4000.0_rp-0.0_rp )
3608 velx(k,i,j) = -9.9_rp + fact
3609 vely(k,i,j) = -3.8_rp
3611 velx(k,i,j) = -1.9_rp
3612 vely(k,i,j) = -3.8_rp
3621 potl(:,:,:), qv(:,:,:), qc(:,:,:), &
3622 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3623 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3624 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3629 qv_sfc(i,j) = 16.0e-3_rp
3633 if ( cz(k) <= 740.0_rp )
then 3634 fact = ( cz(k)-0.0_rp ) * ( 13.8e-3_rp-16.0e-3_rp ) / ( 740.0_rp-0.0_rp )
3635 qall = 16.0e-3_rp + fact
3636 elseif ( cz(k) <= 3260.0_rp )
then 3637 fact = ( cz(k)-740.0_rp ) * ( 2.4e-3_rp-13.8e-3_rp ) / ( 3260.0_rp-740.0_rp )
3638 qall = 13.8e-3_rp + fact
3639 elseif( cz(k) <= 4000.0_rp )
then 3640 fact = ( cz(k)-3260.0_rp ) * ( 1.8e-3_rp-2.4e-3_rp ) / ( 4000.0_rp-3260.0_rp )
3641 qall = 2.4e-3_rp + fact
3646 qv(k,i,j) = qall - qc(k,i,j)
3653 temp(:,:,:), lhv(:,:,:) )
3658 temp(k,i,j) = temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j)
3665 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
3666 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3667 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3668 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3678 call comm_vars8(
dens(:,:,:), 1 )
3679 call comm_wait (
dens(:,:,:), 1 )
3684 momz(k,i,j) = 0.0_rp
3692 momx(k,i,j) = velx(k,i,j) * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
3700 momy(k,i,j) = vely(k,i,j) * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
3709 rhot(k,i,j) = ( pott(k,i,j)+2.0_rp*( rndm(k,i,j)-0.5_rp )*perturb_amp_pt ) *
dens(k,i,j)
3718 qv(k,i,j) = qv(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp_qv
3726 if ( qc(k,i,j) > 0.0_rp )
then 3727 nc(k,i,j) = 70.e6_rp /
dens(k,i,j)
3735 end subroutine mkinit_rico
3739 subroutine mkinit_bomex
3751 real(RP):: PERTURB_AMP_PT = 0.1_rp
3752 real(RP):: PERTURB_AMP_QV = 2.5e-5_rp
3754 namelist / param_mkinit_bomex / &
3758 real(RP) :: LHV (
ka,
ia,
ja)
3759 real(RP) :: potl(
ka,
ia,
ja)
3763 real(RP) :: qdry, Rtot, CPtot
3770 log_info(
"MKINIT_BOMEX",*)
'Setup initial state' 3773 log_error(
"MKINIT_BOMEX",*)
'QV is not registered' 3778 read(
io_fid_conf,nml=param_mkinit_bomex,iostat=ierr)
3780 log_info(
"MKINIT_BOMEX",*)
'Not found namelist. Default used.' 3781 elseif( ierr > 0 )
then 3782 log_error(
"MKINIT_BOMEX",*)
'Not appropriate names in namelist PARAM_MKINIT_BOMEX. Check!' 3785 log_nml(param_mkinit_bomex)
3791 pres_sfc(i,j) = 1015.e2_rp
3792 pott_sfc(i,j) = 299.1_rp
3796 if ( cz(k) < 520.0_rp )
then 3797 potl(k,i,j) = 298.7_rp
3798 elseif( cz(k) < 1480.0_rp )
then 3799 fact = ( cz(k)-520.0_rp ) * ( 302.4_rp-298.7_rp ) / ( 1480.0_rp-520.0_rp )
3800 potl(k,i,j) = 298.7_rp + fact
3801 elseif( cz(k) < 2000.0_rp )
then 3802 fact = ( cz(k)-1480.0_rp ) * ( 308.2_rp-302.4_rp ) / ( 2000.0_rp-1480.0_rp )
3803 potl(k,i,j) = 302.4_rp + fact
3805 fact = ( cz(k)-2000.0_rp ) * 3.65e-3_rp
3806 potl(k,i,j) = 308.2_rp + fact
3810 if ( cz(k) <= 700.0_rp )
then 3811 velx(k,i,j) = -8.75_rp
3812 vely(k,i,j) = 0.0_rp
3814 fact = 1.8e-3_rp * ( cz(k)-700.0_rp )
3815 velx(k,i,j) = -8.75_rp + fact
3816 vely(k,i,j) = 0.0_rp
3825 potl(:,:,:), qv(:,:,:), qc(:,:,:), &
3826 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3827 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3828 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3833 qv_sfc(i,j) = 22.45e-3_rp
3837 if ( cz(k) <= 520.0_rp )
then 3838 fact = ( cz(k)-0.0_rp ) * ( 16.3e-3_rp-17.0e-3_rp ) / ( 520.0_rp-0.0_rp )
3839 qall = 17.0e-3_rp + fact
3840 elseif ( cz(k) <= 1480.0_rp )
then 3841 fact = ( cz(k)-520.0_rp ) * ( 10.7e-3_rp-16.3e-3_rp ) / ( 1480.0_rp-520.0_rp )
3842 qall = 16.3e-3_rp + fact
3843 elseif( cz(k) <= 2000.0_rp )
then 3844 fact = ( cz(k)-1480.0_rp ) * ( 4.2e-3_rp-10.7e-3_rp ) / ( 2000.0_rp-1480.0_rp )
3845 qall = 10.7e-3_rp + fact
3847 fact = ( cz(k)-2000.0_rp ) * ( -1.2e-6_rp )
3848 qall = 4.2e-3_rp + fact
3851 qv(k,i,j) = qall - qc(k,i,j)
3858 temp(:,:,:), lhv(:,:,:) )
3863 qdry = 1.0_rp - qv(k,i,j) - qc(k,i,j)
3864 rtot = rdry * qdry + rvap * qv(k,i,j)
3865 cptot = cpdry * qdry + cpvap * qv(k,i,j) + cl * qc(k,i,j)
3866 pott(k,i,j) = ( temp(k,i,j) + lhv(k,i,j) / cpdry * qc(k,i,j) ) * ( p00 / pres(k,i,j) )**(rtot/cptot)
3873 pott(:,:,:), qv(:,:,:), qc(:,:,:), &
3874 pres_sfc(:,:), pott_sfc(:,:), qv_sfc(:,:), qc_sfc(:,:), &
3875 real_cz(:,:,:), real_fz(:,:,:), area(:,:), &
3876 dens(:,:,:), temp(:,:,:), pres(:,:,:), temp_sfc(:,:) )
3886 call comm_vars8(
dens(:,:,:), 1 )
3887 call comm_wait (
dens(:,:,:), 1 )
3892 momz(k,i,j) = 0.0_rp
3900 momx(k,i,j) = velx(k,i,j) * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
3908 momy(k,i,j) = vely(k,i,j) * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
3917 if( cz(k) <= 1600.0_rp )
then 3918 rhot(k,i,j) = ( pott(k,i,j)+2.0_rp*( rndm(k,i,j)-0.5_rp )*perturb_amp_pt ) *
dens(k,i,j)
3920 rhot(k,i,j) = pott(k,i,j) *
dens(k,i,j)
3930 if( cz(k) <= 1600.0_rp )
then 3931 qv(k,i,j) = qv(k,i,j) + 2.0_rp * ( rndm(k,i,j)-0.50_rp ) * perturb_amp_qv
3940 if ( qc(k,i,j) > 0.0_rp )
then 3941 nc(k,i,j) = 70.e6_rp /
dens(k,i,j)
3949 end subroutine mkinit_bomex
3953 subroutine mkinit_oceancouple
3957 log_info(
"MKINIT_oceancouple",*)
'Setup initial state' 3964 end subroutine mkinit_oceancouple
3968 subroutine mkinit_landcouple
3972 log_info(
"MKINIT_landcouple",*)
'Setup initial state' 3979 end subroutine mkinit_landcouple
3983 subroutine mkinit_urbancouple
3987 log_info(
"MKINIT_urbancouple",*)
'Setup initial state' 3994 end subroutine mkinit_urbancouple
3998 subroutine mkinit_seabreeze
4010 real(RP) :: LAND_SIZE
4012 namelist / param_mkinit_seabreeze / &
4020 log_info(
"MKINIT_seabreeze",*)
'Setup initial state' 4026 read(
io_fid_conf,nml=param_mkinit_seabreeze,iostat=ierr)
4029 log_info(
"MKINIT_seabreeze",*)
'Not found namelist. Default used.' 4030 elseif( ierr > 0 )
then 4031 log_error(
"MKINIT_seabreeze",*)
'Not appropriate names in namelist PARAM_MKINIT_SEABREEZE. Check!' 4034 log_nml(param_mkinit_seabreeze)
4045 if ( abs( cx(i) - domain_center_x ) < land_size )
then 4061 end subroutine mkinit_seabreeze
4065 subroutine mkinit_heatisland
4082 log_info(
"MKINIT_heatisland",*)
'Setup initial state' 4096 if ( cx(i) >= dist * 4.0_rp &
4097 .AND. cx(i) < dist * 5.0_rp )
then 4115 end subroutine mkinit_heatisland
4119 subroutine mkinit_grayzone
4125 real(RP) :: VELX(
ka)
4126 real(RP) :: VELY(
ka)
4127 real(RP) :: POTT(
ka)
4128 real(RP) :: QV1D(
ka)
4130 real(RP) :: PERTURB_AMP = 0.0_rp
4131 integer :: RANDOM_LIMIT = 0
4132 integer :: RANDOM_FLAG = 0
4136 namelist / param_mkinit_grayzone / &
4146 log_info(
"MKINIT_grayzone",*)
'Setup initial state' 4149 log_error(
"MKINIT_grayzone",*)
'QV is not registered' 4155 read(
io_fid_conf,nml=param_mkinit_grayzone,iostat=ierr)
4158 log_info(
"MKINIT_grayzone",*)
'Not found namelist. Default used.' 4159 elseif( ierr > 0 )
then 4160 log_error(
"MKINIT_grayzone",*)
'Not appropriate names in namelist PARAM_MKINIT_GRAYZONE. Check!' 4163 log_nml(param_mkinit_grayzone)
4172 dens(k,i,j) = rho(k)
4194 if ( random_flag == 2 .and. k <= random_limit )
then 4195 momz(k,i,j) = ( 2.0_rp * ( rndm(k,i,j)-0.5_rp ) * perturb_amp ) &
4196 * 0.5_rp * (
dens(k+1,i,j) +
dens(k,i,j) )
4198 momz(k,i,j) = 0.0_rp
4208 if ( random_flag == 2 .AND. k <= random_limit )
then 4209 momx(k,i,j) = ( velx(k) + 2.0_rp * ( rndm(k,i,j)-0.5_rp ) * perturb_amp ) &
4210 * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
4212 momx(k,i,j) = velx(k) * 0.5_rp * (
dens(k,i+1,j) +
dens(k,i,j) )
4222 if ( random_flag == 2 .AND. k <= random_limit )
then 4223 momy(k,i,j) = ( vely(k) + 2.0_rp * ( rndm(k,i,j)-0.5_rp ) * perturb_amp ) &
4224 * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
4226 momy(k,i,j) = vely(k) * 0.5_rp * (
dens(k,i,j+1) +
dens(k,i,j) )
4236 if ( random_flag == 1 .and. k <= random_limit )
then 4237 rhot(k,i,j) = ( pott(k) + 2.0_rp * ( rndm(k,i,j)-0.5_rp ) * perturb_amp ) &
4240 rhot(k,i,j) = pott(k) *
dens(k,i,j)
4247 end subroutine mkinit_grayzone
4251 subroutine mkinit_boxaero
4262 atmos_thermodyn_rhot2temp_pres
4267 real(RP) :: init_dens = 1.12_rp
4268 real(RP) :: init_temp = 298.18_rp
4269 real(RP) :: init_pres = 1.e+5_rp
4270 real(RP) :: init_ssliq = 0.01_rp
4272 namelist / param_mkinit_boxaero / &
4278 real(RP) :: rtot (
ka,
ia,
ja)
4279 real(RP) :: cvtot(
ka,
ia,
ja)
4280 real(RP) :: cptot(
ka,
ia,
ja)
4282 real(RP) :: psat, qsat
4283 integer :: i, j, k, ierr
4287 log_info(
"MKINIT_boxaero",*)
'For [Box model of aerosol],' 4288 log_info(
"MKINIT_boxaero",*)
'ATMOS_PHY_AE_TYPE should be KAJINO13. Stop! ', trim(
atmos_phy_ae_type)
4293 log_error(
"MKINIT_boxaero",*)
'QV is not registered' 4298 log_info(
"MKINIT_boxaero",*)
'Setup initial state' 4302 read(
io_fid_conf,nml=param_mkinit_boxaero,iostat=ierr)
4304 log_info(
"MKINIT_boxaero",*)
'Not found namelist. Default used.' 4305 elseif( ierr > 0 )
then 4306 log_error(
"MKINIT_boxaero",*)
'Not appropriate names in namelist PARAM_MKINIT_BOXAERO. Check!' 4309 log_nml(param_mkinit_boxaero)
4311 call saturation_psat_all( init_temp, psat )
4312 qsat = epsvap * psat / ( init_pres - ( 1.0_rp-epsvap ) * psat )
4317 dens(k,i,j) = init_dens
4318 momx(k,i,j) = 0.0_rp
4319 momy(k,i,j) = 0.0_rp
4320 momz(k,i,j) = 0.0_rp
4321 pott(k,i,j) = init_temp * ( p00/init_pres )**(rdry/cpdry)
4322 rhot(k,i,j) = init_dens * pott(k,i,j)
4324 qv(k,i,j) = ( init_ssliq + 1.0_rp ) * qsat
4326 qdry = 1.0 - qv(k,i,j)
4327 rtot(k,i,j) = rdry * qdry + rvap * qv(i,i,j)
4328 cvtot(k,i,j) = cvdry * qdry + cvvap * qv(i,i,j)
4329 cptot(k,i,j) = cpdry * qdry + cpvap * qv(i,i,j)
4334 call atmos_thermodyn_rhot2temp_pres(
ka, 1,
ka,
ia, 1,
ia,
ja, 1,
ja, &
4336 rtot(:,:,:), cvtot(:,:,:), cptot(:,:,:), &
4337 temp(:,:,:), pres(:,:,:) )
4340 end subroutine mkinit_boxaero
4344 subroutine mkinit_warmbubbleaero
4350 real(RP) :: SFC_THETA
4351 real(RP) :: SFC_PRES
4352 real(RP) :: SFC_RH = 80.0_rp
4354 real(RP) :: ENV_U = 0.0_rp
4355 real(RP) :: ENV_V = 0.0_rp
4356 real(RP) :: ENV_RH = 80.0_rp
4357 real(RP) :: ENV_L1_ZTOP = 1.e3_rp
4358 real(RP) :: ENV_L2_ZTOP = 14.e3_rp
4359 real(RP) :: ENV_L2_TLAPS = 4.e-3_rp
4360 real(RP) :: ENV_L3_TLAPS = 3.e-2_rp
4362 real(RP) :: BBL_THETA = 1.0_rp
4364 namelist / param_mkinit_warmbubble / &
4381 log_info(
"MKINIT_warmbubbleaero",*)
'Setup initial state' 4384 log_error(
"MKINIT_warmbubbleaero",*)
'QV is not registerd' 4389 sfc_theta = thetastd
4394 read(
io_fid_conf,nml=param_mkinit_warmbubble,iostat=ierr)
4397 log_info(
"MKINIT_warmbubbleaero",*)
'Not found namelist. Default used.' 4398 elseif( ierr > 0 )
then 4399 log_error(
"MKINIT_warmbubbleaero",*)
'Not appropriate names in namelist PARAM_MKINIT_WARMBUBBLE. Check!' 4402 log_nml(param_mkinit_warmbubble)
4405 pres_sfc(1,1) = sfc_pres
4406 pott_sfc(1,1) = sfc_theta
4409 if ( cz(k) <= env_l1_ztop )
then 4410 pott(k,1,1) = sfc_theta
4411 elseif( cz(k) < env_l2_ztop )
then 4412 pott(k,1,1) = pott(k-1,1,1) + env_l2_tlaps * ( cz(k)-cz(k-1) )
4414 pott(k,1,1) = pott(k-1,1,1) + env_l3_tlaps * ( cz(k)-cz(k-1) )
4419 call hydrostatic_buildrho(
ka,
ks,
ke, &
4420 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
4421 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
4423 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
4426 call saturation_psat_all( temp_sfc(1,1), psat_sfc(1,1) )
4427 qsat_sfc(1,1) = epsvap * psat_sfc(1,1) / ( pres_sfc(1,1) - ( 1.0_rp-epsvap ) * psat_sfc(1,1) )
4429 qdry(:,1,1) = 1.0_rp - qv(:,1,1) - qc(:,1,1)
4430 call saturation_pres2qsat_all(
ka,
ks,
ke, &
4431 temp(:,1,1), pres(:,1,1), qdry(:,1,1), &
4433 qv_sfc(1,1) = sfc_rh * 1.e-2_rp * qsat_sfc(1,1)
4435 if ( cz(k) <= env_l1_ztop )
then 4436 qv(k,1,1) = env_rh * 1.e-2_rp * qsat(k,1,1)
4437 elseif( cz(k) <= env_l2_ztop )
then 4438 qv(k,1,1) = env_rh * 1.e-2_rp * qsat(k,1,1)
4445 call hydrostatic_buildrho(
ka,
ks,
ke, &
4446 pott(:,1,1), qv(:,1,1), qc(:,1,1), &
4447 pres_sfc(1,1), pott_sfc(1,1), qv_sfc(1,1), qc_sfc(1,1), &
4449 dens(:,1,1), temp(:,1,1), pres(:,1,1), temp_sfc(1,1) )
4455 momz(k,i,j) = 0.0_rp
4460 rhot(k,i,j) =
dens(k,1,1) * ( pott(k,1,1) + bbl_theta * bubble(k,i,j) )
4462 qv(k,i,j) = qv(k,1,1)
4470 end subroutine mkinit_warmbubbleaero
4474 subroutine mkinit_real
4494 end subroutine mkinit_real
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cxg
center coordinate [m]: x, global
real(rp), dimension(:,:,:), allocatable, target, public momz
real(rp), public const_cvdry
specific heat (dry air,constant volume) [J/kg/K]
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_rd_sflx_down
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
module atmosphere / saturation
real(rp), dimension(:,:), allocatable, public urban_qc
integer, public ihalo
of halo cells: x
module coupler / surface-atmospehre
integer, parameter, public i_oceancouple
real(rp), dimension(:,:,:), allocatable, target, public rhot
integer, public imax
of computational cells: x, local
integer, public jhalo
of halo cells: y
integer, public ia
of whole cells: x, local, with HALO
module Atmosphere / Physics Cloud Microphysics
subroutine, public landuse_fillhalo(FILL_BND)
HALO Communication.
integer, parameter, public i_r_vis
integer, parameter, public i_boxaero
integer, public iag
of computational grids
subroutine land_setup
Land setup.
real(rp), parameter, public const_cl
specific heat (liquid water) [J/kg/K]
module ATMOSPHERIC Variables
real(rp), public const_radius
radius of the planet [m]
real(rp), dimension(:,:,:), allocatable, target, public momx
real(rp), dimension(:,:), allocatable, public ocean_sfc_temp
ocean surface skin temperature [K]
subroutine ocean_setup
Ocean setup.
subroutine, public landuse_calc_fact
real(rp), dimension(:,:), allocatable, public ocean_ice_mass
sea ice mass [kg]
integer, parameter, public i_dycoms2_rf02_dns
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fxg
face coordinate [m]: x, global
integer, parameter, public i_turbulence
integer, parameter, public i_urbancouple
integer, parameter, public i_gravitywave
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_fz
geopotential height [m] (wxy)
integer, public ja
of whole cells: y, local, with HALO
character(len=h_short), public atmos_phy_ae_type
integer, public io_fid_conf
Config file ID.
real(rp) function faero(f0, r0, x, alpha, rhoa)
real(rp), dimension(:,:), allocatable, public urban_tb
integer, parameter, public i_grayzone
real(rp), dimension(:,:,:), allocatable, target, public dens
real(rp), public const_cvvap
specific heat (water vapor, constant volume) [J/kg/K]
real(rp), dimension(:,:), allocatable, public landuse_frac_urban
urban fraction
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fz
face coordinate [m]: z, local
real(rp), dimension(:,:), allocatable, public urban_raing
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_lw_up
integer, parameter, public i_landcouple
real(rp), dimension(:,:), allocatable, public atmos_phy_mp_sflx_rain
real(rp), dimension(:,:), allocatable, public urban_uc
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_toaflx_sw_up
real(rp), dimension(:,:,:,:), allocatable, public urban_sfc_albedo
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_lw_dn
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cy
center coordinate [m]: y, local
module Atmosphere / Physics Radiation
subroutine, public atmos_phy_ae_kajino13_mkinit(KA, KS, KE, IA, IS, IE, JA, JS, JE, QA_AE, DENS, TEMP, PRES, QDRY, QV, m0_init, dg_init, sg_init, d_min_inp, d_max_inp, k_min_inp, k_max_inp, n_kap_inp, QTRC, CCN)
real(rp), dimension(:,:), allocatable, public land_sfc_temp
land surface skin temperature [K]
integer, public is
start point of inner domain: x, local
real(rp), public const_ohm
angular velocity of the planet [1/s]
integer, public ie
end point of inner domain: x, local
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_sw_up
subroutine tke_setup
TKE setup.
real(rp), dimension(:,:), allocatable, public urban_tr
module atmosphere / vertical profile
integer, parameter, public i_seabreeze
real(rp), dimension(:,:,:), allocatable, public urban_tgl
logical, public atmos_hydrometeor_dry
module atmosphere / hydrometeor
real(rp), dimension(:,:,:,:), allocatable, public land_sfc_albedo
land surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
subroutine rect_setup
Bubble.
subroutine, public atmos_phy_mp_driver_qhyd2qtrc(KA, KS, KE, IA, IS, IE, JA, JS, JE, QV, QHYD, QTRC, QNUM)
real(rp), dimension(:,:,:), allocatable, public ocean_salt
ocean salinity [PSU]
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0h
ocean surface roughness length for heat [m]
module atmosphere / grid / cartesC index
integer, public ke
end point of inner domain: z, local
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_sflx_sw_dn
integer, parameter, public i_warmbubble
real(rp), public const_pre00
pressure reference [Pa]
real(rp), dimension(:,:,:), allocatable, public ocean_temp
ocean temperature [K]
integer function, public io_get_available_fid()
search & get available file ID
integer, public je
end point of inner domain: y, local
subroutine read_sounding(DENS, VELX, VELY, POTT, QV)
Read sounding data from file.
integer, parameter, public i_mountainwave
subroutine, public landuse_write
Write landuse data.
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cx
center coordinate [m]: x, local
real(rp), dimension(:,:,:), allocatable, public land_temp
temperature of each soil layer [K]
module atmosphere / hydrostatic barance
real(rp), public const_grav
standard acceleration of gravity [m/s2]
module atmosphere / physics / PBL
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_toaflx_lw_dn
module atmosphere / grid / cartesC
real(rp), dimension(:,:), allocatable, public urban_roff
integer, public ks
start point of inner domain: z, local
real(rp), dimension(:,:,:), allocatable, public atmos_phy_ae_ccn
integer, parameter, public i_real
real(rp), public const_epsvap
Rdry / Rvap.
module Atmosphere / Physics Turbulence
integer, parameter, public i_heatisland
integer, parameter, public i_triplecouple
real(rp), parameter, public const_rvap
specific gas constant (water vapor) [J/kg/K]
subroutine, public prc_abort
Abort Process.
integer, public jag
of computational grids
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fy
face coordinate [m]: y, local
integer, parameter, public i_hc
liquid water cloud
integer, public js
start point of inner domain: y, local
integer, parameter, public i_planestate
integer, parameter, public i_r_direct
character(len=h_short), public atmos_phy_mp_type
integer, parameter, public i_khwave
integer, parameter, public i_squallline
real(rp), dimension(:,:), allocatable, public urban_tc
real(rp), dimension(:,:,:), allocatable, target, public momy
real(rp), dimension(:,:), allocatable, public urban_rainr
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
real(dp), parameter, public const_undef8
undefined value (REAL8)
real(rp), dimension(:,:,:), allocatable, public land_water
moisture of each soil layer [m3/m3]
integer, public mkinit_type
subroutine, public mkinit(output)
Driver.
real(rp), dimension(:,:), allocatable, public atmos_phy_mp_sflx_snow
integer, parameter, public i_rico
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_cz
geopotential height [m] (zxy)
integer, parameter, public i_ignore
real(rp), public const_eps
small number
integer, parameter, public i_r_nir
module atmosphere / thermodyn
integer, parameter, public i_lambwave
integer, parameter, public i_supercell
real(rp), dimension(:,:,:), allocatable, public ocean_vvel
ocean meridional velocity [m/s]
module Atmosphere GRID CartesC Real(real space)
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_toaflx_sw_dn
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_area
horizontal area ( xy, normal z) [m2]
integer, parameter, public i_bomex
module atmosphere / physics / aerosol / Kajino13
integer, parameter, public i_dycoms2_rf01
integer, public ka
of whole cells: z, local, with HALO
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fx
face coordinate [m]: x, local
integer, parameter, public i_interporation
real(rp), public const_pi
pi
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_fyg
face coordinate [m]: y, global
real(rp), dimension(:,:), allocatable, public urban_tg
real(rp), public atmos_grid_cartesc_domain_center_x
center position of global domain [m]: x
real(rp), dimension(:,:), allocatable, public urban_sfc_temp
subroutine, public random_uniform(var)
Get uniform random number.
real(rp), dimension(:,:,:), allocatable, public urban_trl
integer, parameter, public i_r_ir
integer, parameter, public i_warmbubbleaero
integer, parameter, public i_wk1982
real(rp), dimension(:,:), allocatable, public ocean_ice_temp
sea ice temperature [K]
real(rp), dimension(:,:), allocatable, public ocean_ocn_z0m
surface roughness length for momentum, open ocean [m]
integer, parameter, public i_bubblecouple
integer, parameter, public i_r_diffuse
integer, parameter, public i_tracerbubble
integer, parameter, public n_hyd
real(rp), dimension(:,:,:,:), allocatable, public ocean_sfc_albedo
ocean surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
integer, parameter, public i_coldbubble
real(rp), parameter, public const_cpvap
specific heat (water vapor, constant pressure) [J/kg/K]
integer, parameter, public i_cavityflow
module Spectran Bin Microphysics
module atmosphere / physics / cloud microphysics
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
real(rp), dimension(:,:,:), allocatable, public urban_tbl
module ATMOSPHERE / Physics Aerosol Microphysics
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cz
center coordinate [m]: z, local
real(rp), public atmos_grid_cartesc_domain_center_y
center position of global domain [m]: y
integer, parameter, public i_barocwave
real(rp), dimension(:,:), allocatable, public landuse_frac_land
land fraction
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0m
ocean surface roughness length for momentum [m]
subroutine, public mkinit_setup
Setup.
integer, parameter, public i_dycoms2_rf02
real(rp), dimension(:,:,:), allocatable, public ocean_uvel
ocean zonal velocity [m/s]
real(rp), public const_pstd
standard pressure [Pa]
real(rp), dimension(:,:), allocatable, public urban_rainb
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0e
ocean surface roughness length for vapor [m]
real(rp), dimension(:,:), allocatable, public atmos_phy_rd_toaflx_lw_up
subroutine urban_setup
Urban setup.
subroutine flux_setup
flux setup
real(rp), dimension(:,:,:,:), allocatable, target, public qtrc
integer, public prc_num_x
x length of 2D processor topology