Changeset 3899 for palm/trunk/SOURCE
- Timestamp:
- Apr 16, 2019 2:05:27 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
prognostic_equations.f90 (modified) (8 diffs)
-
salsa_mod.f90 (modified) (72 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/prognostic_equations.f90
r3887 r3899 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Corrections in the OpenMP version of salsa 28 ! 29 ! 3887 2019-04-12 08:47:41Z schwenkel 27 30 ! Implicit Bugfix for chemistry model, loop for non_transport_physics over 28 31 ! ghost points is avoided. Instead introducing module_interface_exchange_horiz. … … 562 565 THEN 563 566 CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' ) 564 !$OMP PARALLEL PRIVATE (i,j,ib,ic,icc,ig) 567 !$OMP PARALLEL PRIVATE (i,j) 568 ! 569 !-- Call salsa processes 565 570 !$OMP DO 566 !567 !-- Call salsa processes568 571 DO i = nxl, nxr 569 572 DO j = nys, nyn … … 573 576 ENDDO 574 577 ENDDO 578 !$OMP END PARALLEL 575 579 576 580 CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' ) 577 581 578 582 CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'start' ) 579 583 ! … … 599 603 ENDIF 600 604 CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' ) 601 602 !$OMP END PARALLEL603 605 last_salsa_time = time_since_reference_point 604 606 … … 631 633 !-- Tendency terms for u-velocity component. Please note, in case of 632 634 !-- non-cyclic boundary conditions the grid point i=0 is excluded from 633 !-- the prognostic equations for the u-component. 635 !-- the prognostic equations for the u-component. 634 636 IF ( i >= nxlu ) THEN 635 637 … … 1175 1177 THEN 1176 1178 CALL cpu_log( log_point_s(90), 'salsa processes ', 'start' ) 1177 !$OMP PARALLEL PRIVATE (i,j ,ib,ic,icc,ig)1179 !$OMP PARALLEL PRIVATE (i,j) 1178 1180 !$OMP DO 1179 1181 ! … … 1186 1188 ENDDO 1187 1189 ENDDO 1190 !$OMP END PARALLEL 1188 1191 1189 1192 CALL cpu_log( log_point_s(90), 'salsa processes ', 'stop' ) … … 1210 1213 ENDIF 1211 1214 CALL cpu_log( log_point_s(91), 'salsa exch-horiz ', 'stop' ) 1212 !$OMP END PARALLEL1213 1215 last_salsa_time = time_since_reference_point 1214 1216 ENDIF -
palm/trunk/SOURCE/salsa_mod.f90
r3885 r3899 26 26 ! ----------------- 27 27 ! $Id$ 28 ! 2018-04-11 monakurppa 29 ! - remove unnecessary error / location messages 30 ! - corrected some error message numbers 31 ! - allocate source arrays only if emissions or dry deposition is applied. 32 ! 3885 2019-04-11 11:29:34Z kanani 28 33 ! Changes related to global restructuring of location messages and introduction 29 34 ! of additional debug messages … … 130 135 !> @todo Apply information from emission_stack_height to lift emission sources 131 136 !> @todo emission mode "parameterized", i.e. based on street type 137 !> @todo Allow insoluble emissions 138 !> @todo two-way nesting is not working properly 132 139 !------------------------------------------------------------------------------! 133 140 MODULE salsa_mod … … 162 169 ! 163 170 !-- Local constants: 164 INTEGER(iwp), PARAMETER :: luc_urban = 8 !< default landuse type for urban: use desert!171 INTEGER(iwp), PARAMETER :: luc_urban = 15 !< default landuse type for urban 165 172 INTEGER(iwp), PARAMETER :: ngases_salsa = 5 !< total number of gaseous tracers: 166 173 !< 1 = H2SO4, 2 = HNO3, 3 = NH3, 4 = OCNV … … 306 313 INTEGER(iwp) :: index_bc = -1 !< index for black carbon (BC) 307 314 INTEGER(iwp) :: index_du = -1 !< index for dust 308 INTEGER(iwp) :: igctyp = 0 !< Initial gas concentration type309 !< 0 = uniform (read from PARIN)310 !< 1 = read vertical profile from an input file311 315 INTEGER(iwp) :: index_nh = -1 !< index for NH3 312 316 INTEGER(iwp) :: index_no = -1 !< index for HNO3 313 317 INTEGER(iwp) :: index_oc = -1 !< index for organic carbon (OC) 314 INTEGER(iwp) :: isdtyp = 0 !< Initial size distribution type 318 INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4 319 INTEGER(iwp) :: index_ss = -1 !< index for sea salt 320 INTEGER(iwp) :: init_aerosol_type = 0 !< Initial size distribution type 315 321 !< 0 = uniform (read from PARIN) 316 322 !< 1 = read vertical profile of the mode number 317 323 !< concentration from an input file 318 INTEGER(iwp) :: index_so4 = -1 !< index for SO4 or H2SO4 319 INTEGER(iwp) :: index_ss = -1 !< index for sea salt 324 INTEGER(iwp) :: init_gases_type = 0 !< Initial gas concentration type 325 !< 0 = uniform (read from PARIN) 326 !< 1 = read vertical profile from an input file 320 327 INTEGER(iwp) :: lod_gas_emissions = 0 !< level of detail of the gaseous emission data 321 328 INTEGER(iwp) :: nbins_aerosol = 1 !< total number of size bins … … 357 364 LOGICAL :: decycle_lr = .FALSE. !< Undo cyclic boundary conditions: left and right 358 365 LOGICAL :: decycle_ns = .FALSE. !< north and south boundaries 366 LOGICAL :: include_emission = .FALSE. !< include or not emissions 359 367 LOGICAL :: feedback_to_palm = .FALSE. !< allow feedback due to condensation of H2O 360 368 LOGICAL :: nest_salsa = .FALSE. !< apply nesting for salsa … … 405 413 !-- standard deviation (sigmag) and concentration (n_lognorm, #/m3) 406 414 REAL(wp), DIMENSION(nmod) :: dpg = & 407 (/0.013_wp, 0.054_wp, 0.86_wp, 0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp/)415 (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/) 408 416 REAL(wp), DIMENSION(nmod) :: sigmag = & 409 417 (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/) … … 423 431 !-- listspec) for both a (soluble) and b (insoluble) bins. 424 432 REAL(wp), DIMENSION(nmod) :: aerosol_flux_dpg = & 425 (/0.013_wp, 0.054_wp, 0.86_wp, 0.2_wp, 0.2_wp, 0.2_wp, 0.2_wp/)433 (/1.3E-8_wp, 5.4E-8_wp, 8.6E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp, 2.0E-7_wp/) 426 434 REAL(wp), DIMENSION(nmod) :: aerosol_flux_sigmag = & 427 435 (/1.8_wp, 2.16_wp, 2.21_wp, 2.0_wp, 2.0_wp, 2.0_wp, 2.0_wp/) 428 REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = &429 (/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/)430 436 REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_a = & 431 437 (/1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) 432 438 REAL(wp), DIMENSION(maxspec) :: aerosol_flux_mass_fracs_b = & 433 439 (/0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0/) 440 REAL(wp), DIMENSION(nmod) :: surface_aerosol_flux = & 441 (/1.04e+11_wp, 3.23E+10_wp, 5.4E+6_wp, 0.0_wp, 0.0_wp, 0.0_wp, 0.0_wp/) 434 442 435 443 REAL(wp), DIMENSION(:), ALLOCATABLE :: bin_low_limits !< to deliver information about … … 795 803 decycle_method, decycle_ns, depo_pcm_par, depo_pcm_type, & 796 804 depo_surf_par, dpg, dt_salsa, feedback_to_palm, h2so4_init, & 797 hno3_init, i gctyp, isdtyp, listspec, mass_fracs_a,&798 mass_fracs_ b, n_lognorm, nbin, nest_salsa, nf2a, nh3_init,&799 n j3, nlcnd, nlcndgas, nlcndh2oae, nlcoag, nldepo, nldepo_pcm,&800 nldepo_ surf, nldistupdate, nsnucl, ocnv_init, ocsv_init,&801 read_restart_data_salsa, reglim, salsa, salsa_emission_mode,&802 s igmag, skip_time_do_salsa, surface_aerosol_flux,&803 van_der_waals_coagc, write_binary_salsa805 hno3_init, init_gases_type, init_aerosol_type, listspec, & 806 mass_fracs_a, mass_fracs_b, n_lognorm, nbin, nest_salsa, nf2a,& 807 nh3_init, nj3, nlcnd, nlcndgas, nlcndh2oae, nlcoag, nldepo, & 808 nldepo_pcm, nldepo_surf, nldistupdate, nsnucl, ocnv_init, & 809 ocsv_init, read_restart_data_salsa, reglim, salsa, & 810 salsa_emission_mode, sigmag, skip_time_do_salsa, & 811 surface_aerosol_flux, van_der_waals_coagc, write_binary_salsa 804 812 805 813 line = ' ' … … 867 875 ENDIF 868 876 869 IF ( salsa_emission_mode == 'read_from_file' .AND. ibc_salsa_b == 0 ) THEN870 message_string = 'salsa_emission_mode == read_from_filerequires bc_salsa_b = "Neumann"'877 IF ( salsa_emission_mode /= 'no_emission' .AND. ibc_salsa_b == 0 ) THEN 878 message_string = 'salsa_emission_mode /= "no_emission" requires bc_salsa_b = "Neumann"' 871 879 CALL message( 'salsa_check_parameters','PA0598', 1, 2, 0, 6, 0 ) 872 880 ENDIF 881 882 IF ( salsa_emission_mode /= 'no_emission' ) include_emission = .TRUE. 873 883 874 884 END SUBROUTINE salsa_check_parameters … … 960 970 ENDIF 961 971 WRITE( io, 7 ) 962 IF ( nsnucl > 0 ) THEN 963 WRITE( io, 8 ) nsnucl, nj3 964 ENDIF 965 IF ( nlcoag ) THEN 966 WRITE( io, 9 ) 967 ENDIF 968 IF ( nlcnd ) THEN 969 WRITE( io, 10 ) nlcndgas, nlcndh2oae 970 ENDIF 971 IF ( lspartition ) THEN 972 WRITE( io, 11 ) 973 ENDIF 974 IF ( nldepo ) THEN 975 WRITE( io, 12 ) nldepo_pcm, nldepo_surf 976 ENDIF 972 IF ( nsnucl > 0 ) WRITE( io, 8 ) nsnucl, nj3 973 IF ( nlcoag ) WRITE( io, 9 ) 974 IF ( nlcnd ) WRITE( io, 10 ) nlcndgas, nlcndh2oae 975 IF ( lspartition ) WRITE( io, 11 ) 976 IF ( nldepo ) WRITE( io, 12 ) nldepo_pcm, nldepo_surf 977 977 WRITE( io, 13 ) reglim, nbin, bin_low_limits 978 IF ( i sdtyp== 0 ) WRITE( io, 14 ) nsect978 IF ( init_aerosol_type == 0 ) WRITE( io, 14 ) nsect 979 979 WRITE( io, 15 ) ncc, listspec, mass_fracs_a, mass_fracs_b 980 980 IF ( .NOT. salsa_gases_from_chem ) THEN 981 981 WRITE( io, 16 ) ngases_salsa, h2so4_init, hno3_init, nh3_init, ocnv_init, ocsv_init 982 982 ENDIF 983 WRITE( io, 17 ) i sdtyp, igctyp984 IF ( i sdtyp== 0 ) THEN983 WRITE( io, 17 ) init_aerosol_type, init_gases_type 984 IF ( init_aerosol_type == 0 ) THEN 985 985 WRITE( io, 18 ) dpg, sigmag, n_lognorm 986 986 ELSE … … 989 989 IF ( nest_salsa ) WRITE( io, 20 ) nest_salsa 990 990 WRITE( io, 21 ) salsa_emission_mode 991 991 IF ( salsa_emission_mode == 'uniform' ) THEN 992 WRITE( io, 22 ) surface_aerosol_flux, aerosol_flux_dpg, aerosol_flux_sigmag, & 993 aerosol_flux_mass_fracs_a 994 ENDIF 995 IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp .OR. salsa_emission_mode == 'read_from_file' ) & 996 THEN 997 WRITE( io, 23 ) 998 ENDIF 992 999 993 1000 1 FORMAT (//' SALSA information:'/ & … … 1024 1031 ' OCSV: ',ES12.4E3, ' #/m**3') 1025 1032 17 FORMAT (/' Initialising concentrations: ', / & 1026 ' Aerosol size distribution: i sdtyp = ', I1,/&1027 ' Gas concentrations: i gctyp= ', I1 )1033 ' Aerosol size distribution: init_aerosol_type = ', I1,/ & 1034 ' Gas concentrations: init_gases_type = ', I1 ) 1028 1035 18 FORMAT ( ' Mode diametres: dpg(nmod) = ', 7(F7.3), ' (m)', / & 1029 1036 ' Standard deviation: sigmag(nmod) = ', 7(F7.2),/ & … … 1032 1039 20 FORMAT (/' Nesting for salsa variables: ', L1 ) 1033 1040 21 FORMAT (/' Emissions: salsa_emission_mode = ', A ) 1041 22 FORMAT (/' surface_aerosol_flux = ', ES12.4E3, ' #/m**2/s', / & 1042 ' aerosol_flux_dpg = ', 7(F7.3), ' (m)', / & 1043 ' aerosol_flux_sigmag = ', 7(F7.2), / & 1044 ' aerosol_mass_fracs_a = ', 7(ES12.4E3) ) 1045 23 FORMAT (/' (currently all emissions are soluble!)') 1034 1046 1035 1047 END SUBROUTINE salsa_header … … 1088 1100 !-- Allocate: 1089 1101 ALLOCATE( aero(nbins_aerosol), bc_am_t_val(nbins_aerosol*ncomponents_mass), & 1090 bc_an_t_val(n gases_salsa), bc_gt_t_val(nbins_aerosol), bin_low_limits(nbins_aerosol),&1102 bc_an_t_val(nbins_aerosol), bc_gt_t_val(ngases_salsa), bin_low_limits(nbins_aerosol),& 1091 1103 nsect(nbins_aerosol), massacc(nbins_aerosol) ) 1092 1104 ALLOCATE( k_topo_top(nysg:nyng,nxlg:nxrg) ) … … 1108 1120 aerosol_number(i)%conc_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_2(:,:,:,i) 1109 1121 aerosol_number(i)%tconc_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) => nconc_3(:,:,:,i) 1110 ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), &1111 aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), &1112 aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &1113 aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &1114 aerosol_number(i)%init(nzb:nzt+1), &1122 ALLOCATE( aerosol_number(i)%flux_s(nzb+1:nzt,0:threads_per_task-1), & 1123 aerosol_number(i)%diss_s(nzb+1:nzt,0:threads_per_task-1), & 1124 aerosol_number(i)%flux_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 1125 aerosol_number(i)%diss_l(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 1126 aerosol_number(i)%init(nzb:nzt+1), & 1115 1127 aerosol_number(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 1128 IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN 1129 ALLOCATE( aerosol_number(i)%source(nys:nyn,nxl:nxr) ) 1130 ENDIF 1116 1131 ENDDO 1117 1132 … … 1136 1151 aerosol_mass(i)%init(nzb:nzt+1), & 1137 1152 aerosol_mass(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 1153 IF ( include_emission .OR. ( nldepo .AND. nldepo_surf ) ) THEN 1154 ALLOCATE( aerosol_mass(i)%source(nys:nyn,nxl:nxr) ) 1155 ENDIF 1138 1156 ENDDO 1139 1157 … … 1237 1255 salsa_gas(i)%init(nzb:nzt+1), & 1238 1256 salsa_gas(i)%sums_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 1257 IF ( include_emission ) ALLOCATE( salsa_gas(i)%source(nys:nys,nxl:nxr) ) 1239 1258 ENDDO 1240 1259 ! … … 1434 1453 IF ( nldepo ) CALL init_deposition 1435 1454 1436 IF ( salsa_emission_mode /= 'no_emission') THEN1455 IF ( include_emission ) THEN 1437 1456 ! 1438 1457 !-- Read in and initialize emissions 1439 1458 CALL salsa_emission_setup( .TRUE. ) 1440 IF ( .NOT. salsa_gases_from_chem .AND. salsa_emission_mode == 'read_from_file') THEN1459 IF ( .NOT. salsa_gases_from_chem .AND. include_emission ) THEN 1441 1460 CALL salsa_gas_emission_setup( .TRUE. ) 1442 1461 ENDIF … … 1598 1617 pmfoc1a(:) = 0.0_wp 1599 1618 1600 IF ( i sdtyp== 1 ) THEN1619 IF ( init_aerosol_type == 1 ) THEN 1601 1620 ! 1602 1621 !-- Read input profiles from PIDS_DYNAMIC_SALSA … … 1608 1627 ! 1609 1628 !-- Open file in read-only mode 1610 CALL open_read_file( input_file_dynamic// TRIM( coupling_char ), id_dyn )1629 CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn ) 1611 1630 ! 1612 1631 !-- Inquire dimensions: … … 1671 1690 !-- Aerosol concentrations: lod=1 (total PM) or lod=2 (sectional number size distribution) 1672 1691 CALL get_attribute( id_dyn, 'lod', lod_aero, .FALSE., 'init_atmosphere_aerosol' ) 1673 IF ( lod_aero /= 2) THEN1674 message_string = 'Currently only lod= 2accepted for init_atmosphere_aerosol'1692 IF ( lod_aero /= 1 ) THEN 1693 message_string = 'Currently only lod=1 accepted for init_atmosphere_aerosol' 1675 1694 CALL message( 'salsa_mod: aerosol_init', 'PA0603', 2, 2, 0, 6, 0 ) 1676 1695 ELSE … … 1693 1712 IF ( ANY( ABS( ( aero(1:nbins_aerosol)%dmid - pr_dmid ) / & 1694 1713 aero(1:nbins_aerosol)%dmid ) > 0.1_wp ) ) THEN 1695 message_string = 'Mean diameters of the aerosol size bins ' // TRIM(&1696 input_file_dynamic ) // ' in do not conform to the sectional '//&1714 message_string = 'Mean diameters of the aerosol size bins in ' // TRIM( & 1715 input_file_dynamic ) // ' do not match with the sectional '// & 1697 1716 'representation of the model.' 1698 1717 CALL message( 'salsa_mod: aerosol_init', 'PA0605', 2, 2, 0, 6, 0 ) … … 1763 1782 1764 1783 #else 1765 message_string = 'isdtyp = 1 but preprocessor directive __netcdf is not used in compiling!' 1784 message_string = 'init_aerosol_type = 1 but preprocessor directive __netcdf is not used '// & 1785 'in compiling!' 1766 1786 CALL message( 'salsa_mod: aerosol_init', 'PA0608', 1, 2, 0, 6, 0 ) 1767 1787 1768 1788 #endif 1769 1789 1770 ELSEIF ( i sdtyp== 0 ) THEN1790 ELSEIF ( init_aerosol_type == 0 ) THEN 1771 1791 ! 1772 1792 !-- Mass fractions for species in a and b-bins … … 1813 1833 ENDIF 1814 1834 1815 IF ( i gctyp== 1 ) THEN1835 IF ( init_gases_type == 1 ) THEN 1816 1836 ! 1817 1837 !-- Read input profiles from PIDS_CHEM … … 1823 1843 ! 1824 1844 !-- Open file in read-only mode 1825 CALL open_read_file( input_file_dynamic// TRIM( coupling_char ), id_dyn )1845 CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dyn ) 1826 1846 ! 1827 1847 !-- Inquire dimensions: … … 1855 1875 ENDIF ! netcdf_extend 1856 1876 #else 1857 message_string = 'igctyp = 1 but preprocessor directive __netcdf is not used in compiling!' 1877 message_string = 'init_gases_type = 1 but preprocessor directive __netcdf is not used in '//& 1878 'compiling!' 1858 1879 CALL message( 'salsa_mod: aerosol_init', 'PA0611', 1, 2, 0, 6, 0 ) 1859 1880 … … 2508 2529 REAL(wp), DIMENSION(nzb:nzt+1,nbins_aerosol) :: vd !< particle fall seed (m/s) 2509 2530 2510 TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array 2531 TYPE(t_section), DIMENSION(nbins_aerosol) :: lo_aero !< additional variable for OpenMP 2532 TYPE(t_section), DIMENSION(nbins_aerosol) :: aero_old !< helper array 2511 2533 2512 2534 aero_old(:)%numc = 0.0_wp … … 2514 2536 in_u = 0.0_wp 2515 2537 kvis = 0.0_wp 2538 lo_aero = aero 2516 2539 schmidt_num = 0.0_wp 2517 2540 vd = 0.0_wp … … 2524 2547 !-- Aerosol number is always set, but mass can be uninitialized 2525 2548 DO ib = 1, nbins_aerosol 2526 aero(ib)%volc(:)= 0.0_wp2549 lo_aero(ib)%volc(:) = 0.0_wp 2527 2550 aero_old(ib)%volc(:) = 0.0_wp 2528 2551 ENDDO … … 2573 2596 ic = 1 2574 2597 DO ss = str, endi 2575 aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so42598 lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2so4 2576 2599 ic = ic+1 2577 2600 ENDDO 2578 aero_old(1:nbins_aerosol)%volc(vc) = aero(1:nbins_aerosol)%volc(vc)2601 aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) 2579 2602 ENDIF 2580 2603 ! … … 2586 2609 ic = 1 2587 2610 DO ss = str, endi 2588 aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc2611 lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhooc 2589 2612 ic = ic+1 2590 2613 ENDDO 2591 aero_old(1:nbins_aerosol)%volc(vc) = aero(1:nbins_aerosol)%volc(vc)2614 aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) 2592 2615 ENDIF 2593 2616 ! … … 2599 2622 ic = 1 + end_subrange_1a 2600 2623 DO ss = str, endi 2601 aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc2624 lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhobc 2602 2625 ic = ic+1 2603 2626 ENDDO 2604 aero_old(1:nbins_aerosol)%volc(vc) = aero(1:nbins_aerosol)%volc(vc)2627 aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) 2605 2628 ENDIF 2606 2629 ! … … 2612 2635 ic = 1 + end_subrange_1a 2613 2636 DO ss = str, endi 2614 aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu2637 lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhodu 2615 2638 ic = ic+1 2616 2639 ENDDO 2617 aero_old(1:nbins_aerosol)%volc(vc) = aero(1:nbins_aerosol)%volc(vc)2640 aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) 2618 2641 ENDIF 2619 2642 ! … … 2625 2648 ic = 1 + end_subrange_1a 2626 2649 DO ss = str, endi 2627 aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss2650 lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoss 2628 2651 ic = ic+1 2629 2652 ENDDO 2630 aero_old(1:nbins_aerosol)%volc(vc) = aero(1:nbins_aerosol)%volc(vc)2653 aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) 2631 2654 ENDIF 2632 2655 ! … … 2638 2661 ic = 1 2639 2662 DO ss = str, endi 2640 aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno32663 lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhohno3 2641 2664 ic = ic+1 2642 2665 ENDDO 2643 aero_old(1:nbins_aerosol)%volc(vc) = aero(1:nbins_aerosol)%volc(vc)2666 aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) 2644 2667 ENDIF 2645 2668 ! … … 2651 2674 ic = 1 2652 2675 DO ss = str, endi 2653 aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh32676 lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhonh3 2654 2677 ic = ic+1 2655 2678 ENDDO 2656 aero_old(1:nbins_aerosol)%volc(vc) = aero(1:nbins_aerosol)%volc(vc)2679 aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) 2657 2680 ENDIF 2658 2681 ! … … 2665 2688 IF ( advect_particle_water ) THEN 2666 2689 DO ss = str, endi 2667 aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o2690 lo_aero(ic)%volc(vc) = aerosol_mass(ss)%conc(k,j,i) / arhoh2o 2668 2691 ic = ic+1 2669 2692 ENDDO 2670 2693 ELSE 2671 aero(1:nbins_aerosol)%volc(vc) = mclim2672 ENDIF 2673 aero_old(1:nbins_aerosol)%volc(vc) = aero(1:nbins_aerosol)%volc(vc)2694 lo_aero(1:nbins_aerosol)%volc(vc) = mclim 2695 ENDIF 2696 aero_old(1:nbins_aerosol)%volc(vc) = lo_aero(1:nbins_aerosol)%volc(vc) 2674 2697 ! 2675 2698 !-- Number concentrations (numc) and particle sizes 2676 2699 !-- (dwet = wet diameter, core = dry volume) 2677 2700 DO ib = 1, nbins_aerosol 2678 aero(ib)%numc = aerosol_number(ib)%conc(k,j,i)2679 aero_old(ib)%numc = aero(ib)%numc2680 IF ( aero(ib)%numc > nclim ) THEN2681 aero(ib)%dwet = ( SUM( aero(ib)%volc(:) ) /aero(ib)%numc / api6 )**0.33333333_wp2682 aero(ib)%core = SUM( aero(ib)%volc(1:7) ) /aero(ib)%numc2701 lo_aero(ib)%numc = aerosol_number(ib)%conc(k,j,i) 2702 aero_old(ib)%numc = lo_aero(ib)%numc 2703 IF ( lo_aero(ib)%numc > nclim ) THEN 2704 lo_aero(ib)%dwet = ( SUM( lo_aero(ib)%volc(:) ) / lo_aero(ib)%numc / api6 )**0.33333333_wp 2705 lo_aero(ib)%core = SUM( lo_aero(ib)%volc(1:7) ) / lo_aero(ib)%numc 2683 2706 ELSE 2684 aero(ib)%dwet =aero(ib)%dmid2685 aero(ib)%core = api6 * (aero(ib)%dwet )**32707 lo_aero(ib)%dwet = lo_aero(ib)%dmid 2708 lo_aero(ib)%core = api6 * ( lo_aero(ib)%dwet )**3 2686 2709 ENDIF 2687 2710 ENDDO … … 2692 2715 in_rh = in_cw(k) / in_cs(k) 2693 2716 IF ( prunmode==1 .OR. .NOT. advect_particle_water ) THEN 2694 CALL equilibration( in_rh, in_t(k), aero, .TRUE. )2717 CALL equilibration( in_rh, in_t(k), lo_aero, .TRUE. ) 2695 2718 ENDIF 2696 2719 ! … … 2717 2740 !-- Coagulation 2718 2741 IF ( lscoag ) THEN 2719 CALL coagulation( aero, dt_salsa, in_t(k), in_p(k) )2742 CALL coagulation( lo_aero, dt_salsa, in_t(k), in_p(k) ) 2720 2743 ENDIF 2721 2744 ! 2722 2745 !-- Condensation 2723 2746 IF ( lscnd ) THEN 2724 CALL condensation( aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), &2747 CALL condensation( lo_aero, zgso4, zgocnv, zgocsv, zghno3, zgnh3, in_cw(k), in_cs(k), & 2725 2748 in_t(k), in_p(k), dt_salsa, prtcl ) 2726 2749 ENDIF … … 2728 2751 !-- Deposition 2729 2752 IF ( lsdepo ) THEN 2730 CALL deposition( aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:), &2753 CALL deposition( lo_aero, in_t(k), in_adn(k), in_u(k), in_lad, kvis(k), schmidt_num(k,:), & 2731 2754 vd(k,:) ) 2732 2755 ENDIF … … 2734 2757 !-- Size distribution bin update 2735 2758 IF ( lsdistupdate ) THEN 2736 CALL distr_update( aero )2759 CALL distr_update( lo_aero ) 2737 2760 ENDIF 2738 2761 !-- ********************************************************************************************* … … 2742 2765 !-- Calculate changes in concentrations 2743 2766 DO ib = 1, nbins_aerosol 2744 aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( aero(ib)%numc - &2767 aerosol_number(ib)%conc(k,j,i) = aerosol_number(ib)%conc(k,j,i) + ( lo_aero(ib)%numc - & 2745 2768 aero_old(ib)%numc ) * flag 2746 2769 ENDDO … … 2752 2775 ic = 1 2753 2776 DO ss = str, endi 2754 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( aero(ic)%volc(vc) - &2777 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - & 2755 2778 aero_old(ic)%volc(vc) ) * arhoh2so4 * flag 2756 2779 ic = ic+1 … … 2764 2787 ic = 1 2765 2788 DO ss = str, endi 2766 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( aero(ic)%volc(vc) - &2789 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - & 2767 2790 aero_old(ic)%volc(vc) ) * arhooc * flag 2768 2791 ic = ic+1 … … 2776 2799 ic = 1 + end_subrange_1a 2777 2800 DO ss = str, endi 2778 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( aero(ic)%volc(vc) - &2801 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - & 2779 2802 aero_old(ic)%volc(vc) ) * arhobc * flag 2780 2803 ic = ic+1 … … 2788 2811 ic = 1 + end_subrange_1a 2789 2812 DO ss = str, endi 2790 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( aero(ic)%volc(vc) - &2813 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - & 2791 2814 aero_old(ic)%volc(vc) ) * arhodu * flag 2792 2815 ic = ic+1 … … 2800 2823 ic = 1 + end_subrange_1a 2801 2824 DO ss = str, endi 2802 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( aero(ic)%volc(vc) - &2825 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - & 2803 2826 aero_old(ic)%volc(vc) ) * arhoss * flag 2804 2827 ic = ic+1 … … 2812 2835 ic = 1 2813 2836 DO ss = str, endi 2814 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( aero(ic)%volc(vc) - &2837 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - & 2815 2838 aero_old(ic)%volc(vc) ) * arhohno3 * flag 2816 2839 ic = ic+1 … … 2824 2847 ic = 1 2825 2848 DO ss = str, endi 2826 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( aero(ic)%volc(vc) - &2849 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - & 2827 2850 aero_old(ic)%volc(vc) ) * arhonh3 * flag 2828 2851 ic = ic+1 … … 2837 2860 ic = 1 2838 2861 DO ss = str, endi 2839 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( aero(ic)%volc(vc) - &2862 aerosol_mass(ss)%conc(k,j,i) = aerosol_mass(ss)%conc(k,j,i) + ( lo_aero(ic)%volc(vc) - & 2840 2863 aero_old(ic)%volc(vc) ) * arhoh2o * flag 2841 2864 IF ( prunmode == 1 ) THEN … … 2918 2941 2919 2942 ENDDO ! k 2943 2920 2944 ! 2921 2945 !-- Set surfaces and wall fluxes due to deposition … … 2937 2961 ENDIF 2938 2962 ENDIF 2963 2964 IF ( prunmode < 3 ) THEN 2965 !$OMP MASTER 2966 aero = lo_aero 2967 !$OMP END MASTER 2968 END IF 2939 2969 2940 2970 END SUBROUTINE salsa_driver … … 3655 3685 ! 3656 3686 !-- Calculate changes in surface fluxes due to dry deposition 3657 IF ( aero_emission_att%lod == 2 .OR. salsa_emission_mode == 'no_emission' ) THEN 3658 surf%answs(m,ib) = -depo * norm_fac * aerosol_number(ib)%conc(k,j,i) 3659 DO ic = 1, ncomponents_mass 3660 icc = ( ic - 1 ) * nbins_aerosol + ib 3661 surf%amsws(m,icc) = -depo * norm_fac * aerosol_mass(icc)%conc(k,j,i) 3662 ENDDO ! ic 3663 ELSE 3687 IF ( include_emission ) THEN 3664 3688 surf%answs(m,ib) = aerosol_number(ib)%source(j,i) - & 3665 3689 MAX( 0.0_wp, depo * norm_fac * aerosol_number(ib)%conc(k,j,i) ) … … 3669 3693 MAX( 0.0_wp, depo * norm_fac * aerosol_mass(icc)%conc(k,j,i) ) 3670 3694 ENDDO ! ic 3695 ELSE 3696 surf%answs(m,ib) = -depo * norm_fac * aerosol_number(ib)%conc(k,j,i) 3697 DO ic = 1, ncomponents_mass 3698 icc = ( ic - 1 ) * nbins_aerosol + ib 3699 surf%amsws(m,icc) = -depo * norm_fac * aerosol_mass(icc)%conc(k,j,i) 3700 ENDDO ! ic 3671 3701 ENDIF 3672 3702 ENDDO ! ib … … 4975 5005 IF ( ptemp < 240.0_wp .OR. ptemp > 300.0_wp ) THEN 4976 5006 message_string = 'Invalid input value: ptemp' 4977 CALL message( 'salsa_mod: ternucl', 'PA06 19', 1, 2, 0, 6, 0 )5007 CALL message( 'salsa_mod: ternucl', 'PA0648', 1, 2, 0, 6, 0 ) 4978 5008 ENDIF 4979 5009 IF ( prh < 0.05_wp .OR. prh > 0.95_wp ) THEN 4980 5010 message_string = 'Invalid input value: prh' 4981 CALL message( 'salsa_mod: ternucl', 'PA06 20', 1, 2, 0, 6, 0 )5011 CALL message( 'salsa_mod: ternucl', 'PA0649', 1, 2, 0, 6, 0 ) 4982 5012 ENDIF 4983 5013 IF ( pc_sa < 1.0E+4_wp .OR. pc_sa > 1.0E+9_wp ) THEN 4984 5014 message_string = 'Invalid input value: pc_sa' 4985 CALL message( 'salsa_mod: ternucl', 'PA06 21', 1, 2, 0, 6, 0 )5015 CALL message( 'salsa_mod: ternucl', 'PA0650', 1, 2, 0, 6, 0 ) 4986 5016 ENDIF 4987 5017 IF ( pc_nh3 < 0.1_wp .OR. pc_nh3 > 100.0_wp ) THEN 4988 5018 message_string = 'Invalid input value: pc_nh3' 4989 CALL message( 'salsa_mod: ternucl', 'PA06 22', 1, 2, 0, 6, 0 )5019 CALL message( 'salsa_mod: ternucl', 'PA0651', 1, 2, 0, 6, 0 ) 4990 5020 ENDIF 4991 5021 … … 6933 6963 6934 6964 IF ( paero(ib)%numc > nclim ) THEN 6935 zvpart = SUM( paero(ib)%volc( :) ) / paero(ib)%numc6965 zvpart = SUM( paero(ib)%volc(1:7) ) / paero(ib)%numc ! Note: dry volume! 6936 6966 within_bins = ( paero(ib)%vlolim < zvpart .AND. zvpart < paero(ib)%vhilim ) 6937 6967 ENDIF … … 6991 7021 zvol = 0.0_wp 6992 7022 7023 !$OMP MASTER 6993 7024 CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'start' ) 7025 !$OMP END MASTER 7026 6994 7027 ! 6995 7028 !-- Calculate thermodynamic quantities needed in SALSA … … 7009 7042 !-- Calculate total mass concentration per bin 7010 7043 mcsum = 0.0_wp 7011 DO ic = 1, nc omponents_mass7044 DO ic = 1, ncc 7012 7045 icc = ( ic - 1 ) * nbins_aerosol + ib 7013 7046 mcsum = mcsum + aerosol_mass(icc)%conc(:,j,i) * flag … … 7015 7048 ! 7016 7049 !-- Check that number and mass concentration match qualitatively 7017 IF ( ANY ( aerosol_number(ib)%conc(:,j,i) > nclim .AND. mcsum <= 0.0_wp ) ) THEN7050 IF ( ANY ( aerosol_number(ib)%conc(:,j,i) >= nclim .AND. mcsum <= 0.0_wp ) ) THEN 7018 7051 DO k = nzb+1, nzt 7019 IF ( aerosol_number(ib)%conc(k,j,i) > nclim .AND. mcsum(k) <= 0.0_wp ) THEN7052 IF ( aerosol_number(ib)%conc(k,j,i) >= nclim .AND. mcsum(k) <= 0.0_wp ) THEN 7020 7053 aerosol_number(ib)%conc(k,j,i) = nclim * flag(k) 7021 7054 DO ic = 1, ncomponents_mass … … 7103 7136 ENDIF 7104 7137 7138 !$OMP MASTER 7105 7139 CALL cpu_log( log_point_s(94), 'salsa diagnostics ', 'stop' ) 7140 !$OMP END MASTER 7106 7141 7107 7142 END SUBROUTINE salsa_diagnostics … … 7185 7220 INTEGER(iwp) :: tn !< 7186 7221 7187 LOGICAL :: sedim !< calculate sedimentation only for aerosols (number and mass) 7222 IF ( time_since_reference_point >= skip_time_do_salsa ) THEN 7223 ! 7224 !-- Aerosol number 7225 DO ib = 1, nbins_aerosol 7226 !kk sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l 7227 CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,& 7228 aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, & 7229 aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, & 7230 aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, & 7231 aerosol_number(ib)%init, .TRUE. ) 7232 !kk aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l 7233 ! 7234 !-- Aerosol mass 7235 DO ic = 1, ncomponents_mass 7236 icc = ( ic - 1 ) * nbins_aerosol + ib 7237 !kk sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l 7238 CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,& 7239 aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, & 7240 aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, & 7241 aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, & 7242 aerosol_mass(icc)%init, .TRUE. ) 7243 !kk aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l 7244 7245 ENDDO ! ic 7246 ENDDO ! ib 7247 ! 7248 !-- Gases 7249 IF ( .NOT. salsa_gases_from_chem ) THEN 7250 7251 DO ig = 1, ngases_salsa 7252 !kk sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l 7253 CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, & 7254 salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, & 7255 salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,& 7256 salsa_gas(ig)%diss_l, salsa_gas(ig)%init, .FALSE. ) 7257 !kk salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l 7258 7259 ENDDO ! ig 7260 7261 ENDIF 7262 7263 ENDIF 7264 7265 END SUBROUTINE salsa_prognostic_equations_ij 7266 ! 7267 !------------------------------------------------------------------------------! 7268 ! Description: 7269 ! ------------ 7270 !> Calculate the prognostic equation for aerosol number and mass, and gas 7271 !> concentrations. Cache-optimized. 7272 !------------------------------------------------------------------------------! 7273 SUBROUTINE salsa_prognostic_equations() 7274 7275 USE control_parameters, & 7276 ONLY: time_since_reference_point 7277 7278 IMPLICIT NONE 7279 7280 INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index 7281 INTEGER(iwp) :: ic !< loop index for aerosol mass bin 7282 INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b 7283 INTEGER(iwp) :: ig !< loop index for salsa gases 7188 7284 7189 7285 IF ( time_since_reference_point >= skip_time_do_salsa ) THEN … … 7193 7289 sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l 7194 7290 CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,& 7195 aerosol_number(ib)%tconc_m, i, j, i_omp_start, tn, ib, ib, & 7196 aerosol_number(ib)%flux_s, aerosol_number(ib)%diss_s, & 7197 aerosol_number(ib)%flux_l, aerosol_number(ib)%diss_l, & 7198 aerosol_number(ib)%init, sedim ) 7291 aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, .TRUE. ) 7199 7292 aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l 7200 7293 ! … … 7204 7297 sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l 7205 7298 CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,& 7206 aerosol_mass(icc)%tconc_m, i, j, i_omp_start, tn, ib, ic, & 7207 aerosol_mass(icc)%flux_s, aerosol_mass(icc)%diss_s, & 7208 aerosol_mass(icc)%flux_l, aerosol_mass(icc)%diss_l, & 7209 aerosol_mass(icc)%init, sedim ) 7299 aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, .TRUE. ) 7210 7300 aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l 7211 7301 … … 7219 7309 sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l 7220 7310 CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, & 7221 salsa_gas(ig)%tconc_m, i, j, i_omp_start, tn, ig, ig, & 7222 salsa_gas(ig)%flux_s, salsa_gas(ig)%diss_s, salsa_gas(ig)%flux_l,& 7223 salsa_gas(ig)%diss_l, salsa_gas(ig)%init, sedim ) 7224 salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l 7225 7226 ENDDO ! ig 7227 7228 ENDIF 7229 7230 ENDIF 7231 7232 END SUBROUTINE salsa_prognostic_equations_ij 7233 ! 7234 !------------------------------------------------------------------------------! 7235 ! Description: 7236 ! ------------ 7237 !> Calculate the prognostic equation for aerosol number and mass, and gas 7238 !> concentrations. Cache-optimized. 7239 !------------------------------------------------------------------------------! 7240 SUBROUTINE salsa_prognostic_equations() 7241 7242 USE control_parameters, & 7243 ONLY: time_since_reference_point 7244 7245 IMPLICIT NONE 7246 7247 INTEGER(iwp) :: ib !< loop index for aerosol number bin OR gas index 7248 INTEGER(iwp) :: ic !< loop index for aerosol mass bin 7249 INTEGER(iwp) :: icc !< (c-1)*nbins_aerosol+b 7250 INTEGER(iwp) :: ig !< loop index for salsa gases 7251 7252 LOGICAL :: sedim !< calculate sedimentation only for aerosols (number and mass) 7253 7254 IF ( time_since_reference_point >= skip_time_do_salsa ) THEN 7255 ! 7256 !-- Aerosol number 7257 DO ib = 1, nbins_aerosol 7258 sums_salsa_ws_l = aerosol_number(ib)%sums_ws_l 7259 CALL salsa_tendency( 'aerosol_number', aerosol_number(ib)%conc_p, aerosol_number(ib)%conc,& 7260 aerosol_number(ib)%tconc_m, ib, ib, aerosol_number(ib)%init, sedim ) 7261 aerosol_number(ib)%sums_ws_l = sums_salsa_ws_l 7262 ! 7263 !-- Aerosol mass 7264 DO ic = 1, ncomponents_mass 7265 icc = ( ic - 1 ) * nbins_aerosol + ib 7266 sums_salsa_ws_l = aerosol_mass(icc)%sums_ws_l 7267 CALL salsa_tendency( 'aerosol_mass', aerosol_mass(icc)%conc_p, aerosol_mass(icc)%conc,& 7268 aerosol_mass(icc)%tconc_m, ib, ic, aerosol_mass(icc)%init, sedim ) 7269 aerosol_mass(icc)%sums_ws_l = sums_salsa_ws_l 7270 7271 ENDDO ! ic 7272 ENDDO ! ib 7273 ! 7274 !-- Gases 7275 IF ( .NOT. salsa_gases_from_chem ) THEN 7276 7277 DO ig = 1, ngases_salsa 7278 sums_salsa_ws_l = salsa_gas(ig)%sums_ws_l 7279 CALL salsa_tendency( 'salsa_gas', salsa_gas(ig)%conc_p, salsa_gas(ig)%conc, & 7280 salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, sedim ) 7311 salsa_gas(ig)%tconc_m, ig, ig, salsa_gas(ig)%init, .FALSE. ) 7281 7312 salsa_gas(ig)%sums_ws_l = sums_salsa_ws_l 7282 7313 … … 7955 7986 ELSE 7956 7987 message_string = 'Error in itype!' 7957 CALL message( ' salsa_mod:bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 )7988 CALL message( 'bin_mixrat', 'PA0628', 2, 2, 0, 6, 0 ) 7958 7989 ENDIF 7959 7990 … … 7978 8009 IMPLICIT NONE 7979 8010 7980 IF ( time_since_reference_point >= skip_time_do_salsa ) THEN 7981 7982 IF ( next_aero_emission_update <= time_since_reference_point ) THEN 7983 CALL salsa_emission_setup( .FALSE. ) 7984 ENDIF 7985 7986 IF ( next_gas_emission_update <= time_since_reference_point ) THEN 7987 IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) THEN 7988 CALL salsa_gas_emission_setup( .FALSE. ) 8011 IF ( include_emission ) THEN 8012 8013 IF ( time_since_reference_point >= skip_time_do_salsa ) THEN 8014 8015 IF ( next_aero_emission_update <= time_since_reference_point ) THEN 8016 CALL salsa_emission_setup( .FALSE. ) 7989 8017 ENDIF 7990 ENDIF 7991 8018 8019 IF ( next_gas_emission_update <= time_since_reference_point ) THEN 8020 IF ( salsa_emission_mode == 'read_from_file' .AND. .NOT. salsa_gases_from_chem ) & 8021 THEN 8022 CALL salsa_gas_emission_setup( .FALSE. ) 8023 ENDIF 8024 ENDIF 8025 8026 ENDIF 7992 8027 ENDIF 7993 8028 … … 8041 8076 8042 8077 ! 8043 !-- Allocate source arrays:8078 !-- Set source arrays to zero: 8044 8079 DO ib = 1, nbins_aerosol 8045 IF ( init ) ALLOCATE( aerosol_number(ib)%source(nys:nyn,nxl:nxr) )8046 8080 aerosol_number(ib)%source = 0.0_wp 8047 8081 ENDDO 8048 8082 8049 8083 DO ic = 1, ncomponents_mass * nbins_aerosol 8050 IF ( init ) ALLOCATE( aerosol_mass(ic)%source(nys:nyn,nxl:nxr) )8051 8084 aerosol_mass(ic)%source = 0.0_wp 8052 8085 ENDDO … … 8089 8122 !-- Set uniform fluxes of default horizontal surfaces 8090 8123 CALL set_flux( surf_def_h(0), cc_i2m, aerosol_flux_mass_fracs_a, source_array ) 8091 !8092 !-- Subrange 2b:8093 !-- todo: this information should go to HEADER/RUN_CONTROL, it doesn't belong to the job log,8094 !-- and actually, aerosol_flux_mass_fracs_b is not used anywhere else except for this message,8095 !-- hence, what do we need it for?8096 IF ( SUM( aerosol_flux_mass_fracs_b ) > 0.0_wp ) THEN8097 CALL debug_message( ' salsa_emission_setup: emissions are soluble!', 'info' )8098 ENDIF8099 8124 8100 8125 DEALLOCATE( nsect_emission, source_array ) … … 8119 8144 ! 8120 8145 !-- Check existence of PIDS_SALSA file 8121 INQUIRE( FILE = input_file_salsa // TRIM( coupling_char ), EXIST = netcdf_extend ) 8146 INQUIRE( FILE = TRIM( input_file_salsa ) // TRIM( coupling_char ), & 8147 EXIST = netcdf_extend ) 8122 8148 IF ( .NOT. netcdf_extend ) THEN 8123 8149 message_string = 'Input file '// TRIM( input_file_salsa ) // TRIM( coupling_char )& … … 8127 8153 ! 8128 8154 !-- Open file in read-only mode 8129 CALL open_read_file( input_file_salsa// TRIM( coupling_char ), id_salsa )8155 CALL open_read_file( TRIM( input_file_salsa ) // TRIM( coupling_char ), id_salsa ) 8130 8156 ! 8131 8157 !-- Read the index and name of chemical components … … 8686 8712 aero(ib)%core * prho * rho_air_zw(k-1) 8687 8713 aerosol_mass(ic)%source(j,i) = aerosol_mass(ic)%source(j,i) + surface%amsws(surf_num,ic) 8688 !8689 !-- Subrange 2b:8690 !-- todo: this information should go to HEADER/RUN_CONTROL, it doesn't belong to the job log8691 ! IF ( .NOT. no_insoluble ) THEN8692 ! CALL location_message( ' salsa_mass_flux: All emissions are soluble!', .TRUE. )8693 ! ENDIF8694 8714 8695 8715 END SUBROUTINE set_mass_flux … … 8784 8804 END SELECT 8785 8805 ENDDO 8786 !-- todo: this information should go to HEADER/RUN_CONTROL, it doesn't belong to the job log8787 ! IF ( SUM( emission_index_chem ) == 0 ) THEN8788 ! CALL location_message( ' salsa_gas_emission_setup: no gas emissions', .TRUE. )8789 ! ENDIF8790 8806 ! 8791 8807 !-- Inquire the fill value
Note: See TracChangeset
for help on using the changeset viewer.
