Changeset 4559 for palm/trunk/SOURCE/chem_photolysis_mod.f90
- Timestamp:
- Jun 11, 2020 8:51:48 AM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chem_photolysis_mod.f90
r4481 r4559 1 1 !> @file chem_photolysis_mod.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 2018-2020 Leibniz Universitaet Hannover 18 17 ! Copyright 2018-2020 Karlsruhe Institute of Technology 19 !------------------------------------------------------------------------------ !18 !--------------------------------------------------------------------------------------------------! 20 19 ! 21 20 ! Current revisions: … … 26 25 ! ----------------- 27 26 ! $Id$ 27 ! file re-formatted to follow the PALM coding standard 28 ! 29 ! 4481 2020-03-31 18:55:54Z maronga 28 30 ! Change call to calc_zenith 29 ! 31 ! 30 32 ! 4223 2019-09-10 09:20:47Z gronemeier 31 33 ! Corrected "Former revisions" section 32 ! 34 ! 33 35 ! 3876 2019-04-08 18:41:49Z knoop 34 ! some formatting and comments added 35 ! 36 ! some formatting and comments added 37 ! 36 38 ! 3824 2019-03-27 15:56:16Z pavelkrc 37 39 ! unused variables removed 38 ! 40 ! 39 41 ! 2718 2018-01-02 08:49:38Z maronga 40 42 ! Initial revision … … 45 47 ! @author Renate Forkel 46 48 ! 47 !------------------------------------------------------------------------------ !49 !--------------------------------------------------------------------------------------------------! 48 50 ! Description: 49 51 ! ------------ 50 52 !> photolysis models and interfaces (Adapted from photolysis_model_mod.f90) 51 53 !> @todo more complex scheme, add shading 52 !------------------------------------------------------------------------------ !54 !--------------------------------------------------------------------------------------------------! 53 55 MODULE chem_photolysis_mod 54 56 55 ! USE arrays_3d, &57 ! USE arrays_3d, & 56 58 ! ONLY: dzw, q, ql, zu, zw 57 59 58 USE control_parameters, &60 USE control_parameters, & 59 61 ONLY: time_since_reference_point 60 62 61 USE pegrid, &63 USE pegrid, & 62 64 ONLY: myid, threads_per_task 63 65 64 USE indices, &66 USE indices, & 65 67 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt 66 68 67 USE control_parameters, &68 ONLY: initializing_actions 69 70 USE chem_gasphase_mod, &71 ONLY: nphot, phot _names, phot72 73 USE chem_modules, &69 USE control_parameters, & 70 ONLY: initializing_actions 71 72 USE chem_gasphase_mod, & 73 ONLY: nphot, phot, phot_names 74 75 USE chem_modules, & 74 76 ONLY: phot_frequen, photolysis_scheme 75 77 76 USE chem_modules, &78 USE chem_modules, & 77 79 ONLY: chem_debug2 78 80 … … 87 89 88 90 89 ! LOGICAL :: unscheduled_photolysis_calls = .TRUE., & !< flag parameter indicating whether additional calls of the photolysis code are allowed 90 ! constant_albedo = .FALSE., & !< flag parameter indicating whether the albedo may change depending on zenith 91 ! force_photolysis_call = .FALSE., & !< flag parameter for unscheduled photolysis calls 92 ! photolysis = .FALSE., & !< flag parameter indicating whether the photolysis model is used 93 ! sun_up = .TRUE., & !< flag parameter indicating whether the sun is up or down 94 ! photolysis = .TRUE., & !< flag parameter indicing whether photolysis shall be calculated 95 ! sun_direction = .FALSE. !< flag parameter indicing whether solar direction shall be calculated 91 ! LOGICAL :: unscheduled_photolysis_calls = .TRUE., & !< flag parameter indicating whether 92 ! !< additional calls of the photolysis code are allowed 93 ! constant_albedo = .FALSE., & !< flag parameter indicating whether the 94 ! !< albedo may change depending on zenith 95 ! force_photolysis_call = .FALSE., & !< flag parameter for unscheduled photolysis 96 ! !< calls 97 ! photolysis = .FALSE., & !< flag parameter indicating whether the 98 ! !< photolysis model is used 99 ! sun_up = .TRUE., & !< flag parameter indicating whether the sun 100 ! !< is up or down 101 ! photolysis = .TRUE., & !< flag parameter indicing whether 102 ! !< photolysis shall be calculated 103 ! sun_direction = .FALSE. !< flag parameter indicing whether solar 104 ! !< direction shall be calculated 96 105 97 106 !-- Parameters for constant photolysis frequencies 98 INTEGER,PARAMETER :: nconst = 15 !< available predefined photolysis prequencies for constant 107 INTEGER,PARAMETER :: nconst = 15 !< available predefined photolysis prequencies 108 !< for constant 99 109 100 110 ! Names for predefined fixed photolysis frequencies at zenith angle 0 101 CHARACTER(LEN=10), PARAMETER, DIMENSION(nconst) :: names_c = (/ &102 'J_O31D ','J_O33P ','J_NO2 ','J_HNO3 ','J_RCHO ', &103 'J ','J ','J ','J ','J ', &111 CHARACTER(LEN=10), PARAMETER, DIMENSION(nconst) :: names_c = (/ & 112 'J_O31D ','J_O33P ','J_NO2 ','J_HNO3 ','J_RCHO ', & 113 'J ','J ','J ','J ','J ', & 104 114 'J ','J ','J ','J ','J ' /) 105 115 ! Photolysis frequency at zenith angle 0 degrees in 1/s 106 REAL(wp), PARAMETER, DIMENSION(nconst) :: phot0 = (/ &107 2.489E-05_wp, 3.556E-04_wp, 8.89E-03_wp,5.334E-07_wp,3.734E-05_wp,&108 0.0000E00_wp, 0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,&109 0.0000E00_wp, 0.0000E00_wp,0.0000E00_wp,0.0000E00_wp,0.0000E00_wp /)116 REAL(wp), PARAMETER, DIMENSION(nconst) :: phot0 = (/ & 117 2.489E-05_wp, 3.556E-04_wp, 8.89E-03_wp,5.334E-07_wp, 3.734E-05_wp, & 118 0.0000E00_wp, 0.0000E00_wp, 0.0000E00_wp,0.0000E00_wp, 0.0000E00_wp, & 119 0.0000E00_wp, 0.0000E00_wp, 0.0000E00_wp,0.0000E00_wp, 0.0000E00_wp /) 110 120 111 121 !-- Parameters for simple photolysis frequencies from MCM (http://mcm.leeds.ac.uk/MCM) 112 122 !-- Saunders et al., 2003, Atmos. Chem. Phys., 3, 161-180 113 INTEGER,PARAMETER :: nsimple = 15 !< available predefined photolysis prequencies for simple parameterisation114 ! Names for simple photolysis frequencies parameterisation (115 CHARACTER(LEN=10), PARAMETER, DIMENSION(nsimple) :: names_s = (/ &116 'J_O31D ','J_O33P ','J_H2O2 ','J_NO2 ','J_NO3_A ', &117 'J_NO3_B ','J_HONO ','J_HNO3 ','J_HCHO_A ','J_HCHO_B ', &123 INTEGER,PARAMETER :: nsimple = 15 !< available predefined photolysis prequencies for simple parameterisation 124 !-- Names for simple photolysis frequencies parameterisation ( 125 CHARACTER(LEN=10), PARAMETER, DIMENSION(nsimple) :: names_s = (/ & 126 'J_O31D ','J_O33P ','J_H2O2 ','J_NO2 ','J_NO3_A ', & 127 'J_NO3_B ','J_HONO ','J_HNO3 ','J_HCHO_A ','J_HCHO_B ', & 118 128 'J_CH3CHO ','J ','J ','J ','J_RCHO ' /) 119 129 120 !-- Species dependent parameters for simple photolysis frequencies from MCM (http://mcm.leeds.ac.uk/MCM) 130 !-- Species dependent parameters for simple photolysis frequencies from MCM 131 !-- (http://mcm.leeds.ac.uk/MCM) 121 132 !-- J = l*COSx@m*EXP(-n*SECx) with l,m,n named par_l etc., x is the zenith angle 122 REAL(wp), PARAMETER, DIMENSION(nconst) :: par_l = (/&123 6.073E-05_wp, 4.775E-04_wp,1.041E-05_wp,1.165E-02_wp,2.485E-02_wp,&124 1.747E-01_wp, 2.644E-03_wp,9.312E-07_wp,4.642E-05_wp,6.853E-05_wp,&125 7.344E-06_wp, 0.0000E00_wp,0.0000E00_wp,0.000E00_wp,6.853E-05_wp /)126 127 REAL(wp), PARAMETER, DIMENSION(nconst) :: par_m = (/ &128 1.743_wp, 0.298_wp, 0.723_wp, 0.244_wp, 0.168_wp, &129 0.155_wp, 0.261_wp, 1.230_wp, 0.762_wp, 0.477_wp, &133 REAL(wp), PARAMETER, DIMENSION(nconst) :: par_l = (/ & 134 6.073E-05_wp, 4.775E-04_wp, 1.041E-05_wp, 1.165E-02_wp, 2.485E-02_wp, & 135 1.747E-01_wp, 2.644E-03_wp, 9.312E-07_wp, 4.642E-05_wp, 6.853E-05_wp, & 136 7.344E-06_wp, 0.0000E00_wp, 0.0000E00_wp, 0.000E00_wp, 6.853E-05_wp /) 137 138 REAL(wp), PARAMETER, DIMENSION(nconst) :: par_m = (/ & 139 1.743_wp, 0.298_wp, 0.723_wp, 0.244_wp, 0.168_wp, & 140 0.155_wp, 0.261_wp, 1.230_wp, 0.762_wp, 0.477_wp, & 130 141 1.202_wp, 0.000_wp, 0.000_wp, 0.000_wp, 0.477_wp /) 131 142 132 REAL(wp), PARAMETER, DIMENSION(nconst) :: par_n = (/ &133 0.474_wp, 0.080_wp, 0.279_wp, 0.267_wp, 0.108_wp, &134 0.125_wp, 0.288_wp, 0.307_wp, 0.353_wp, 0.323_wp, &143 REAL(wp), PARAMETER, DIMENSION(nconst) :: par_n = (/ & 144 0.474_wp, 0.080_wp, 0.279_wp, 0.267_wp, 0.108_wp, & 145 0.125_wp, 0.288_wp, 0.307_wp, 0.353_wp, 0.323_wp, & 135 146 0.417_wp, 0.000_wp, 0.000_wp, 0.000_wp, 0.323_wp /) 136 147 137 148 138 REAL(wp) :: cosz = 0.7_wp !< cosine of fixed zenith angle (45 deg, if not specified otherwise) 149 REAL(wp) :: cosz = 0.7_wp !< cosine of fixed zenith angle (45 deg, if not 150 !< specified otherwise) 139 151 140 152 ! … … 142 154 MODULE PROCEDURE photolysis_constant 143 155 END INTERFACE photolysis_constant 144 156 145 157 INTERFACE photolysis_simple 146 158 MODULE PROCEDURE photolysis_simple … … 166 178 167 179 168 !------------------------------------------------------------------------------ !169 ! Description: 170 ! ------------ 171 !> This subroutine controls the calls of the photolysis schemes 172 !------------------------------------------------------------------------------ !180 !--------------------------------------------------------------------------------------------------! 181 ! Description: 182 ! ------------ 183 !> This subroutine controls the calls of the photolysis schemes. 184 !--------------------------------------------------------------------------------------------------! 173 185 SUBROUTINE photolysis_control 174 186 175 187 IMPLICIT NONE 176 188 … … 179 191 CASE ( 'constant' ) 180 192 CALL photolysis_constant 181 193 182 194 CASE ( 'simple' ) 183 195 CALL photolysis_simple 184 196 185 197 ! CASE ( 'fastj' ) 186 198 ! CALL photolysis_fastj … … 194 206 195 207 196 !------------------------------------------------------------------------------ !197 ! Description: 198 ! ------------ 199 !> This scheme keeps the prescribed net radiation constant during the run 208 !--------------------------------------------------------------------------------------------------! 209 ! Description: 210 ! ------------ 211 !> This scheme keeps the prescribed net radiation constant during the run. 200 212 !> Default zenith angle is 45 deg 201 !------------------------------------------------------------------------------ !213 !--------------------------------------------------------------------------------------------------! 202 214 SUBROUTINE photolysis_constant 203 215 204 216 IMPLICIT NONE 205 217 206 INTEGER(iwp) :: iphot,iav !< loop ind ix for photolysis reaction218 INTEGER(iwp) :: iphot,iav !< loop index for photolysis reaction 207 219 208 220 DO iphot = 1, nphot 209 221 DO iav = 1, nconst 210 IF ( TRIM( names_c(iav) ) == TRIM( phot_names(iphot) ) ) THEN 211 !-- Prescribe fixed photolysis frequencies [1/s] 212 phot_frequen(iphot)%freq(nzb+1:nzt,:,:) = & 213 phot0(iav) * cosz 222 IF ( TRIM( names_c(iav) ) == TRIM( phot_names(iphot) ) ) THEN 223 !-- Prescribe fixed photolysis frequencies [1/s] 224 phot_frequen(iphot)%freq(nzb+1:nzt,:,:) = phot0(iav) * cosz 214 225 ENDIF 215 226 ENDDO … … 220 231 221 232 222 !------------------------------------------------------------------------------ !223 ! Description: 224 ! ------------ 225 !> This scheme applies a simple parameterisation for clear sky photolysis frequencies 226 !> from theMaster Chemical Mechanism, MCM v3.2 (http://mcm.leeds.ac.uk/MCM).233 !--------------------------------------------------------------------------------------------------! 234 ! Description: 235 ! ------------ 236 !> This scheme applies a simple parameterisation for clear sky photolysis frequencies from the 237 !> Master Chemical Mechanism, MCM v3.2 (http://mcm.leeds.ac.uk/MCM). 227 238 !> Reference: Saunders et al., Atmos. Chem. Phys., 3, 161, 2003 228 239 !> J = l*COSx@m*EXP(-n*SECx) with l,m,n named par_l etc., x is the zenith angle 229 !------------------------------------------------------------------------------ !240 !--------------------------------------------------------------------------------------------------! 230 241 SUBROUTINE photolysis_simple 231 242 232 USE palm_date_time_mod, &243 USE palm_date_time_mod, & 233 244 ONLY: get_date_time 234 245 235 USE radiation_model_mod, &246 USE radiation_model_mod, & 236 247 ONLY: calc_zenith, cos_zenith 237 248 … … 249 260 ENDDO 250 261 251 CALL get_date_time( time_since_reference_point, &252 day_of_year=day_of_year,second_of_day=second_of_day )262 CALL get_date_time( time_since_reference_point, day_of_year = day_of_year, & 263 second_of_day=second_of_day ) 253 264 CALL calc_zenith( day_of_year, second_of_day ) 254 265 255 IF ( cos_zenith > 0.0_wp ) THEN256 coszi = 1. / cos_zenith266 IF ( cos_zenith > 0.0_wp ) THEN 267 coszi = 1.0_wp / cos_zenith 257 268 258 269 DO iphot = 1, nphot 259 270 DO iav = 1, nsimple 260 IF ( TRIM( names_s(iav) ) == TRIM( phot_names(iphot) ) ) then261 phot_frequen(iphot)%freq(nzb+1:nzt,:,:) = 262 par_l(iav) * cos_zenith**par_m(iav) * EXP( -par_n(iav) * coszi )271 IF ( TRIM( names_s(iav) ) == TRIM( phot_names(iphot) ) ) THEN 272 phot_frequen(iphot)%freq(nzb+1:nzt,:,:) = par_l(iav) * cos_zenith**par_m(iav) * & 273 EXP( - par_n(iav) * coszi ) 263 274 ENDIF 264 275 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.