Changeset 4508 for palm/trunk/SOURCE
- Timestamp:
- Apr 24, 2020 1:32:20 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
-
Makefile (modified) (3 diffs)
-
pmc_interface_mod.f90 (modified) (3 diffs)
-
salsa_mod.f90 (modified) (23 diffs)
-
time_integration.f90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r4495 r4508 25 25 # ----------------- 26 26 # $Id$ 27 # dependencies for salsa_mod updated 28 # 29 # 4495 2020-04-13 20:11:20Z raasch 27 30 # added routines and dependencies for restart data with MPI-IO 28 31 # … … 895 898 pmc_particle_interface.o \ 896 899 restart_data_mpi_io_mod.o \ 897 salsa_mod.o \898 900 surface_layer_fluxes_mod.o \ 899 901 surface_data_output_mod.o \ … … 1024 1026 plant_canopy_model_mod.o \ 1025 1027 radiation_model_mod.o \ 1026 salsa_mod.o \1027 1028 subsidence_mod.o \ 1028 1029 surface_mod.o \ -
palm/trunk/SOURCE/pmc_interface_mod.f90
r4444 r4508 25 25 ! ----------------- 26 26 ! $Id$ 27 ! salsa variable name changed 28 ! 29 ! 4444 2020-03-05 15:59:50Z raasch 27 30 ! bugfix: cpp-directives and variable declarations for serial mode added 28 31 ! … … 288 291 289 292 USE salsa_mod, & 290 ONLY: aerosol_mass, aerosol_number, gconc_2, ibc_ salsa_b,&293 ONLY: aerosol_mass, aerosol_number, gconc_2, ibc_aer_b, & 291 294 mconc_2, nbins_aerosol, & 292 295 ncomponents_mass, nconc_2, nesting_salsa, ngases_salsa, & … … 4875 4878 !-- Set Neumann boundary conditions for aerosols and salsa gases 4876 4879 IF ( salsa .AND. nesting_salsa ) THEN 4877 IF ( ibc_ salsa_b == 1 ) THEN4880 IF ( ibc_aer_b == 1 ) THEN 4878 4881 DO m = 1, bc_h(0)%ns 4879 4882 ic = bc_h(0)%i(m) -
palm/trunk/SOURCE/salsa_mod.f90
r4487 r4508 26 26 ! ----------------- 27 27 ! $Id$ 28 ! decycling replaced by explicit setting of lateral boundary conditions (Siggi) 29 ! 30 ! 4487 2020-04-03 09:38:20Z raasch 28 31 ! bugfix for subroutine calls that contain the decycle_salsa switches as arguments 29 32 ! … … 430 433 ! 431 434 !-- SALSA variables: 432 CHARACTER(LEN=20) :: bc_salsa_b = 'neumann' !< bottom boundary condition 433 CHARACTER(LEN=20) :: bc_salsa_t = 'neumann' !< top boundary condition 435 CHARACTER(LEN=20) :: bc_aer_b = 'neumann' !< bottom boundary condition 436 CHARACTER(LEN=20) :: bc_aer_l = 'undefined' !< left boundary condition 437 CHARACTER(LEN=20) :: bc_aer_n = 'undefined' !< north boundary condition 438 CHARACTER(LEN=20) :: bc_aer_r = 'undefined' !< right boundary condition 439 CHARACTER(LEN=20) :: bc_aer_s = 'undefined' !< south boundary condition 440 CHARACTER(LEN=20) :: bc_aer_t = 'neumann' !< top boundary condition 434 441 CHARACTER(LEN=20) :: depo_pcm_par = 'zhang2001' !< or 'petroff2010' 435 442 CHARACTER(LEN=20) :: depo_pcm_type = 'deciduous_broadleaf' !< leaf type … … 439 446 CHARACTER(LEN=20) :: salsa_emission_mode = 'no_emission' !< 'no_emission', 'uniform', 440 447 !< 'parameterized', 'read_from_file' 441 442 CHARACTER(LEN=20), DIMENSION(4) :: decycle_method_salsa = &443 (/'dirichlet','dirichlet','dirichlet','dirichlet'/)444 !< Decycling method at horizontal boundaries445 !< 1=left, 2=right, 3=south, 4=north446 !< dirichlet = initial profiles for the ghost and first 3 layers447 !< neumann = zero gradient448 449 448 CHARACTER(LEN=3), DIMENSION(maxspec) :: listspec = & !< Active aerosols 450 449 (/'SO4',' ',' ',' ',' ',' ',' '/) 451 450 451 INTEGER(iwp) :: communicator_salsa !< stores the number of the MPI communicator to be used 452 !< for ghost layer data exchange 453 !< 1: cyclic, 2: cyclic along x, 3: cyclic along y, 454 !< 4: non-cyclic 452 455 INTEGER(iwp) :: depo_pcm_par_num = 1 !< parametrisation type: 1=zhang2001, 2=petroff2010 453 456 INTEGER(iwp) :: depo_pcm_type_num = 0 !< index for the dry deposition type on the plant canopy … … 456 459 INTEGER(iwp) :: end_subrange_2a = 1 !< last index for bin subrange 2a 457 460 INTEGER(iwp) :: end_subrange_2b = 1 !< last index for bin subrange 2b 458 INTEGER(iwp) :: ibc_ salsa_b!< index for the bottom boundary condition459 INTEGER(iwp) :: ibc_ salsa_t!< index for the top boundary condition461 INTEGER(iwp) :: ibc_aer_b !< index for the bottom boundary condition 462 INTEGER(iwp) :: ibc_aer_t !< index for the top boundary condition 460 463 INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC) 461 464 INTEGER(iwp) :: index_du = -1 !< index for dust … … 520 523 !-- SALSA switches: 521 524 LOGICAL :: advect_particle_water = .TRUE. !< Advect water concentration of particles 522 LOGICAL :: decycle_salsa_lr = .FALSE. !< Undo cyclic boundaries: left and right 523 LOGICAL :: decycle_salsa_ns = .FALSE. !< Undo cyclic boundaries: north and south 525 LOGICAL :: bc_dirichlet_aer_l = .FALSE. !< flag for indicating a dirichlet condition at 526 !< the left boundary 527 LOGICAL :: bc_dirichlet_aer_n = .FALSE. !< flag for indicating a dirichlet condition at 528 !< the north boundary 529 LOGICAL :: bc_dirichlet_aer_r = .FALSE. !< flag for indicating a dirichlet condition at 530 !< the right boundary 531 LOGICAL :: bc_dirichlet_aer_s = .FALSE. !< flag for indicating a dirichlet condition at 532 !< the south boundary 533 LOGICAL :: bc_radiation_aer_l = .FALSE. !< flag for indicating a radiation/neumann 534 !< condition at the left boundary 535 LOGICAL :: bc_radiation_aer_n = .FALSE. !< flag for indicating a radiation/neumann 536 !< condition at the north boundary 537 LOGICAL :: bc_radiation_aer_r = .FALSE. !< flag for indicating a radiation/neumann 538 !< condition at the right boundary 539 LOGICAL :: bc_radiation_aer_s = .FALSE. !< flag for indicating a radiation/neumann 540 !< condition at the south boundary 524 541 LOGICAL :: include_emission = .FALSE. !< Include or not emissions 525 542 LOGICAL :: feedback_to_palm = .FALSE. !< Allow feedback due to condensation of H2O … … 531 548 LOGICAL :: van_der_waals_coagc = .FALSE. !< Include van der Waals and viscous forces in coagulation 532 549 LOGICAL :: write_binary_salsa = .TRUE. !< read binary for salsa 550 533 551 ! 534 552 !-- Process switches: nl* is read from the NAMELIST and is NOT changed. … … 886 904 END INTERFACE salsa_3d_data_averaging 887 905 888 INTERFACE salsa_boundary_conds889 MODULE PROCEDURE salsa_boundary_conds890 MODULE PROCEDURE salsa_boundary_conds_decycle891 END INTERFACE salsa_boundary_conds892 893 906 INTERFACE salsa_boundary_conditions 894 907 MODULE PROCEDURE salsa_boundary_conditions … … 998 1011 PUBLIC salsa_3d_data_averaging, & 999 1012 salsa_actions, & 1000 salsa_boundary_conds, &1001 1013 salsa_boundary_conditions, & 1002 1014 salsa_check_data_output, & … … 1029 1041 bc_an_t_val, & 1030 1042 bc_gt_t_val, & 1031 ibc_salsa_b, & 1043 communicator_salsa, & 1044 ibc_aer_b, & 1032 1045 init_aerosol_type, & 1033 1046 init_gases_type, & … … 1074 1087 aerosol_flux_sigmag, & 1075 1088 advect_particle_water, & 1076 bc_salsa_b, & 1077 bc_salsa_t, & 1078 decycle_salsa_lr, & 1079 decycle_method_salsa, & 1080 decycle_salsa_ns, & 1089 bc_aer_b, & 1090 bc_aer_l, & 1091 bc_aer_n, & 1092 bc_aer_r, & 1093 bc_aer_s, & 1094 bc_aer_t, & 1081 1095 depo_pcm_par, & 1082 1096 depo_pcm_type, & … … 1175 1189 IF ( child_domain ) THEN 1176 1190 IF ( nesting_salsa ) THEN 1177 bc_ salsa_t = 'nested'1191 bc_aer_t = 'nested' 1178 1192 ELSE 1179 bc_ salsa_t = 'neumann'1193 bc_aer_t = 'neumann' 1180 1194 ENDIF 1181 1195 ENDIF … … 1184 1198 IF ( nesting_offline ) THEN 1185 1199 IF ( nesting_offline_salsa ) THEN 1186 bc_ salsa_t = 'nesting_offline'1200 bc_aer_t = 'nesting_offline' 1187 1201 ELSE 1188 bc_ salsa_t = 'neumann'1202 bc_aer_t = 'neumann' 1189 1203 ENDIF 1190 1204 ENDIF 1191 1205 ! 1192 1206 !-- Set bottom boundary condition flag 1193 IF ( bc_ salsa_b == 'dirichlet' ) THEN1194 ibc_ salsa_b = 01195 ELSEIF ( bc_ salsa_b == 'neumann' ) THEN1196 ibc_ salsa_b = 11207 IF ( bc_aer_b == 'dirichlet' ) THEN 1208 ibc_aer_b = 0 1209 ELSEIF ( bc_aer_b == 'neumann' ) THEN 1210 ibc_aer_b = 1 1197 1211 ELSE 1198 message_string = 'unknown boundary condition: bc_ salsa_b = "' // TRIM( bc_salsa_t ) // '"'1212 message_string = 'unknown boundary condition: bc_aer_b = "' // TRIM( bc_aer_t ) // '"' 1199 1213 CALL message( 'salsa_check_parameters', 'PA0595', 1, 2, 0, 6, 0 ) 1200 1214 ENDIF 1201 1215 ! 1202 1216 !-- Set top boundary conditions flag 1203 IF ( bc_ salsa_t == 'dirichlet' ) THEN1204 ibc_ salsa_t = 01205 ELSEIF ( bc_ salsa_t == 'neumann' ) THEN1206 ibc_ salsa_t = 11207 ELSEIF ( bc_ salsa_t == 'initial_gradient' ) THEN1208 ibc_ salsa_t = 21209 ELSEIF ( bc_ salsa_t == 'nested' .OR. bc_salsa_t == 'nesting_offline' ) THEN1210 ibc_ salsa_t = 31217 IF ( bc_aer_t == 'dirichlet' ) THEN 1218 ibc_aer_t = 0 1219 ELSEIF ( bc_aer_t == 'neumann' ) THEN 1220 ibc_aer_t = 1 1221 ELSEIF ( bc_aer_t == 'initial_gradient' ) THEN 1222 ibc_aer_t = 2 1223 ELSEIF ( bc_aer_t == 'nested' .OR. bc_aer_t == 'nesting_offline' ) THEN 1224 ibc_aer_t = 3 1211 1225 ELSE 1212 message_string = 'unknown boundary condition: bc_ salsa_t = "' // TRIM( bc_salsa_t ) // '"'1226 message_string = 'unknown boundary condition: bc_aer_t = "' // TRIM( bc_aer_t ) // '"' 1213 1227 CALL message( 'salsa_check_parameters', 'PA0596', 1, 2, 0, 6, 0 ) 1214 1228 ENDIF … … 1221 1235 ! 1222 1236 !-- Check bottom boundary condition in case of surface emissions 1223 IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_ salsa_b == 0 ) THEN1224 message_string = 'salsa_emission_mode /= "no_emission" requires bc_ salsa_b = "Neumann"'1237 IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_aer_b == 0 ) THEN 1238 message_string = 'salsa_emission_mode /= "no_emission" requires bc_aer_b = "Neumann"' 1225 1239 CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 ) 1240 ENDIF 1241 ! 1242 !-- Check left and right boundary conditions. First set default value if not set by user. 1243 IF ( bc_aer_l == 'undefined' ) THEN 1244 IF ( bc_lr == 'cyclic' ) THEN 1245 bc_aer_l = 'cyclic' 1246 ELSEIF ( bc_lr == 'dirichlet/radiation' ) THEN 1247 bc_aer_l = 'dirichlet' 1248 ELSEIF ( bc_lr == 'radiation/dirichlet' ) THEN 1249 bc_aer_l = 'neumann' 1250 ENDIF 1251 ENDIF 1252 IF ( bc_aer_r == 'undefined' ) THEN 1253 IF ( bc_lr == 'cyclic' ) THEN 1254 bc_aer_r = 'cyclic' 1255 ELSEIF ( bc_lr == 'dirichlet/radiation' ) THEN 1256 bc_aer_r = 'neumann' 1257 ELSEIF ( bc_lr == 'radiation/dirichlet' ) THEN 1258 bc_aer_r = 'dirichlet' 1259 ENDIF 1260 ENDIF 1261 IF ( bc_aer_l /= 'dirichlet' .AND. bc_aer_l /= 'neumann' .AND. bc_aer_l /= 'cyclic' ) THEN 1262 message_string = 'unknown boundary condition: bc_aer_l = "' // TRIM( bc_aer_l ) // '"' 1263 CALL message( 'salsa_check_parameters','PA0626', 1, 2, 0, 6, 0 ) 1264 ENDIF 1265 IF ( bc_aer_r /= 'dirichlet' .AND. bc_aer_r /= 'neumann' .AND. bc_aer_r /= 'cyclic' ) THEN 1266 message_string = 'unknown boundary condition: bc_aer_r = "' // TRIM( bc_aer_r ) // '"' 1267 CALL message( 'salsa_check_parameters','PA0627', 1, 2, 0, 6, 0 ) 1268 ENDIF 1269 ! 1270 !-- Check north and south boundary conditions. First set default value if not set by user. 1271 IF ( bc_aer_n == 'undefined' ) THEN 1272 IF ( bc_ns == 'cyclic' ) THEN 1273 bc_aer_n = 'cyclic' 1274 ELSEIF ( bc_ns == 'dirichlet/radiation' ) THEN 1275 bc_aer_n = 'dirichlet' 1276 ELSEIF ( bc_ns == 'radiation/dirichlet' ) THEN 1277 bc_aer_n = 'neumann' 1278 ENDIF 1279 ENDIF 1280 IF ( bc_aer_s == 'undefined' ) THEN 1281 IF ( bc_ns == 'cyclic' ) THEN 1282 bc_aer_s = 'cyclic' 1283 ELSEIF ( bc_ns == 'dirichlet/radiation' ) THEN 1284 bc_aer_s = 'neumann' 1285 ELSEIF ( bc_ns == 'radiation/dirichlet' ) THEN 1286 bc_aer_s = 'dirichlet' 1287 ENDIF 1288 ENDIF 1289 IF ( bc_aer_n /= 'dirichlet' .AND. bc_aer_n /= 'neumann' .AND. bc_aer_n /= 'cyclic' ) THEN 1290 message_string = 'unknown boundary condition: bc_aer_n = "' // TRIM( bc_aer_n ) // '"' 1291 CALL message( 'salsa_check_parameters','PA0709', 1, 2, 0, 6, 0 ) 1292 ENDIF 1293 IF ( bc_aer_s /= 'dirichlet' .AND. bc_aer_s /= 'neumann' .AND. bc_aer_s /= 'cyclic' ) THEN 1294 message_string = 'unknown boundary condition: bc_aer_s = "' // TRIM( bc_aer_s ) // '"' 1295 CALL message( 'salsa_check_parameters','PA0711', 1, 2, 0, 6, 0 ) 1296 ENDIF 1297 ! 1298 !-- Cyclic conditions must be set identically at opposing boundaries 1299 IF ( ( bc_aer_l == 'cyclic' .AND. bc_aer_r /= 'cyclic' ) .OR. & 1300 ( bc_aer_r == 'cyclic' .AND. bc_aer_l /= 'cyclic' ) ) THEN 1301 message_string = 'boundary conditions bc_aer_l and bc_aer_r must both be cyclic or non-cyclic' 1302 CALL message( 'salsa_check_parameters','PA0712', 1, 2, 0, 6, 0 ) 1303 ENDIF 1304 IF ( ( bc_aer_n == 'cyclic' .AND. bc_aer_s /= 'cyclic' ) .OR. & 1305 ( bc_aer_s == 'cyclic' .AND. bc_aer_n /= 'cyclic' ) ) THEN 1306 message_string = 'boundary conditions bc_aer_n and bc_aer_s must both be cyclic or non-cyclic' 1307 CALL message( 'salsa_check_parameters','PA0713', 1, 2, 0, 6, 0 ) 1308 ENDIF 1309 ! 1310 !-- Set the switches that control application of horizontal boundary conditions at the boundaries 1311 !-- of the total domain 1312 IF ( bc_aer_n == 'dirichlet' .AND. nyn == ny ) bc_dirichlet_aer_n = .TRUE. 1313 IF ( bc_aer_n == 'neumann' .AND. nyn == ny ) bc_radiation_aer_n = .TRUE. 1314 IF ( bc_aer_s == 'dirichlet' .AND. nys == 0 ) bc_dirichlet_aer_s = .TRUE. 1315 IF ( bc_aer_s == 'neumann' .AND. nys == 0 ) bc_radiation_aer_s = .TRUE. 1316 IF ( bc_aer_l == 'dirichlet' .AND. nxl == 0 ) bc_dirichlet_aer_l = .TRUE. 1317 IF ( bc_aer_l == 'neumann' .AND. nxl == 0 ) bc_radiation_aer_l = .TRUE. 1318 IF ( bc_aer_r == 'dirichlet' .AND. nxr == nx ) bc_dirichlet_aer_r = .TRUE. 1319 IF ( bc_aer_r == 'neumann' .AND. nxr == nx ) bc_radiation_aer_r = .TRUE. 1320 ! 1321 !-- Set the communicator to be used for ghost layer data exchange 1322 !-- 1: cyclic, 2: cyclic along x, 3: cyclic along y, 4: non-cyclic 1323 IF ( bc_aer_l == 'cyclic' ) THEN 1324 IF ( bc_aer_s == 'cyclic' ) THEN 1325 communicator_salsa = 1 1326 ELSE 1327 communicator_salsa = 2 1328 ENDIF 1329 ELSE 1330 IF ( bc_aer_s == 'cyclic' ) THEN 1331 communicator_salsa = 3 1332 ELSE 1333 communicator_salsa = 4 1334 ENDIF 1226 1335 ENDIF 1227 1336 ! … … 1336 1445 WRITE( io, 24 ) 1337 1446 ENDIF 1447 WRITE( io, 26 ) TRIM( bc_aer_b ), TRIM( bc_aer_t ), TRIM( bc_aer_s ), TRIM( bc_aer_n ), & 1448 TRIM( bc_aer_l ), TRIM( bc_aer_r ) 1338 1449 1339 1450 1 FORMAT (//' SALSA information:'/ & 1340 1451 ' ------------------------------'/) 1341 2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s') 1342 3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s') 1343 4 FORMAT (/' Array shape (z,y,x,bins):'/ & 1344 ' aerosol_number: ', 4(I5)) 1345 5 FORMAT (/' aerosol_mass: ', 4(I5),/ & 1346 ' (advect_particle_water = ', L1, ')') 1347 6 FORMAT (' salsa_gas: ', 4(I5),/ & 1348 ' (salsa_gases_from_chem = ', L1, ')') 1349 7 FORMAT (/' Aerosol dynamic processes included: ') 1350 8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')') 1351 9 FORMAT (/' coagulation') 1352 10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' ) 1353 11 FORMAT (/' dissolutional growth by HNO3 and NH3') 1354 12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')') 1355 13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / & 1356 ' Number of size bins for each aerosol subrange: ', 2I3,/ & 1357 ' Aerosol bin lower limits (in metres): ', 12(ES10.2E3)) 1358 25 FORMAT (/' Bin geometric mean diameters (in metres): ', 12(ES10.2E3)) 1359 14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3)) 1360 15 FORMAT (/' Number of chemical components used: ', I1,/ & 1361 ' Species: ',7(A6),/ & 1362 ' Initial relative contribution of each species to particle volume in:',/ & 1363 ' a-bins: ', 7(F6.3),/ & 1364 ' b-bins: ', 7(F6.3)) 1365 16 FORMAT (/' Number of gaseous tracers used: ', I1,/ & 1366 ' Initial gas concentrations:',/ & 1367 ' H2SO4: ',ES12.4E3, ' #/m**3',/ & 1368 ' HNO3: ',ES12.4E3, ' #/m**3',/ & 1369 ' NH3: ',ES12.4E3, ' #/m**3',/ & 1370 ' OCNV: ',ES12.4E3, ' #/m**3',/ & 1371 ' OCSV: ',ES12.4E3, ' #/m**3') 1372 17 FORMAT (/' Initialising concentrations: ', / & 1373 ' Aerosol size distribution: init_aerosol_type = ', I1,/ & 1374 ' Gas concentrations: init_gases_type = ', I1 ) 1375 18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / & 1376 ' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ & 1377 ' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' ) 1378 19 FORMAT (/' Size distribution read from a file.') 1379 20 FORMAT (/' Nesting for salsa variables: ', L1 ) 1380 21 FORMAT (/' Offline nesting for salsa variables: ', L1 ) 1381 22 FORMAT (/' Emissions: salsa_emission_mode = ', A ) 1382 23 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / & 1383 ' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / & 1384 ' aerosol_flux_sigmag = ', 7(F7.2), / & 1385 ' aerosol_mass_fracs_a = ', 7(ES12.4E3) ) 1386 24 FORMAT (/' (currently all emissions are soluble!)') 1452 2 FORMAT (' Starts at: skip_time_do_salsa = ', F10.2, ' s') 1453 3 FORMAT (/' Timestep: dt_salsa = ', F6.2, ' s') 1454 4 FORMAT (/' Array shape (z,y,x,bins):'/ & 1455 ' aerosol_number: ', 4(I5)) 1456 5 FORMAT (/' aerosol_mass: ', 4(I5),/ & 1457 ' (advect_particle_water = ', L1, ')') 1458 6 FORMAT ( ' salsa_gas: ', 4(I5),/ & 1459 ' (salsa_gases_from_chem = ', L1, ')') 1460 7 FORMAT (/' Aerosol dynamic processes included: ') 1461 8 FORMAT (/' nucleation (scheme = ', I1, ' and J3 parametrization = ', I1, ')') 1462 9 FORMAT (/' coagulation') 1463 10 FORMAT (/' condensation (of precursor gases = ', L1, ' and water vapour = ', L1, ')' ) 1464 11 FORMAT (/' dissolutional growth by HNO3 and NH3') 1465 12 FORMAT (/' dry deposition (on vegetation = ', L1, ' and on topography = ', L1, ')') 1466 13 FORMAT (/' Aerosol bin subrange limits (in metres): ', 3(ES10.2E3), / & 1467 ' Number of size bins for each aerosol subrange: ', 2I3,/ & 1468 ' Aerosol bin lower limits (in metres): ', 12(ES10.2E3)) 1469 25 FORMAT (/' Bin geometric mean diameters (in metres): ', 12(ES10.2E3)) 1470 14 FORMAT (' Initial number concentration in bins at the lowest level (#/m**3):', 9(ES10.2E3)) 1471 15 FORMAT (/' Number of chemical components used: ', I1,/ & 1472 ' Species: ',7(A6),/ & 1473 ' Initial relative contribution of each species to particle volume in:',/ & 1474 ' a-bins: ', 7(F6.3),/ & 1475 ' b-bins: ', 7(F6.3)) 1476 16 FORMAT (/' Number of gaseous tracers used: ', I1,/ & 1477 ' Initial gas concentrations:',/ & 1478 ' H2SO4: ',ES12.4E3, ' #/m**3',/ & 1479 ' HNO3: ',ES12.4E3, ' #/m**3',/ & 1480 ' NH3: ',ES12.4E3, ' #/m**3',/ & 1481 ' OCNV: ',ES12.4E3, ' #/m**3',/ & 1482 ' OCSV: ',ES12.4E3, ' #/m**3') 1483 17 FORMAT (/' Initialising concentrations: ', / & 1484 ' Aerosol size distribution: init_aerosol_type = ', I1,/ & 1485 ' Gas concentrations: init_gases_type = ', I1 ) 1486 18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / & 1487 ' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ & 1488 ' Number concentration: n_lognorm(nmod) = ', 7(ES12.4E3), ' (#/m3)' ) 1489 19 FORMAT (/' Size distribution read from a file.') 1490 20 FORMAT (/' Nesting for salsa variables: ', L1 ) 1491 21 FORMAT (/' Offline nesting for salsa variables: ', L1 ) 1492 22 FORMAT (/' Emissions: salsa_emission_mode = ', A ) 1493 23 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / & 1494 ' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / & 1495 ' aerosol_flux_sigmag = ', 7(F7.2), / & 1496 ' aerosol_mass_fracs_a = ', 7(ES12.4E3) ) 1497 24 FORMAT (/' (currently all emissions are soluble!)') 1498 26 FORMAT (/' Boundary conditions for aerosols:', / & 1499 ' bottom/top: ',A10,' / ',A10, / & 1500 ' north/south: ',A10,' / ',A10, / & 1501 ' left/right: ',A10,' / ',A10) 1387 1502 1388 1503 END SUBROUTINE salsa_header … … 1680 1795 1681 1796 ENDIF 1682 ! 1683 !-- Set control flags for decycling only at lateral boundary cores. Within the inner cores the 1684 !-- decycle flag is set to .FALSE.. Even though it does not affect the setting of chemistry boundary 1685 !-- conditions, this flag is used to set advection control flags appropriately. 1686 decycle_salsa_lr = MERGE( decycle_salsa_lr, .FALSE., nxl == 0 .OR. nxr == nx ) 1687 decycle_salsa_ns = MERGE( decycle_salsa_ns, .FALSE., nys == 0 .OR. nyn == ny ) 1688 ! 1689 !-- Decycling can be applied separately for aerosol variables, while wind and other scalars may have 1690 !-- cyclic or nested boundary conditions. However, large gradients near the boundaries may produce 1797 1798 ! 1799 !-- Large gradients near the boundaries may produce 1691 1800 !-- stationary numerical oscillations near the lateral boundaries when a higher-order scheme is 1692 1801 !-- applied near these boundaries. To get rid-off this, set-up additional flags that control the … … 1694 1803 !-- decycling. 1695 1804 IF ( scalar_advec == 'ws-scheme' ) THEN 1805 1696 1806 ALLOCATE( salsa_advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1697 1807 ! 1698 !-- In case of decycling, set Neuman boundary conditions for wall_flags_total_0 bit 31 instead of 1699 !-- cyclic boundary conditions. Bit 31 is used to identify extended degradation zones (please see 1808 !-- Bit 31 is used to identify extended degradation zones (please see 1700 1809 !-- the following comment). Note, since several also other modules may access this bit but may 1701 1810 !-- have other boundary conditions, the original value of wall_flags_total_0 bit 31 must not be … … 1707 1816 salsa_advc_flags_s = MERGE( IBSET( salsa_advc_flags_s, 31 ), 0, BTEST( wall_flags_total_0, 31 ) ) 1708 1817 1709 IF ( decycle_salsa_ns ) THEN1710 IF ( nys == 0 ) THEN1711 DO i = 1, nbgp1712 salsa_advc_flags_s(:,nys-i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nys,:), 31 ), &1713 IBCLR( salsa_advc_flags_s(:,nys,:), 31 ), &1714 BTEST( salsa_advc_flags_s(:,nys,:), 31 ) )1715 ENDDO1716 ENDIF1717 IF ( nyn == ny ) THEN1718 DO i = 1, nbgp1719 salsa_advc_flags_s(:,nyn+i,:) = MERGE( IBSET( salsa_advc_flags_s(:,nyn,:), 31 ), &1720 IBCLR( salsa_advc_flags_s(:,nyn,:), 31 ), &1721 BTEST( salsa_advc_flags_s(:,nyn,:), 31 ) )1722 ENDDO1723 ENDIF1724 ENDIF1725 IF ( decycle_salsa_lr ) THEN1726 IF ( nxl == 0 ) THEN1727 DO i = 1, nbgp1728 salsa_advc_flags_s(:,:,nxl-i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxl), 31 ), &1729 IBCLR( salsa_advc_flags_s(:,:,nxl), 31 ), &1730 BTEST( salsa_advc_flags_s(:,:,nxl), 31 ) )1731 ENDDO1732 ENDIF1733 IF ( nxr == nx ) THEN1734 DO i = 1, nbgp1735 salsa_advc_flags_s(:,:,nxr+i) = MERGE( IBSET( salsa_advc_flags_s(:,:,nxr), 31 ), &1736 IBCLR( salsa_advc_flags_s(:,:,nxr), 31 ), &1737 BTEST( salsa_advc_flags_s(:,:,nxr), 31 ) )1738 ENDDO1739 ENDIF1740 ENDIF1741 1818 ! 1742 1819 !-- To initialise the advection flags appropriately, pass the boundary flags to … … 1751 1828 !-- oscillations, which are responsible for high concentration maxima that may appear e.g. under 1752 1829 !-- shear-free stable conditions. 1753 CALL ws_init_flags_scalar( & 1754 bc_dirichlet_l .OR. bc_radiation_l .OR. ( decycle_salsa_lr .AND. nxl == 0 ), & 1755 bc_dirichlet_n .OR. bc_radiation_n .OR. ( decycle_salsa_ns .AND. nyn == ny ), & 1756 bc_dirichlet_r .OR. bc_radiation_r .OR. ( decycle_salsa_lr .AND. nxr == nx ), & 1757 bc_dirichlet_s .OR. bc_radiation_s .OR. ( decycle_salsa_ns .AND. nys == 0 ), & 1758 salsa_advc_flags_s, .TRUE. ) 1830 CALL ws_init_flags_scalar( bc_dirichlet_aer_l .OR. bc_radiation_aer_l, & 1831 bc_dirichlet_aer_n .OR. bc_radiation_aer_n, & 1832 bc_dirichlet_aer_r .OR. bc_radiation_aer_r, & 1833 bc_dirichlet_aer_s .OR. bc_radiation_aer_s, & 1834 salsa_advc_flags_s, .TRUE. ) 1759 1835 ENDIF 1760 1836 … … 7902 7978 CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' ) 7903 7979 ! 7904 !-- Exchange ghost points and decycle if needed.7980 !-- Exchange ghost points 7905 7981 DO ib = 1, nbins_aerosol 7906 CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )7907 CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init)7982 CALL exchange_horiz( aerosol_number(ib)%conc, nbgp, & 7983 alternative_communicator = communicator_salsa ) 7908 7984 DO ic = 1, ncomponents_mass 7909 7985 icc = ( ic - 1 ) * nbins_aerosol + ib 7910 CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )7911 CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init)7986 CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp, & 7987 alternative_communicator = communicator_salsa ) 7912 7988 ENDDO 7913 7989 ENDDO 7914 7990 IF ( .NOT. salsa_gases_from_chem ) THEN 7915 7991 DO ig = 1, ngases_salsa 7916 CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )7917 CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init)7992 CALL exchange_horiz( salsa_gas(ig)%conc, nbgp, & 7993 alternative_communicator = communicator_salsa ) 7918 7994 ENDDO 7919 7995 ENDIF 7996 ! 7997 !-- Apply only horizontal boundary conditions 7998 CALL salsa_boundary_conditions( horizontal_conditions_only = .TRUE. ) 7920 7999 CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' ) 7921 8000 ! … … 8108 8187 IF ( timestep_scheme(1:5) == 'runge' ) THEN 8109 8188 IF ( ws_scheme_sca ) THEN 8110 CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, & 8111 flux_s, diss_s, flux_l, diss_l, i_omp_start, tn, & 8112 bc_dirichlet_l .OR. bc_radiation_l .OR. ( decycle_salsa_lr .AND. nxl == 0 ), & 8113 bc_dirichlet_n .OR. bc_radiation_n .OR. ( decycle_salsa_ns .AND. nyn == ny ), & 8114 bc_dirichlet_r .OR. bc_radiation_r .OR. ( decycle_salsa_lr .AND. nxr == nx ), & 8115 bc_dirichlet_s .OR. bc_radiation_s .OR. ( decycle_salsa_ns .AND. nys == 0 ), & 8116 monotonic_limiter_z ) 8189 CALL advec_s_ws( salsa_advc_flags_s, i, j, rs, id, flux_s, diss_s, flux_l, diss_l, & 8190 i_omp_start, tn, bc_dirichlet_aer_l .OR. bc_radiation_aer_l, & 8191 bc_dirichlet_aer_n .OR. bc_radiation_aer_n, & 8192 bc_dirichlet_aer_r .OR. bc_radiation_aer_r, & 8193 bc_dirichlet_aer_s .OR. bc_radiation_aer_s, monotonic_limiter_z ) 8117 8194 ELSE 8118 8195 CALL advec_s_pw( i, j, rs ) … … 8246 8323 IF ( ws_scheme_sca ) THEN 8247 8324 CALL advec_s_ws( salsa_advc_flags_s, rs, id, & 8248 bc_dirichlet_l .OR. bc_radiation_l .OR. ( decycle_salsa_lr .AND. nxl == 0 ),&8249 bc_dirichlet_n .OR. bc_radiation_n .OR. ( decycle_salsa_ns .AND. nyn == ny ),&8250 bc_dirichlet_r .OR. bc_radiation_r .OR. ( decycle_salsa_lr .AND. nxr == nx ),&8251 bc_dirichlet_s .OR. bc_radiation_s .OR. ( decycle_salsa_ns .AND. nys == 0 ))8325 bc_dirichlet_aer_l .OR. bc_radiation_aer_l, & 8326 bc_dirichlet_aer_n .OR. bc_radiation_aer_n, & 8327 bc_dirichlet_aer_r .OR. bc_radiation_aer_r, & 8328 bc_dirichlet_aer_s .OR. bc_radiation_aer_s ) 8252 8329 ELSE 8253 8330 CALL advec_s_pw( rs ) … … 8338 8415 ! Description: 8339 8416 ! ------------ 8340 !> Boundary conditions for prognostic variables in SALSA from module interface8341 !------------------------------------------------------------------------------!8342 SUBROUTINE salsa_boundary_conditions8343 8344 IMPLICIT NONE8345 8346 INTEGER(iwp) :: ib !< index for aerosol size bins8347 INTEGER(iwp) :: ic !< index for aerosol mass bins8348 INTEGER(iwp) :: icc !< additional index for aerosol mass bins8349 INTEGER(iwp) :: ig !< index for salsa gases8350 8351 8352 !8353 !-- moved from boundary_conds8354 CALL salsa_boundary_conds8355 !8356 !-- Boundary conditions for prognostic quantitites of other modules:8357 !-- Here, only decycling is carried out8358 IF ( time_since_reference_point >= skip_time_do_salsa ) THEN8359 8360 DO ib = 1, nbins_aerosol8361 CALL salsa_boundary_conds( aerosol_number(ib)%conc_p, aerosol_number(ib)%init )8362 DO ic = 1, ncomponents_mass8363 icc = ( ic - 1 ) * nbins_aerosol + ib8364 CALL salsa_boundary_conds( aerosol_mass(icc)%conc_p, aerosol_mass(icc)%init )8365 ENDDO8366 ENDDO8367 IF ( .NOT. salsa_gases_from_chem ) THEN8368 DO ig = 1, ngases_salsa8369 CALL salsa_boundary_conds( salsa_gas(ig)%conc_p, salsa_gas(ig)%init )8370 ENDDO8371 ENDIF8372 8373 ENDIF8374 8375 END SUBROUTINE salsa_boundary_conditions8376 8377 !------------------------------------------------------------------------------!8378 ! Description:8379 ! ------------8380 8417 !> Boundary conditions for prognostic variables in SALSA 8381 8418 !------------------------------------------------------------------------------! 8382 SUBROUTINE salsa_boundary_cond s8419 SUBROUTINE salsa_boundary_conditions( horizontal_conditions_only ) 8383 8420 8384 8421 USE arrays_3d, & … … 8400 8437 INTEGER(iwp) :: m !< running index surface elements 8401 8438 8439 LOGICAL, OPTIONAL :: horizontal_conditions_only !< switch to set horizontal bc only 8440 8441 REAL(wp) :: flag !< flag to mask topography grid points 8442 8402 8443 IF ( time_since_reference_point >= skip_time_do_salsa ) THEN 8403 ! 8404 !-- Surface conditions: 8405 IF ( ibc_salsa_b == 0 ) THEN ! Dirichlet 8406 ! 8407 !-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k coordinate 8408 !-- belongs to the atmospheric grid point, therefore, set s_p at k-1 8409 DO l = 0, 1 8410 !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k ) 8411 !$OMP DO 8412 DO m = 1, bc_h(l)%ns 8413 8414 i = bc_h(l)%i(m) 8415 j = bc_h(l)%j(m) 8416 k = bc_h(l)%k(m) 8417 8418 DO ib = 1, nbins_aerosol 8419 aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = & 8420 aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i) 8421 DO ic = 1, ncomponents_mass 8422 icc = ( ic - 1 ) * nbins_aerosol + ib 8423 aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = & 8424 aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i) 8425 ENDDO 8426 ENDDO 8427 IF ( .NOT. salsa_gases_from_chem ) THEN 8428 DO ig = 1, ngases_salsa 8429 salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = & 8430 salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i) 8431 ENDDO 8432 ENDIF 8444 8445 IF ( .NOT. PRESENT( horizontal_conditions_only ) ) THEN 8446 ! 8447 !-- Surface conditions: 8448 IF ( ibc_aer_b == 0 ) THEN ! Dirichlet 8449 ! 8450 !-- Run loop over all non-natural and natural walls. Note, in wall-datatype the k 8451 !-- coordinate belongs to the atmospheric grid point, therefore, set s_p at k-1 8452 DO l = 0, 1 8453 !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k ) 8454 !$OMP DO 8455 DO m = 1, bc_h(l)%ns 8456 8457 i = bc_h(l)%i(m) 8458 j = bc_h(l)%j(m) 8459 k = bc_h(l)%k(m) 8460 8461 DO ib = 1, nbins_aerosol 8462 aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = & 8463 aerosol_number(ib)%conc(k+bc_h(l)%koff,j,i) 8464 DO ic = 1, ncomponents_mass 8465 icc = ( ic - 1 ) * nbins_aerosol + ib 8466 aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = & 8467 aerosol_mass(icc)%conc(k+bc_h(l)%koff,j,i) 8468 ENDDO 8469 ENDDO 8470 IF ( .NOT. salsa_gases_from_chem ) THEN 8471 DO ig = 1, ngases_salsa 8472 salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = & 8473 salsa_gas(ig)%conc(k+bc_h(l)%koff,j,i) 8474 ENDDO 8475 ENDIF 8476 8477 ENDDO 8478 !$OMP END PARALLEL 8433 8479 8434 8480 ENDDO 8435 !$OMP END PARALLEL 8436 8437 ENDDO 8438 8439 ELSE ! Neumann 8440 8441 DO l = 0, 1 8442 !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k ) 8443 !$OMP DO 8444 DO m = 1, bc_h(l)%ns 8445 8446 i = bc_h(l)%i(m) 8447 j = bc_h(l)%j(m) 8448 k = bc_h(l)%k(m) 8449 8450 DO ib = 1, nbins_aerosol 8451 aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = & 8452 aerosol_number(ib)%conc_p(k,j,i) 8453 DO ic = 1, ncomponents_mass 8454 icc = ( ic - 1 ) * nbins_aerosol + ib 8455 aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = & 8456 aerosol_mass(icc)%conc_p(k,j,i) 8457 ENDDO 8458 ENDDO 8459 IF ( .NOT. salsa_gases_from_chem ) THEN 8460 DO ig = 1, ngases_salsa 8461 salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = & 8462 salsa_gas(ig)%conc_p(k,j,i) 8463 ENDDO 8464 ENDIF 8465 8481 8482 ELSE ! Neumann 8483 8484 DO l = 0, 1 8485 !$OMP PARALLEL PRIVATE( ib, ic, icc, ig, i, j, k ) 8486 !$OMP DO 8487 DO m = 1, bc_h(l)%ns 8488 8489 i = bc_h(l)%i(m) 8490 j = bc_h(l)%j(m) 8491 k = bc_h(l)%k(m) 8492 8493 DO ib = 1, nbins_aerosol 8494 aerosol_number(ib)%conc_p(k+bc_h(l)%koff,j,i) = & 8495 aerosol_number(ib)%conc_p(k,j,i) 8496 DO ic = 1, ncomponents_mass 8497 icc = ( ic - 1 ) * nbins_aerosol + ib 8498 aerosol_mass(icc)%conc_p(k+bc_h(l)%koff,j,i) = & 8499 aerosol_mass(icc)%conc_p(k,j,i) 8500 ENDDO 8501 ENDDO 8502 IF ( .NOT. salsa_gases_from_chem ) THEN 8503 DO ig = 1, ngases_salsa 8504 salsa_gas(ig)%conc_p(k+bc_h(l)%koff,j,i) = salsa_gas(ig)%conc_p(k,j,i) 8505 ENDDO 8506 ENDIF 8507 8508 ENDDO 8509 !$OMP END PARALLEL 8466 8510 ENDDO 8467 !$OMP END PARALLEL 8468 ENDDO 8469 8470 ENDIF 8471 ! 8472 !-- Top boundary conditions: 8473 IF ( ibc_salsa_t == 0 ) THEN ! Dirichlet 8474 8475 DO ib = 1, nbins_aerosol 8476 aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:) 8477 DO ic = 1, ncomponents_mass 8478 icc = ( ic - 1 ) * nbins_aerosol + ib 8479 aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:) 8511 8512 ENDIF 8513 ! 8514 !-- Top boundary conditions: 8515 IF ( ibc_aer_t == 0 ) THEN ! Dirichlet 8516 8517 DO ib = 1, nbins_aerosol 8518 aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc(nzt+1,:,:) 8519 DO ic = 1, ncomponents_mass 8520 icc = ( ic - 1 ) * nbins_aerosol + ib 8521 aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc(nzt+1,:,:) 8522 ENDDO 8480 8523 ENDDO 8481 ENDDO 8482 IF ( .NOT. salsa_gases_from_chem ) THEN 8483 DO ig = 1, ngases_salsa 8484 salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:) 8524 IF ( .NOT. salsa_gases_from_chem ) THEN 8525 DO ig = 1, ngases_salsa 8526 salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc(nzt+1,:,:) 8527 ENDDO 8528 ENDIF 8529 8530 ELSEIF ( ibc_aer_t == 1 ) THEN ! Neumann 8531 8532 DO ib = 1, nbins_aerosol 8533 aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) 8534 DO ic = 1, ncomponents_mass 8535 icc = ( ic - 1 ) * nbins_aerosol + ib 8536 aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) 8537 ENDDO 8485 8538 ENDDO 8539 IF ( .NOT. salsa_gases_from_chem ) THEN 8540 DO ig = 1, ngases_salsa 8541 salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) 8542 ENDDO 8543 ENDIF 8544 8545 ELSEIF ( ibc_aer_t == 2 ) THEN ! Initial gradient 8546 8547 DO ib = 1, nbins_aerosol 8548 aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + & 8549 bc_an_t_val(ib) * dzu(nzt+1) 8550 DO ic = 1, ncomponents_mass 8551 icc = ( ic - 1 ) * nbins_aerosol + ib 8552 aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + & 8553 bc_am_t_val(icc) * dzu(nzt+1) 8554 ENDDO 8555 ENDDO 8556 IF ( .NOT. salsa_gases_from_chem ) THEN 8557 DO ig = 1, ngases_salsa 8558 salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + & 8559 bc_gt_t_val(ig) * dzu(nzt+1) 8560 ENDDO 8561 ENDIF 8562 8563 ENDIF ! top conditions 8564 8565 ! 8566 !-- Lateral boundary conditions 8567 IF ( bc_dirichlet_aer_s ) THEN 8568 8569 DO ib = 1, nbins_aerosol 8570 DO i = nxlg, nxrg 8571 DO k = nzb+1, nzt 8572 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8573 aerosol_number(ib)%conc_p(k,nys-1,i) = aerosol_number(ib)%init(k) * flag 8574 ENDDO 8575 ENDDO 8576 DO ic = 1, ncomponents_mass 8577 icc = ( ic - 1 ) * nbins_aerosol + ib 8578 DO i = nxlg, nxrg 8579 DO k = nzb+1, nzt 8580 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8581 aerosol_mass(icc)%conc_p(k,nys-1,i) = aerosol_mass(icc)%init(k) * flag 8582 ENDDO 8583 ENDDO 8584 ENDDO 8585 ENDDO 8586 IF ( .NOT. salsa_gases_from_chem ) THEN 8587 DO ig = 1, ngases_salsa 8588 DO i = nxlg, nxrg 8589 DO k = nzb+1, nzt 8590 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8591 salsa_gas(ig)%conc_p(k,nys-1,i) = salsa_gas(ig)%init(k) * flag 8592 ENDDO 8593 ENDDO 8594 ENDDO 8595 ENDIF 8596 8597 ELSEIF ( bc_radiation_aer_s ) THEN 8598 8599 DO ib = 1, nbins_aerosol 8600 DO i = nxlg, nxrg 8601 DO k = nzb+1, nzt 8602 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8603 aerosol_number(ib)%conc_p(k,nys-1,i) = aerosol_number(ib)%conc_p(k,nys,i) * flag 8604 ENDDO 8605 ENDDO 8606 DO ic = 1, ncomponents_mass 8607 icc = ( ic - 1 ) * nbins_aerosol + ib 8608 DO i = nxlg, nxrg 8609 DO k = nzb+1, nzt 8610 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8611 aerosol_mass(icc)%conc_p(k,nys-1,i) = aerosol_mass(icc)%conc_p(k,nys,i) * flag 8612 ENDDO 8613 ENDDO 8614 ENDDO 8615 ENDDO 8616 IF ( .NOT. salsa_gases_from_chem ) THEN 8617 DO ig = 1, ngases_salsa 8618 DO i = nxlg, nxrg 8619 DO k = nzb+1, nzt 8620 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8621 salsa_gas(ig)%conc_p(k,nys-1,i) = salsa_gas(ig)%conc_p(k,nys,i) * flag 8622 ENDDO 8623 ENDDO 8624 ENDDO 8625 ENDIF 8626 8486 8627 ENDIF 8487 8628 8488 ELSEIF ( ibc_salsa_t == 1 ) THEN ! Neumann 8489 8490 DO ib = 1, nbins_aerosol 8491 aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) 8492 DO ic = 1, ncomponents_mass 8493 icc = ( ic - 1 ) * nbins_aerosol + ib 8494 aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) 8629 IF ( bc_dirichlet_aer_n ) THEN 8630 8631 DO ib = 1, nbins_aerosol 8632 DO i = nxlg, nxrg 8633 DO k = nzb+1, nzt 8634 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8635 aerosol_number(ib)%conc_p(k,nyn+1,i) = aerosol_number(ib)%init(k) * flag 8636 ENDDO 8637 ENDDO 8638 DO ic = 1, ncomponents_mass 8639 icc = ( ic - 1 ) * nbins_aerosol + ib 8640 DO i = nxlg, nxrg 8641 DO k = nzb+1, nzt 8642 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8643 aerosol_mass(icc)%conc_p(k,nyn+1,i) = aerosol_mass(icc)%init(k) * flag 8644 ENDDO 8645 ENDDO 8646 ENDDO 8495 8647 ENDDO 8496 ENDDO 8497 IF ( .NOT. salsa_gases_from_chem ) THEN 8498 DO ig = 1, ngases_salsa 8499 salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) 8648 IF ( .NOT. salsa_gases_from_chem ) THEN 8649 DO ig = 1, ngases_salsa 8650 DO i = nxlg, nxrg 8651 DO k = nzb+1, nzt 8652 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8653 salsa_gas(ig)%conc_p(k,nyn+1,i) = salsa_gas(ig)%init(k) * flag 8654 ENDDO 8655 ENDDO 8656 ENDDO 8657 ENDIF 8658 8659 ELSEIF ( bc_radiation_aer_n ) THEN 8660 8661 DO ib = 1, nbins_aerosol 8662 DO i = nxlg, nxrg 8663 DO k = nzb+1, nzt 8664 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8665 aerosol_number(ib)%conc_p(k,nyn+1,i) = aerosol_number(ib)%conc_p(k,nyn,i) * flag 8666 ENDDO 8667 ENDDO 8668 DO ic = 1, ncomponents_mass 8669 icc = ( ic - 1 ) * nbins_aerosol + ib 8670 DO i = nxlg, nxrg 8671 DO k = nzb+1, nzt 8672 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8673 aerosol_mass(icc)%conc_p(k,nyn+1,i) = aerosol_mass(icc)%conc_p(k,nyn,i) * flag 8674 ENDDO 8675 ENDDO 8676 ENDDO 8500 8677 ENDDO 8678 IF ( .NOT. salsa_gases_from_chem ) THEN 8679 DO ig = 1, ngases_salsa 8680 DO i = nxlg, nxrg 8681 DO k = nzb+1, nzt 8682 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8683 salsa_gas(ig)%conc_p(k,nyn+1,i) = salsa_gas(ig)%conc_p(k,nyn,i) * flag 8684 ENDDO 8685 ENDDO 8686 ENDDO 8687 ENDIF 8688 8501 8689 ENDIF 8502 8690 8503 ELSEIF ( ibc_salsa_t == 2 ) THEN ! Initial gradient 8504 8505 DO ib = 1, nbins_aerosol 8506 aerosol_number(ib)%conc_p(nzt+1,:,:) = aerosol_number(ib)%conc_p(nzt,:,:) + & 8507 bc_an_t_val(ib) * dzu(nzt+1) 8508 DO ic = 1, ncomponents_mass 8509 icc = ( ic - 1 ) * nbins_aerosol + ib 8510 aerosol_mass(icc)%conc_p(nzt+1,:,:) = aerosol_mass(icc)%conc_p(nzt,:,:) + & 8511 bc_am_t_val(icc) * dzu(nzt+1) 8512 ENDDO 8513 ENDDO 8514 IF ( .NOT. salsa_gases_from_chem ) THEN 8515 DO ig = 1, ngases_salsa 8516 salsa_gas(ig)%conc_p(nzt+1,:,:) = salsa_gas(ig)%conc_p(nzt,:,:) + & 8517 bc_gt_t_val(ig) * dzu(nzt+1) 8518 ENDDO 8519 ENDIF 8520 8521 ENDIF 8522 ! 8523 !-- Lateral boundary conditions at the outflow 8524 IF ( bc_radiation_s ) THEN 8525 DO ib = 1, nbins_aerosol 8526 aerosol_number(ib)%conc_p(:,nys-1,:) = aerosol_number(ib)%conc_p(:,nys,:) 8527 DO ic = 1, ncomponents_mass 8528 icc = ( ic - 1 ) * nbins_aerosol + ib 8529 aerosol_mass(icc)%conc_p(:,nys-1,:) = aerosol_mass(icc)%conc_p(:,nys,:) 8530 ENDDO 8531 ENDDO 8532 IF ( .NOT. salsa_gases_from_chem ) THEN 8533 DO ig = 1, ngases_salsa 8534 salsa_gas(ig)%conc_p(:,nys-1,:) = salsa_gas(ig)%conc_p(:,nys,:) 8535 ENDDO 8536 ENDIF 8537 8538 ELSEIF ( bc_radiation_n ) THEN 8539 DO ib = 1, nbins_aerosol 8540 aerosol_number(ib)%conc_p(:,nyn+1,:) = aerosol_number(ib)%conc_p(:,nyn,:) 8541 DO ic = 1, ncomponents_mass 8542 icc = ( ic - 1 ) * nbins_aerosol + ib 8543 aerosol_mass(icc)%conc_p(:,nyn+1,:) = aerosol_mass(icc)%conc_p(:,nyn,:) 8544 ENDDO 8545 ENDDO 8546 IF ( .NOT. salsa_gases_from_chem ) THEN 8547 DO ig = 1, ngases_salsa 8548 salsa_gas(ig)%conc_p(:,nyn+1,:) = salsa_gas(ig)%conc_p(:,nyn,:) 8549 ENDDO 8550 ENDIF 8551 8552 ELSEIF ( bc_radiation_l ) THEN 8553 DO ib = 1, nbins_aerosol 8554 aerosol_number(ib)%conc_p(:,:,nxl-1) = aerosol_number(ib)%conc_p(:,:,nxl) 8555 DO ic = 1, ncomponents_mass 8556 icc = ( ic - 1 ) * nbins_aerosol + ib 8557 aerosol_mass(icc)%conc_p(:,:,nxl-1) = aerosol_mass(icc)%conc_p(:,:,nxl) 8558 ENDDO 8559 ENDDO 8560 IF ( .NOT. salsa_gases_from_chem ) THEN 8561 DO ig = 1, ngases_salsa 8562 salsa_gas(ig)%conc_p(:,:,nxl-1) = salsa_gas(ig)%conc_p(:,:,nxl) 8563 ENDDO 8564 ENDIF 8565 8566 ELSEIF ( bc_radiation_r ) THEN 8567 DO ib = 1, nbins_aerosol 8568 aerosol_number(ib)%conc_p(:,:,nxr+1) = aerosol_number(ib)%conc_p(:,:,nxr) 8569 DO ic = 1, ncomponents_mass 8570 icc = ( ic - 1 ) * nbins_aerosol + ib 8571 aerosol_mass(icc)%conc_p(:,:,nxr+1) = aerosol_mass(icc)%conc_p(:,:,nxr) 8572 ENDDO 8573 ENDDO 8574 IF ( .NOT. salsa_gases_from_chem ) THEN 8575 DO ig = 1, ngases_salsa 8576 salsa_gas(ig)%conc_p(:,:,nxr+1) = salsa_gas(ig)%conc_p(:,:,nxr) 8577 ENDDO 8578 ENDIF 8579 8580 ENDIF 8581 8582 ENDIF 8583 8584 END SUBROUTINE salsa_boundary_conds 8585 8586 !------------------------------------------------------------------------------! 8587 ! Description: 8588 ! ------------ 8589 ! Undoing of the previously done cyclic boundary conditions. 8590 !------------------------------------------------------------------------------! 8591 SUBROUTINE salsa_boundary_conds_decycle ( sq, sq_init ) 8592 8593 USE control_parameters, & 8594 ONLY: nesting_offline 8595 8596 IMPLICIT NONE 8597 8598 INTEGER(iwp) :: boundary !< 8599 INTEGER(iwp) :: ee !< 8600 INTEGER(iwp) :: copied !< 8601 INTEGER(iwp) :: i !< 8602 INTEGER(iwp) :: j !< 8603 INTEGER(iwp) :: k !< 8604 INTEGER(iwp) :: ss !< 8605 8606 REAL(wp) :: flag !< flag to mask topography grid points 8607 8608 REAL(wp), DIMENSION(nzb:nzt+1) :: sq_init !< initial concentration profile 8609 8610 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: sq !< concentration array 8611 8612 flag = 0.0_wp 8613 ! 8614 !-- Skip input if forcing from a larger-scale models is applied. 8615 IF ( nesting_offline .AND. nesting_offline_salsa ) RETURN 8616 ! 8617 !-- Left and right boundaries 8618 IF ( decycle_salsa_lr .AND. ( bc_lr_cyc .OR. bc_lr == 'nested' ) ) THEN 8619 8620 DO boundary = 1, 2 8621 8622 IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN 8623 ! 8624 !-- Initial profile is copied to ghost and first three layers 8625 ss = 1 8626 ee = 0 8627 IF ( boundary == 1 .AND. nxl == 0 ) THEN 8628 ss = nxlg 8629 ee = nxl-1 8630 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 8631 ss = nxr+1 8632 ee = nxrg 8633 ENDIF 8634 8635 DO i = ss, ee 8691 IF ( bc_dirichlet_aer_l ) THEN 8692 8693 DO ib = 1, nbins_aerosol 8636 8694 DO j = nysg, nyng 8637 8695 DO k = nzb+1, nzt 8638 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 8639 sq(k,j,i) = sq_init(k) * flag 8696 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8697 aerosol_number(ib)%conc_p(k,j,nxl-1) = aerosol_number(ib)%init(k) * flag 8698 ENDDO 8699 ENDDO 8700 DO ic = 1, ncomponents_mass 8701 icc = ( ic - 1 ) * nbins_aerosol + ib 8702 DO j = nysg, nyng 8703 DO k = nzb+1, nzt 8704 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8705 aerosol_mass(icc)%conc_p(k,j,nxl-1) = aerosol_mass(icc)%init(k) * flag 8706 ENDDO 8640 8707 ENDDO 8641 8708 ENDDO 8642 8709 ENDDO 8643 8644 ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN 8645 ! 8646 !-- The value at the boundary is copied to the ghost layers to simulate an outlet with 8647 !-- zero gradient 8648 ss = 1 8649 ee = 0 8650 IF ( boundary == 1 .AND. nxl == 0 ) THEN 8651 ss = nxlg 8652 ee = nxl-1 8653 copied = nxl 8654 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 8655 ss = nxr+1 8656 ee = nxrg 8657 copied = nxr 8710 IF ( .NOT. salsa_gases_from_chem ) THEN 8711 DO ig = 1, ngases_salsa 8712 DO j = nysg, nyng 8713 DO k = nzb+1, nzt 8714 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8715 salsa_gas(ig)%conc_p(k,j,nxl-1) = salsa_gas(ig)%init(k) * flag 8716 ENDDO 8717 ENDDO 8718 ENDDO 8658 8719 ENDIF 8659 8720 8660 DO i = ss, ee 8721 ELSEIF ( bc_radiation_aer_l ) THEN 8722 8723 DO ib = 1, nbins_aerosol 8661 8724 DO j = nysg, nyng 8662 8725 DO k = nzb+1, nzt 8663 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 8664 sq(k,j,i) = sq(k,j,copied) * flag 8726 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8727 aerosol_number(ib)%conc_p(k,j,nxl-1) = aerosol_number(ib)%conc_p(k,j,nxl) * flag 8728 ENDDO 8729 ENDDO 8730 DO ic = 1, ncomponents_mass 8731 icc = ( ic - 1 ) * nbins_aerosol + ib 8732 DO j = nysg, nyng 8733 DO k = nzb+1, nzt 8734 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8735 aerosol_mass(icc)%conc_p(k,j,nxl-1) = aerosol_mass(icc)%conc_p(k,j,nxl) * flag 8736 ENDDO 8665 8737 ENDDO 8666 8738 ENDDO 8667 8739 ENDDO 8668 8669 ELSE 8670 WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, & 8671 ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"' 8672 CALL message( 'salsa_boundary_conds_decycle', 'PA0626', 1, 2, 0, 6, 0 ) 8740 IF ( .NOT. salsa_gases_from_chem ) THEN 8741 DO ig = 1, ngases_salsa 8742 DO j = nysg, nyng 8743 DO k = nzb+1, nzt 8744 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8745 salsa_gas(ig)%conc_p(k,j,nxl-1) = salsa_gas(ig)%conc_p(k,j,nxl) * flag 8746 ENDDO 8747 ENDDO 8748 ENDDO 8749 ENDIF 8750 8673 8751 ENDIF 8674 ENDDO 8675 ENDIF 8676 8677 ! 8678 !-- South and north boundaries 8679 IF ( decycle_salsa_ns .AND. ( bc_ns_cyc .OR. bc_ns == 'nested' ) ) THEN 8680 8681 DO boundary = 3, 4 8682 8683 IF ( decycle_method_salsa(boundary) == 'dirichlet' ) THEN 8684 ! 8685 !-- Initial profile is copied to ghost and first three layers 8686 ss = 1 8687 ee = 0 8688 IF ( boundary == 3 .AND. nys == 0 ) THEN 8689 ss = nysg 8690 ee = nys-1 8691 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 8692 ss = nyn+1 8693 ee = nyng 8752 8753 IF ( bc_dirichlet_aer_r ) THEN 8754 8755 DO ib = 1, nbins_aerosol 8756 DO j = nysg, nyng 8757 DO k = nzb+1, nzt 8758 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 8759 aerosol_number(ib)%conc_p(k,j,nxr+1) = aerosol_number(ib)%init(k) * flag 8760 ENDDO 8761 ENDDO 8762 DO ic = 1, ncomponents_mass 8763 icc = ( ic - 1 ) * nbins_aerosol + ib 8764 DO j = nysg, nyng 8765 DO k = nzb+1, nzt 8766 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 8767 aerosol_mass(icc)%conc_p(k,j,nxr+1) = aerosol_mass(icc)%init(k) * flag 8768 ENDDO 8769 ENDDO 8770 ENDDO 8771 ENDDO 8772 IF ( .NOT. salsa_gases_from_chem ) THEN 8773 DO ig = 1, ngases_salsa 8774 DO j = nysg, nyng 8775 DO k = nzb+1, nzt 8776 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 8777 salsa_gas(ig)%conc_p(k,j,nxr+1) = salsa_gas(ig)%init(k) * flag 8778 ENDDO 8779 ENDDO 8780 ENDDO 8694 8781 ENDIF 8695 8782 8696 DO i = nxlg, nxrg 8697 DO j = ss, ee 8783 ELSEIF ( bc_radiation_aer_r ) THEN 8784 8785 DO ib = 1, nbins_aerosol 8786 DO j = nysg, nyng 8698 8787 DO k = nzb+1, nzt 8699 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 8700 sq(k,j,i) = sq_init(k) * flag 8788 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 8789 aerosol_number(ib)%conc_p(k,j,nxr+1) = aerosol_number(ib)%conc_p(k,j,nxr) * flag 8790 ENDDO 8791 ENDDO 8792 DO ic = 1, ncomponents_mass 8793 icc = ( ic - 1 ) * nbins_aerosol + ib 8794 DO j = nysg, nyng 8795 DO k = nzb+1, nzt 8796 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 8797 aerosol_mass(icc)%conc_p(k,j,nxr+1) = aerosol_mass(icc)%conc_p(k,j,nxr) * flag 8798 ENDDO 8701 8799 ENDDO 8702 8800 ENDDO 8703 8801 ENDDO 8704 8705 ELSEIF ( decycle_method_salsa(boundary) == 'neumann' ) THEN 8706 ! 8707 !-- The value at the boundary is copied to the ghost layers to simulate an outlet with 8708 !-- zero gradient 8709 ss = 1 8710 ee = 0 8711 IF ( boundary == 3 .AND. nys == 0 ) THEN 8712 ss = nysg 8713 ee = nys-1 8714 copied = nys 8715 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 8716 ss = nyn+1 8717 ee = nyng 8718 copied = nyn 8802 IF ( .NOT. salsa_gases_from_chem ) THEN 8803 DO ig = 1, ngases_salsa 8804 DO j = nysg, nyng 8805 DO k = nzb+1, nzt 8806 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 8807 salsa_gas(ig)%conc_p(k,j,nxr+1) = salsa_gas(ig)%conc_p(k,j,nxr) * flag 8808 ENDDO 8809 ENDDO 8810 ENDDO 8719 8811 ENDIF 8720 8812 8721 DO i = nxlg, nxrg 8722 DO j = ss, ee 8813 ENDIF 8814 8815 ELSE 8816 ! 8817 !-- Conditions for timelevel t (if called from salsa_exchange_horiz_bounds). 8818 !-- Only horizontal boundary conditions are set here. 8819 IF ( bc_dirichlet_aer_s ) THEN 8820 8821 DO ib = 1, nbins_aerosol 8822 DO i = nxlg, nxrg 8723 8823 DO k = nzb+1, nzt 8724 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 8725 sq(k,j,i) = sq(k,copied,i) * flag 8824 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8825 aerosol_number(ib)%conc(k,nys-1,i) = aerosol_number(ib)%init(k) * flag 8826 ENDDO 8827 ENDDO 8828 DO ic = 1, ncomponents_mass 8829 icc = ( ic - 1 ) * nbins_aerosol + ib 8830 DO i = nxlg, nxrg 8831 DO k = nzb+1, nzt 8832 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8833 aerosol_mass(icc)%conc(k,nys-1,i) = aerosol_mass(icc)%init(k) * flag 8834 ENDDO 8726 8835 ENDDO 8727 8836 ENDDO 8728 8837 ENDDO 8729 8730 ELSE 8731 WRITE(message_string,*) 'unknown decycling method: decycle_method_salsa (', boundary, & 8732 ') ="' // TRIM( decycle_method_salsa(boundary) ) // '"' 8733 CALL message( 'salsa_boundary_conds_decycle', 'PA0627', 1, 2, 0, 6, 0 ) 8838 IF ( .NOT. salsa_gases_from_chem ) THEN 8839 DO ig = 1, ngases_salsa 8840 DO i = nxlg, nxrg 8841 DO k = nzb+1, nzt 8842 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8843 salsa_gas(ig)%conc(k,nys-1,i) = salsa_gas(ig)%init(k) * flag 8844 ENDDO 8845 ENDDO 8846 ENDDO 8847 ENDIF 8848 8849 ELSEIF ( bc_radiation_aer_s ) THEN 8850 8851 DO ib = 1, nbins_aerosol 8852 DO i = nxlg, nxrg 8853 DO k = nzb+1, nzt 8854 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8855 aerosol_number(ib)%conc(k,nys-1,i) = aerosol_number(ib)%conc(k,nys,i) * flag 8856 ENDDO 8857 ENDDO 8858 DO ic = 1, ncomponents_mass 8859 icc = ( ic - 1 ) * nbins_aerosol + ib 8860 DO i = nxlg, nxrg 8861 DO k = nzb+1, nzt 8862 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8863 aerosol_mass(icc)%conc(k,nys-1,i) = aerosol_mass(icc)%conc(k,nys,i) * flag 8864 ENDDO 8865 ENDDO 8866 ENDDO 8867 ENDDO 8868 IF ( .NOT. salsa_gases_from_chem ) THEN 8869 DO ig = 1, ngases_salsa 8870 DO i = nxlg, nxrg 8871 DO k = nzb+1, nzt 8872 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nys-1,i), 0 ) ) 8873 salsa_gas(ig)%conc(k,nys-1,i) = salsa_gas(ig)%conc(k,nys,i) * flag 8874 ENDDO 8875 ENDDO 8876 ENDDO 8877 ENDIF 8878 8734 8879 ENDIF 8735 ENDDO 8736 ENDIF 8737 8738 END SUBROUTINE salsa_boundary_conds_decycle 8880 8881 IF ( bc_dirichlet_aer_n ) THEN 8882 8883 DO ib = 1, nbins_aerosol 8884 DO i = nxlg, nxrg 8885 DO k = nzb+1, nzt 8886 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8887 aerosol_number(ib)%conc(k,nyn+1,i) = aerosol_number(ib)%init(k) * flag 8888 ENDDO 8889 ENDDO 8890 DO ic = 1, ncomponents_mass 8891 icc = ( ic - 1 ) * nbins_aerosol + ib 8892 DO i = nxlg, nxrg 8893 DO k = nzb+1, nzt 8894 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8895 aerosol_mass(icc)%conc(k,nyn+1,i) = aerosol_mass(icc)%init(k) * flag 8896 ENDDO 8897 ENDDO 8898 ENDDO 8899 ENDDO 8900 IF ( .NOT. salsa_gases_from_chem ) THEN 8901 DO ig = 1, ngases_salsa 8902 DO i = nxlg, nxrg 8903 DO k = nzb+1, nzt 8904 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8905 salsa_gas(ig)%conc(k,nyn+1,i) = salsa_gas(ig)%init(k) * flag 8906 ENDDO 8907 ENDDO 8908 ENDDO 8909 ENDIF 8910 8911 ELSEIF ( bc_radiation_aer_n ) THEN 8912 8913 DO ib = 1, nbins_aerosol 8914 DO i = nxlg, nxrg 8915 DO k = nzb+1, nzt 8916 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8917 aerosol_number(ib)%conc(k,nyn+1,i) = aerosol_number(ib)%conc(k,nyn,i) * flag 8918 ENDDO 8919 ENDDO 8920 DO ic = 1, ncomponents_mass 8921 icc = ( ic - 1 ) * nbins_aerosol + ib 8922 DO i = nxlg, nxrg 8923 DO k = nzb+1, nzt 8924 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8925 aerosol_mass(icc)%conc(k,nyn+1,i) = aerosol_mass(icc)%conc(k,nyn,i) * flag 8926 ENDDO 8927 ENDDO 8928 ENDDO 8929 ENDDO 8930 IF ( .NOT. salsa_gases_from_chem ) THEN 8931 DO ig = 1, ngases_salsa 8932 DO i = nxlg, nxrg 8933 DO k = nzb+1, nzt 8934 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,nyn+1,i), 0 ) ) 8935 salsa_gas(ig)%conc(k,nyn+1,i) = salsa_gas(ig)%conc(k,nyn,i) * flag 8936 ENDDO 8937 ENDDO 8938 ENDDO 8939 ENDIF 8940 8941 ENDIF 8942 8943 IF ( bc_dirichlet_aer_l ) THEN 8944 8945 DO ib = 1, nbins_aerosol 8946 DO j = nysg, nyng 8947 DO k = nzb+1, nzt 8948 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8949 aerosol_number(ib)%conc(k,j,nxl-1) = aerosol_number(ib)%init(k) * flag 8950 ENDDO 8951 ENDDO 8952 DO ic = 1, ncomponents_mass 8953 icc = ( ic - 1 ) * nbins_aerosol + ib 8954 DO j = nysg, nyng 8955 DO k = nzb+1, nzt 8956 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8957 aerosol_mass(icc)%conc(k,j,nxl-1) = aerosol_mass(icc)%init(k) * flag 8958 ENDDO 8959 ENDDO 8960 ENDDO 8961 ENDDO 8962 IF ( .NOT. salsa_gases_from_chem ) THEN 8963 DO ig = 1, ngases_salsa 8964 DO j = nysg, nyng 8965 DO k = nzb+1, nzt 8966 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8967 salsa_gas(ig)%conc(k,j,nxl-1) = salsa_gas(ig)%init(k) * flag 8968 ENDDO 8969 ENDDO 8970 ENDDO 8971 ENDIF 8972 8973 ELSEIF ( bc_radiation_aer_l ) THEN 8974 8975 DO ib = 1, nbins_aerosol 8976 DO j = nysg, nyng 8977 DO k = nzb+1, nzt 8978 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8979 aerosol_number(ib)%conc(k,j,nxl-1) = aerosol_number(ib)%conc(k,j,nxl) * flag 8980 ENDDO 8981 ENDDO 8982 DO ic = 1, ncomponents_mass 8983 icc = ( ic - 1 ) * nbins_aerosol + ib 8984 DO j = nysg, nyng 8985 DO k = nzb+1, nzt 8986 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8987 aerosol_mass(icc)%conc(k,j,nxl-1) = aerosol_mass(icc)%conc(k,j,nxl) * flag 8988 ENDDO 8989 ENDDO 8990 ENDDO 8991 ENDDO 8992 IF ( .NOT. salsa_gases_from_chem ) THEN 8993 DO ig = 1, ngases_salsa 8994 DO j = nysg, nyng 8995 DO k = nzb+1, nzt 8996 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxl-1), 0 ) ) 8997 salsa_gas(ig)%conc(k,j,nxl-1) = salsa_gas(ig)%conc(k,j,nxl) * flag 8998 ENDDO 8999 ENDDO 9000 ENDDO 9001 ENDIF 9002 9003 ENDIF 9004 9005 IF ( bc_dirichlet_aer_r ) THEN 9006 9007 DO ib = 1, nbins_aerosol 9008 DO j = nysg, nyng 9009 DO k = nzb+1, nzt 9010 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 9011 aerosol_number(ib)%conc(k,j,nxr+1) = aerosol_number(ib)%init(k) * flag 9012 ENDDO 9013 ENDDO 9014 DO ic = 1, ncomponents_mass 9015 icc = ( ic - 1 ) * nbins_aerosol + ib 9016 DO j = nysg, nyng 9017 DO k = nzb+1, nzt 9018 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 9019 aerosol_mass(icc)%conc(k,j,nxr+1) = aerosol_mass(icc)%init(k) * flag 9020 ENDDO 9021 ENDDO 9022 ENDDO 9023 ENDDO 9024 IF ( .NOT. salsa_gases_from_chem ) THEN 9025 DO ig = 1, ngases_salsa 9026 DO j = nysg, nyng 9027 DO k = nzb+1, nzt 9028 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 9029 salsa_gas(ig)%conc(k,j,nxr+1) = salsa_gas(ig)%init(k) * flag 9030 ENDDO 9031 ENDDO 9032 ENDDO 9033 ENDIF 9034 9035 ELSEIF ( bc_radiation_aer_r ) THEN 9036 9037 DO ib = 1, nbins_aerosol 9038 DO j = nysg, nyng 9039 DO k = nzb+1, nzt 9040 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 9041 aerosol_number(ib)%conc(k,j,nxr+1) = aerosol_number(ib)%conc(k,j,nxr) * flag 9042 ENDDO 9043 ENDDO 9044 DO ic = 1, ncomponents_mass 9045 icc = ( ic - 1 ) * nbins_aerosol + ib 9046 DO j = nysg, nyng 9047 DO k = nzb+1, nzt 9048 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 9049 aerosol_mass(icc)%conc(k,j,nxr+1) = aerosol_mass(icc)%conc(k,j,nxr) * flag 9050 ENDDO 9051 ENDDO 9052 ENDDO 9053 ENDDO 9054 IF ( .NOT. salsa_gases_from_chem ) THEN 9055 DO ig = 1, ngases_salsa 9056 DO j = nysg, nyng 9057 DO k = nzb+1, nzt 9058 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,nxr+1), 0 ) ) 9059 salsa_gas(ig)%conc(k,j,nxr+1) = salsa_gas(ig)%conc(k,j,nxr) * flag 9060 ENDDO 9061 ENDDO 9062 ENDDO 9063 ENDIF 9064 9065 ENDIF 9066 9067 ENDIF ! PRESENT( horizontal conditions only ) 9068 9069 ENDIF 9070 9071 END SUBROUTINE salsa_boundary_conditions 9072 8739 9073 8740 9074 !------------------------------------------------------------------------------! -
palm/trunk/SOURCE/time_integration.f90
r4502 r4508 25 25 ! ----------------- 26 26 ! $Id$ 27 ! salsa decycling replaced by explicit setting of lateral boundary conditions 28 ! 29 ! 4502 2020-04-17 16:14:16Z schwenkel 27 30 ! Implementation of ice microphysics 28 31 ! … … 213 216 214 217 USE arrays_3d, & 215 ONLY: diss, diss_p, dzu, e_p, nc_p, nr_p, prho, pt, pt_p, pt_init, q, qc_p, qr_p, q_init, & 216 q_p, ref_state, rho_ocean, sa_p, s_p, tend, u, u_p, v, vpt, v_p, w_p, & 217 qi_p, ni_p 218 ONLY: diss, diss_p, dzu, e_p, nc_p, ni_p, nr_p, prho, pt, pt_p, pt_init, q, qc_p, qr_p, & 219 q_init, q_p, qi_p, ref_state, rho_ocean, sa_p, s_p, tend, u, u_p, v, vpt, v_p, w_p 218 220 219 221 #if defined( __parallel ) && ! defined( _OPENACC ) 220 222 USE arrays_3d, & 221 ONLY: e, nc, n r, qc, qr, s, w, qi, ni223 ONLY: e, nc, ni, nr, qc, qi, qr, s, w 222 224 #endif 223 225 … … 228 230 USE bulk_cloud_model_mod, & 229 231 ONLY: bulk_cloud_model, calc_liquid_water_content, collision_turbulence, & 230 microphysics_ morrison, microphysics_seifert, microphysics_ice_extension232 microphysics_ice_extension, microphysics_morrison, microphysics_seifert 231 233 232 234 USE calc_mean_profile_mod, & … … 274 276 time_dopr_listing, time_dopts, time_dosp, time_dosp_av, time_dots, time_do_av, & 275 277 time_do_sla, time_disturb, time_run_control, time_since_reference_point, & 276 t urbulent_inflow, turbulent_outflow, urban_surface,&278 timestep_count, turbulent_inflow, turbulent_outflow, urban_surface, & 277 279 use_initial_profile_as_reference, use_single_reference_value, u_gtrans, v_gtrans, & 278 virtual_flight, virtual_measurement, ws_scheme_mom, ws_scheme_sca , timestep_count280 virtual_flight, virtual_measurement, ws_scheme_mom, ws_scheme_sca 279 281 280 282 #if defined( __parallel ) … … 365 367 USE salsa_mod, & 366 368 ONLY: aerosol_number, aerosol_mass, bc_am_t_val, bc_an_t_val, bc_gt_t_val, & 367 nbins_aerosol, ncomponents_mass, ngases_salsa, salsa_boundary_conds, & 368 salsa_emission_update, salsa_gas, salsa_gases_from_chem, skip_time_do_salsa 369 communicator_salsa, nbins_aerosol, ncomponents_mass, ngases_salsa, & 370 salsa_boundary_conditions, salsa_emission_update, salsa_gas, salsa_gases_from_chem, & 371 skip_time_do_salsa 369 372 370 373 USE spectra_mod, & … … 434 437 flux_s_w, & 435 438 heatflux_output_conversion, & 436 kh, km, momentumflux_output_conversion, nc, n r, p, ptdf_x, ptdf_y, qc, qr, rdf, &439 kh, km, momentumflux_output_conversion, nc, ni, nr, p, ptdf_x, ptdf_y, qc, qi, qr, rdf, & 437 440 rdf_sc, rho_air, rho_air_zw, s, tdiss_m, te_m, tpt_m, tu_m, tv_m, tw_m, ug, u_init, & 438 u_stokes_zu, vg, v_init, v_stokes_zu, w, zu , qi, ni441 u_stokes_zu, vg, v_init, v_stokes_zu, w, zu 439 442 440 443 USE control_parameters, & … … 448 451 sums_wsus_ws_l, sums_vs2_ws_l, sums_wsvs_ws_l, sums_ws2_ws_l, sums_wspts_ws_l, & 449 452 sums_wsqs_ws_l, sums_wssas_ws_l, sums_wsqcs_ws_l, sums_wsqrs_ws_l, sums_wsncs_ws_l, & 450 sums_wsnrs_ws_l, sums_wsss_ws_l, weight_substep, sums_salsa_ws_l, 451 sums_ws qis_ws_l, sums_wsnis_ws_l453 sums_wsnrs_ws_l, sums_wsss_ws_l, weight_substep, sums_salsa_ws_l, sums_wsqis_ws_l, & 454 sums_wsnis_ws_l 452 455 453 456 USE surface_mod, & … … 703 706 CALL module_interface_actions( 'before_timestep' ) 704 707 708 ! 705 709 !-- Start of intermediate step loop 706 710 intermediate_timestep_count = 0 … … 770 774 CALL prognostic_equations_vector 771 775 ENDIF 776 772 777 ! 773 778 !-- Movement of agents in multi agent system … … 826 831 IF ( salsa .AND. time_since_reference_point >= skip_time_do_salsa ) THEN 827 832 DO ib = 1, nbins_aerosol 828 CALL exchange_horiz( aerosol_number(ib)%conc_p, nbgp ) 833 CALL exchange_horiz( aerosol_number(ib)%conc_p, nbgp, & 834 alternative_communicator = communicator_salsa ) 829 835 DO ic = 1, ncomponents_mass 830 836 icc = ( ic - 1 ) * nbins_aerosol + ib 831 CALL exchange_horiz( aerosol_mass(icc)%conc_p, nbgp ) 837 CALL exchange_horiz( aerosol_mass(icc)%conc_p, nbgp, & 838 alternative_communicator = communicator_salsa ) 832 839 ENDDO 833 840 ENDDO 834 841 IF ( .NOT. salsa_gases_from_chem ) THEN 835 842 DO ig = 1, ngases_salsa 836 CALL exchange_horiz( salsa_gas(ig)%conc_p, nbgp ) 843 CALL exchange_horiz( salsa_gas(ig)%conc_p, nbgp, & 844 alternative_communicator = communicator_salsa ) 837 845 ENDDO 838 846 ENDIF 839 847 ENDIF 848 840 849 CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'stop' ) 841 850 … … 845 854 !-- boundary conditions for module-specific variables 846 855 CALL module_interface_boundary_conditions 856 847 857 ! 848 858 !-- Incrementing timestep counter … … 906 916 ENDIF 907 917 IF ( bulk_cloud_model .AND. microphysics_ice_extension ) THEN 908 909 918 CALL exchange_horiz( qi, nbgp ) 919 CALL exchange_horiz( ni, nbgp ) 910 920 ENDIF 921 911 922 ENDIF 912 923 … … 927 938 IF ( salsa .AND. time_since_reference_point >= skip_time_do_salsa ) THEN 928 939 DO ib = 1, nbins_aerosol 929 CALL exchange_horiz( aerosol_number(ib)%conc, nbgp ) 940 CALL exchange_horiz( aerosol_number(ib)%conc, nbgp, & 941 alternative_communicator = communicator_salsa ) 930 942 DO ic = 1, ncomponents_mass 931 943 icc = ( ic - 1 ) * nbins_aerosol + ib 932 CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp ) 944 CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp, & 945 alternative_communicator = communicator_salsa ) 933 946 ENDDO 934 947 ENDDO 935 948 IF ( .NOT. salsa_gases_from_chem ) THEN 936 949 DO ig = 1, ngases_salsa 937 CALL exchange_horiz( salsa_gas(ig)%conc, nbgp ) 950 CALL exchange_horiz( salsa_gas(ig)%conc, nbgp, & 951 alternative_communicator = communicator_salsa ) 938 952 ENDDO 939 953 ENDIF … … 960 974 ENDDO 961 975 ENDDO 962 ENDIF963 964 !965 !-- Set SALSA boundary conditions (decycling)966 IF ( salsa .AND. time_since_reference_point >= skip_time_do_salsa ) THEN967 DO ib = 1, nbins_aerosol968 CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )969 DO ic = 1, ncomponents_mass970 icc = ( ic - 1 ) * nbins_aerosol + ib971 CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )972 ENDDO973 ENDDO974 IF ( .NOT. salsa_gases_from_chem ) THEN975 DO ig = 1, ngases_salsa976 CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )977 ENDDO978 ENDIF979 976 ENDIF 980 977
Note: See TracChangeset
for help on using the changeset viewer.
