Changeset 10622 for branches/UKMO/AMM15_v3_6_STABLE_package_collate_BGC_DA/NEMOGCM/NEMO/OPA_SRC/ASM/asmphyto2dbal_ersem.F90
- Timestamp:
- 2019-02-01T17:27:20+01:00 (5 years ago)
- File:
-
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_collate_BGC_DA/NEMOGCM/NEMO/OPA_SRC/ASM/asmphyto2dbal_ersem.F90
r10574 r10622 1 MODULE asmphyto2dbal_ medusa1 MODULE asmphyto2dbal_ersem 2 2 !!====================================================================== 3 !! *** MODULE asmphyto2dbal_ medusa***4 !! Calculate increments to MEDUSAbased on surface phyto2d increments3 !! *** MODULE asmphyto2dbal_ersem *** 4 !! Calculate increments to ERSEM based on surface phyto2d increments 5 5 !! 6 6 !! IMPORTANT NOTE: This calls the bioanalysis routine of Hemmings et al. … … 10 10 !! 11 11 !!====================================================================== 12 !! History : 3.6 ! 201 7-08 (D. Ford) Adapted from asmphyto2dbal_hadocc12 !! History : 3.6 ! 2019-01 (D. Ford) Adapted from asmphyto2dbal_medusa 13 13 !!---------------------------------------------------------------------- 14 #if defined key_asminc && defined key_ medusa14 #if defined key_asminc && defined key_fabm 15 15 !!---------------------------------------------------------------------- 16 16 !! 'key_asminc' : assimilation increment interface 17 !! 'key_ medusa' : MEDUSAmodel17 !! 'key_fabm' : FABM-ERSEM model 18 18 !!---------------------------------------------------------------------- 19 !! asm_phyto2d_bal_ medusa : routine to calculate increments to MEDUSA19 !! asm_phyto2d_bal_ersem : routine to calculate increments to ERSEM 20 20 !!---------------------------------------------------------------------- 21 21 USE par_kind, ONLY: wp ! kind parameters 22 22 USE par_oce, ONLY: jpi, jpj, jpk ! domain array sizes 23 23 USE dom_oce, ONLY: gdepw_n ! domain information 24 USE zdftmx, ONLY: ln_tmx_itf, & ! Indonesian Throughflow25 & mask_itf ! tidal mixing mask26 24 USE iom ! i/o 27 USE sms_medusa ! MEDUSA parameters 28 USE par_medusa ! MEDUSA parameters 25 USE par_fabm ! FABM-ERSEM parameters 29 26 USE par_trc, ONLY: jptra ! Tracer parameters 30 27 USE bioanalysis ! Nitrogen balancing … … 33 30 PRIVATE 34 31 35 PUBLIC asm_phyto2d_bal_ medusa32 PUBLIC asm_phyto2d_bal_ersem 36 33 37 34 ! Default values for biological assimilation parameters … … 68 65 CONTAINS 69 66 70 SUBROUTINE asm_phyto2d_bal_ medusa(ld_chltot, &67 SUBROUTINE asm_phyto2d_bal_ersem( ld_chltot, & 71 68 & pinc_chltot, & 72 69 & ld_chldia, & 73 70 & pinc_chldia, & 74 & ld_chlnon, & 75 & pinc_chlnon, & 76 & ld_phytot, & 77 & pinc_phytot, & 78 & ld_phydia, & 79 & pinc_phydia, & 80 & ld_phynon, & 81 & pinc_phynon, & 71 & ld_chlnan, & 72 & pinc_chlnan, & 73 & ld_chlpic, & 74 & pinc_chlpic, & 75 & ld_chldin, & 76 & pinc_chldin, & 82 77 & pincper, & 83 78 & p_maxchlinc, ld_phytobal, pmld, & 84 79 & pgrow_avg_bkg, ploss_avg_bkg, & 85 80 & phyt_avg_bkg, mld_max_bkg, & 81 & totalk_bkg, & 86 82 & tracer_bkg, phyto2d_balinc ) 87 83 !!--------------------------------------------------------------------------- 88 !! *** ROUTINE asm_phyto2d_bal_ medusa***84 !! *** ROUTINE asm_phyto2d_bal_ersem *** 89 85 !! 90 !! ** Purpose : calculate increments to MEDUSAfrom 2d phytoplankton increments86 !! ** Purpose : calculate increments to ERSEM from 2d phytoplankton increments 91 87 !! 92 !! ** Method : average up MEDUSA to look like HadOCC 88 !! ** Method : EITHER (ld_phytobal == .TRUE.): 89 !! average up ERSEM to look like HadOCC 93 90 !! call nitrogen balancing scheme 94 91 !! separate back out to MEDUSA 92 !! OR (ld_phytobal == .FALSE.): 93 !! calculate increments to maintain background stoichiometry 95 94 !! 96 95 !! ** Action : populate phyto2d_balinc … … 98 97 !! References : Hemmings et al., 2008, J. Mar. Res. 99 98 !! Ford et al., 2012, Ocean Sci. 99 !! Skakala et al., 2018, JGR 100 100 !!--------------------------------------------------------------------------- 101 101 !! … … 104 104 LOGICAL, INTENT(in ) :: ld_chldia ! Assim chldia y/n 105 105 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chldia ! chldia increments 106 LOGICAL, INTENT(in ) :: ld_chlnon ! Assim chlnon y/n 107 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chlnon ! chlnon increments 108 LOGICAL, INTENT(in ) :: ld_phytot ! Assim phytot y/n 109 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_phytot ! phytot increments 110 LOGICAL, INTENT(in ) :: ld_phydia ! Assim phydia y/n 111 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_phydia ! phydia increments 112 LOGICAL, INTENT(in ) :: ld_phynon ! Assim phynon y/n 113 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_phynon ! phynon increments 106 LOGICAL, INTENT(in ) :: ld_chlnan ! Assim chlnan y/n 107 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chlnan ! chlnan increments 108 LOGICAL, INTENT(in ) :: ld_chlpic ! Assim chlpic y/n 109 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chlpic ! chlpic increments 110 LOGICAL, INTENT(in ) :: ld_chldin ! Assim chldin y/n 111 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) :: pinc_chldin ! chldin increments 114 112 REAL(wp), INTENT(in ) :: pincper ! Assimilation period 115 113 REAL(wp), INTENT(in ) :: p_maxchlinc ! Max chl increment … … 120 118 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: phyt_avg_bkg ! Avg phyto 121 119 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: mld_max_bkg ! Max MLD 120 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk) :: totalk_bkg ! Total alkalinity 122 121 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,jpk,jptra) :: tracer_bkg ! State variables 123 122 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: phyto2d_balinc ! Balancing increments … … 126 125 INTEGER :: jkmax ! Loop index 127 126 INTEGER, DIMENSION(6) :: i_tracer ! Tracer indices 127 REAL(wp) :: zmassc ! Carbon molar mass 128 REAL(wp) :: zmassn ! Nitrogen molar mass 129 REAL(wp) :: z4qnc ! Z4/qnc (mesozoo N:C) 128 130 REAL(wp) :: n2be_p ! N:biomass for total phy 129 131 REAL(wp) :: n2be_z ! N:biomass for total zoo 130 132 REAL(wp) :: n2be_d ! N:biomass for detritus 131 REAL(wp) :: zfrac ! Fraction 132 REAL(wp) :: zfrac_chn ! Fraction of jpchn 133 REAL(wp) :: zfrac_chd ! Fraction of jpchd 134 REAL(wp) :: zfrac_phn ! Fraction of jpphn 135 REAL(wp) :: zfrac_phd ! Fraction of jpphd 136 REAL(wp) :: zfrac_zmi ! Fraction of jpzmi 137 REAL(wp) :: zfrac_zme ! Fraction of jpzme 138 REAL(wp) :: zrat_pds_phd ! Ratio of jppds:jpphd 139 REAL(wp) :: zrat_chd_phd ! Ratio of jpchd:jpphd 140 REAL(wp) :: zrat_chn_phn ! Ratio of jpchn:jpphn 141 REAL(wp) :: zrat_phn_chn ! Ratio of jpphn:jpchn 142 REAL(wp) :: zrat_phd_chd ! Ratio of jpphd:jpchd 143 REAL(wp) :: zrat_pds_chd ! Ratio of jppds:jpchd 144 REAL(wp) :: zrat_dtc_det ! Ratio of jpdtc:jpdet 133 REAL(wp) :: zfrac ! Fractions 134 REAL(wp) :: zfrac_chl1 ! 135 REAL(wp) :: zfrac_chl2 ! 136 REAL(wp) :: zfrac_chl3 ! 137 REAL(wp) :: zfrac_chl4 ! 138 REAL(wp) :: zfrac_p1n ! 139 REAL(wp) :: zfrac_p2n ! 140 REAL(wp) :: zfrac_p3n ! 141 REAL(wp) :: zfrac_p4n ! 142 REAL(wp) :: zfrac_z4n ! 143 REAL(wp) :: zfrac_z5n ! 144 REAL(wp) :: zfrac_z6n ! 145 REAL(wp) :: zfrac_n3n ! 146 REAL(wp) :: zfrac_n4n ! 147 REAL(wp) :: zfrac_r4n ! 148 REAL(wp) :: zfrac_r6n ! 149 REAL(wp) :: zfrac_r8n ! 150 REAL(wp) :: zrat_chl1_p1n ! Ratios 151 REAL(wp) :: zrat_p1c_p1n ! 152 REAL(wp) :: zrat_p1p_p1n ! 153 REAL(wp) :: zrat_p1s_p1n ! 154 REAL(wp) :: zrat_chl2_p2n ! 155 REAL(wp) :: zrat_p2c_p2n ! 156 REAL(wp) :: zrat_p2p_p2n ! 157 REAL(wp) :: zrat_chl3_p3n ! 158 REAL(wp) :: zrat_p3c_p3n ! 159 REAL(wp) :: zrat_p3p_p3n ! 160 REAL(wp) :: zrat_chl4_p4n ! 161 REAL(wp) :: zrat_p4c_p4n ! 162 REAL(wp) :: zrat_p4p_p4n ! 163 REAL(wp) :: zrat_z4c_z4n ! 164 REAL(wp) :: zrat_z5c_z5n ! 165 REAL(wp) :: zrat_z5p_z5n ! 166 REAL(wp) :: zrat_z6c_z6n ! 167 REAL(wp) :: zrat_z6p_z6n ! 168 REAL(wp) :: zrat_r4c_r4n ! 169 REAL(wp) :: zrat_r4p_r4n ! 170 REAL(wp) :: zrat_r6c_r6n ! 171 REAL(wp) :: zrat_r6p_r6n ! 172 REAL(wp) :: zrat_r6s_r6n ! 173 REAL(wp) :: zrat_r8c_r8n ! 174 REAL(wp) :: zrat_r8p_r8n ! 175 REAL(wp) :: zrat_r8s_r8n ! 176 REAL(wp) :: zrat_p1c_chl1 ! 177 REAL(wp) :: zrat_p1n_chl1 ! 178 REAL(wp) :: zrat_p1p_chl1 ! 179 REAL(wp) :: zrat_p1s_chl1 ! 180 REAL(wp) :: zrat_p2c_chl2 ! 181 REAL(wp) :: zrat_p2n_chl2 ! 182 REAL(wp) :: zrat_p2p_chl2 ! 183 REAL(wp) :: zrat_p3c_chl3 ! 184 REAL(wp) :: zrat_p3n_chl3 ! 185 REAL(wp) :: zrat_p3p_chl3 ! 186 REAL(wp) :: zrat_p4c_chl4 ! 187 REAL(wp) :: zrat_p4n_chl4 ! 188 REAL(wp) :: zrat_p4p_chl4 ! 145 189 REAL(wp), DIMENSION(jpi,jpj) :: cchl_p ! C:Chl for total phy 146 190 REAL(wp), DIMENSION(16) :: modparm ! Model parameters … … 150 194 REAL(wp), DIMENSION(jpi,jpj,22) :: diag ! Depth-indep diagnostics 151 195 REAL(wp), DIMENSION(jpi,jpj,jpk,22) :: diag_fulldepth ! Full-depth diagnostics 196 REAL(wp), DIMENSION(jpi,jpj) :: pinc_chltot_temp 152 197 !!--------------------------------------------------------------------------- 198 199 ! Set parameters 200 zmassc = 12.01 201 zmassn = 14.01 202 z4qnc = 0.0126 203 !z4qnc = model%state_variables(jp_fabm_z4c)%parameters%qnc%value 204 !z4qnc = get_property_by_name(model%state_variables(jp_fabm_z4c)%parameters, 'qnc') 205 IF (lwp) WRITE(numout,*) 'z4qnc = ', z4qnc 153 206 154 207 ! If p_maxchlinc > 0 then cap total absolute chlorophyll increment at that value … … 160 213 END DO 161 214 END DO 162 ELSE IF ( ld_chldia .AND. ld_chlnon ) THEN215 ELSE 163 216 DO jj = 1, jpj 164 217 DO ji = 1, jpi 165 pinc_chltot(ji,jj) = pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) 166 pinc_chltot(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot(ji,jj), p_maxchlinc ) ) 167 IF ( pinc_chltot(ji,jj) .NE. ( pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) ) ) THEN 168 zfrac = pinc_chltot(ji,jj) / ( pinc_chldia(ji,jj) + pinc_chlnon(ji,jj) ) 169 pinc_chldia(ji,jj) = pinc_chldia(ji,jj) * zfrac 170 pinc_chlnon(ji,jj) = pinc_chlnon(ji,jj) * zfrac 171 ENDIF 172 END DO 173 END DO 174 ELSE IF ( ld_chldia ) THEN 175 DO jj = 1, jpj 176 DO ji = 1, jpi 177 pinc_chldia(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chldia(ji,jj), p_maxchlinc ) ) 178 pinc_chltot(ji,jj) = pinc_chldia(ji,jj) 179 END DO 180 END DO 181 ELSE IF ( ld_chlnon ) THEN 182 DO jj = 1, jpj 183 DO ji = 1, jpi 184 pinc_chlnon(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chlnon(ji,jj), p_maxchlinc ) ) 185 pinc_chltot(ji,jj) = pinc_chlnon(ji,jj) 218 IF ( ld_chldia .AND. ld_chlnan .AND. ld_chlpic .AND. ld_chldin ) THEN 219 pinc_chltot_temp(ji,jj) = pinc_chldia(ji,jj) + pinc_chlnan(ji,jj) + & 220 & pinc_chlpic(ji,jj) + pinc_chldin(ji,jj) 221 ELSE IF ( ld_chldia .AND. ld_chlnan .AND. ld_chlpic ) THEN 222 pinc_chltot_temp(ji,jj) = pinc_chldia(ji,jj) + pinc_chlnan(ji,jj) + & 223 & pinc_chlpic(ji,jj) 224 ELSE IF ( ld_chldia .AND. ld_chlnan .AND. ld_chldin ) THEN 225 pinc_chltot_temp(ji,jj) = pinc_chldia(ji,jj) + pinc_chlnan(ji,jj) + & 226 & pinc_chldin(ji,jj) 227 ELSE IF ( ld_chldia .AND. ld_chlpic .AND. ld_chldin ) THEN 228 pinc_chltot_temp(ji,jj) = pinc_chldia(ji,jj) + & 229 & pinc_chlpic(ji,jj) + pinc_chldin(ji,jj) 230 ELSE IF ( ld_chlnan .AND. ld_chlpic .AND. ld_chldin ) THEN 231 pinc_chltot_temp(ji,jj) = pinc_chlnan(ji,jj) + & 232 & pinc_chlpic(ji,jj) + pinc_chldin(ji,jj) 233 ELSE IF ( ld_chldia .AND. ld_chlnan ) THEN 234 pinc_chltot_temp(ji,jj) = pinc_chldia(ji,jj) + pinc_chlnan(ji,jj) 235 ELSE IF ( ld_chldia .AND. ld_chlpic ) THEN 236 pinc_chltot_temp(ji,jj) = pinc_chldia(ji,jj) + pinc_chlpic(ji,jj) 237 ELSE IF ( ld_chldia .AND. ld_chldin ) THEN 238 pinc_chltot_temp(ji,jj) = pinc_chldia(ji,jj) + pinc_chldin(ji,jj) 239 ELSE IF ( ld_chlnan .AND. ld_chlpic ) THEN 240 pinc_chltot_temp(ji,jj) = pinc_chlnan(ji,jj) + pinc_chlpic(ji,jj) 241 ELSE IF ( ld_chlnan .AND. ld_chldin ) THEN 242 pinc_chltot_temp(ji,jj) = pinc_chlnan(ji,jj) + pinc_chldin(ji,jj) 243 ELSE IF ( ld_chlpic .AND. ld_chldin ) THEN 244 pinc_chltot_temp(ji,jj) = pinc_chlpic(ji,jj) + pinc_chldin(ji,jj) 245 ELSE IF ( ld_chldia ) THEN 246 pinc_chltot_temp(ji,jj) = pinc_chldia(ji,jj) 247 ELSE IF ( ld_chlnan ) THEN 248 pinc_chltot_temp(ji,jj) = pinc_chlnan(ji,jj) 249 ELSE IF ( ld_chlpic ) THEN 250 pinc_chltot_temp(ji,jj) = pinc_chlpic(ji,jj) 251 ELSE IF ( ld_chldin ) THEN 252 pinc_chltot_temp(ji,jj) = pinc_chldin(ji,jj) 253 ENDIF 254 pinc_chltot(ji,jj) = MAX( -1.0 * p_maxchlinc, MIN( pinc_chltot_temp(ji,jj), p_maxchlinc ) ) 255 IF ( pinc_chltot(ji,jj) .NE. pinc_chltot_temp(ji,jj) ) THEN 256 zfrac = pinc_chltot(ji,jj) / pinc_chltot_temp(ji,jj) 257 IF ( ld_chldia ) THEN 258 pinc_chldia(ji,jj) = pinc_chldia(ji,jj) * zfrac 259 ENDIF 260 IF ( ld_chlnan ) THEN 261 pinc_chlnan(ji,jj) = pinc_chlnan(ji,jj) * zfrac 262 ENDIF 263 IF ( ld_chlpic ) THEN 264 pinc_chlpic(ji,jj) = pinc_chlpic(ji,jj) * zfrac 265 ENDIF 266 IF ( ld_chldin ) THEN 267 pinc_chldin(ji,jj) = pinc_chldin(ji,jj) * zfrac 268 ENDIF 269 ENDIF 186 270 END DO 187 271 END DO 188 272 ENDIF 189 273 ENDIF 190 191 IF ( ld_phytot .OR. ld_phydia .OR. ld_phynon ) THEN 192 CALL ctl_stop( ' No phytoplankton carbon assimilation quite yet' ) 193 ENDIF 274 275 ! Initialise balancing increments 276 phyto2d_balinc(:,:,:,:) = 0.0 194 277 195 278 IF ( ld_phytobal ) THEN ! Nitrogen balancing … … 197 280 ! Set up model parameters to be passed into Hemmings balancing routine. 198 281 ! For now these are hardwired to the standard HadOCC parameter values 199 ! (except C:N ratios)as this is what the scheme was developed for.200 ! Obviously, HadOCC and MEDUSAare rather different models, so this282 ! as this is what the scheme was developed for. 283 ! Obviously, HadOCC and ERSEM are rather different models, so this 201 284 ! isn't ideal, but there's not always direct analogues between the two 202 285 ! parameter sets, so it's the easiest way to get something running. … … 211 294 modparm(8) = 0.05 ! z_mort_1 212 295 modparm(9) = 1.0 ! z_mort_2 213 modparm(10) = ( xthetapn + xthetapd ) / 2.0! c2n_p214 modparm(11) = ( xthetazmi + xthetazme ) / 2.0! c2n_z215 modparm(12) = xthetad! c2n_d296 modparm(10) = 6.625 ! c2n_p 297 modparm(11) = 5.625 ! c2n_z 298 modparm(12) = 7.5 ! c2n_d 216 299 modparm(13) = 0.01 ! graze_threshold 217 300 modparm(14) = 2.0 ! holling_coef … … 250 333 251 334 ! Set background state 252 bstate(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jpdin) 253 bstate(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jpphn) + tracer_bkg(:,:,:,jpphd) 254 bstate(:,:,:,i_tracer(3)) = tracer_bkg(:,:,:,jpzmi) + tracer_bkg(:,:,:,jpzme) 255 bstate(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jpdet) 256 bstate(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jpdic) 257 bstate(:,:,:,i_tracer(6)) = tracer_bkg(:,:,:,jpalk) 335 bstate(:,:,:,i_tracer(1)) = tracer_bkg(:,:,:,jp_fabm_n3n) + & 336 & tracer_bkg(:,:,:,jp_fabm_n4n) 337 bstate(:,:,:,i_tracer(2)) = tracer_bkg(:,:,:,jp_fabm_p1n) + & 338 & tracer_bkg(:,:,:,jp_fabm_p2n) + & 339 & tracer_bkg(:,:,:,jp_fabm_p3n) + & 340 & tracer_bkg(:,:,:,jp_fabm_p4n) 341 bstate(:,:,:,i_tracer(3)) = (tracer_bkg(:,:,:,jp_fabm_z4c) * z4qnc) + & 342 & tracer_bkg(:,:,:,jp_fabm_z5n) + & 343 & tracer_bkg(:,:,:,jp_fabm_z6n) 344 bstate(:,:,:,i_tracer(4)) = tracer_bkg(:,:,:,jp_fabm_r4n) + & 345 & tracer_bkg(:,:,:,jp_fabm_r6n) + & 346 & tracer_bkg(:,:,:,jp_fabm_r8n) 347 bstate(:,:,:,i_tracer(5)) = tracer_bkg(:,:,:,jp_fabm_o3c) 348 bstate(:,:,:,i_tracer(6)) = totalk_bkg(:,:,:) 258 349 259 350 ! Calculate carbon to chlorophyll ratio for combined phytoplankton 260 ! and nitrogen to biomass equivalent for PZD 261 ! Hardwire nitrogen mass to 14.01 for now as it doesn't seem to be set in MEDUSA 351 ! and nitrogen to biomass equivalent for PZD (hardwire as per HadOCC) 262 352 cchl_p(:,:) = 0.0 263 353 DO jj = 1, jpj 264 354 DO ji = 1, jpi 265 IF ( ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) .GT. 0.0 ) THEN 266 cchl_p(ji,jj) = xmassc * ( ( tracer_bkg(ji,jj,1,jpphn) * xthetapn ) + & 267 & ( tracer_bkg(ji,jj,1,jpphd) * xthetapd ) ) / & 268 & ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd ) ) 355 IF ( ( tracer_bkg(ji,jj,1,jp_fabm_chl1) + tracer_bkg(ji,jj,1,jp_fabm_chl2) + & 356 & tracer_bkg(ji,jj,1,jp_fabm_chl3) + tracer_bkg(ji,jj,1,jp_fabm_chl4) ) .GT. 0.0 ) THEN 357 cchl_p(ji,jj) = zmassc * ( tracer_bkg(ji,jj,1,jp_fabm_p1c) + & 358 & tracer_bkg(ji,jj,1,jp_fabm_p2c) + & 359 & tracer_bkg(ji,jj,1,jp_fabm_p3c) + & 360 & tracer_bkg(ji,jj,1,jp_fabm_p4c) ) / & 361 & ( tracer_bkg(ji,jj,1,jp_fabm_chl1) + & 362 & tracer_bkg(ji,jj,1,jp_fabm_chl2) + & 363 & tracer_bkg(ji,jj,1,jp_fabm_chl3) + & 364 & tracer_bkg(ji,jj,1,jp_fabm_chl4) ) 269 365 ENDIF 270 366 END DO 271 367 END DO 272 n2be_p = 14.01 + ( xmassc * ( ( xthetapn + xthetapd ) / 2.0) )273 n2be_z = 14.01 + ( xmassc * ( ( xthetazmi + xthetazme ) / 2.0) )274 n2be_d = 14.01 + ( xmassc * xthetad)368 n2be_p = zmassn + ( zmassc * modparm(10) ) 369 n2be_z = zmassn + ( zmassc * modparm(11) ) 370 n2be_d = zmassn + ( zmassc * modparm(12) ) 275 371 276 372 ! Call nitrogen balancing routine … … 288 384 289 385 ! Loop over each grid point partioning the increments 290 phyto2d_balinc(:,:,:,:) = 0.0291 386 DO jk = 1, jpk 292 387 DO jj = 1, jpj … … 294 389 295 390 ! Phytoplankton 296 IF ( ( tracer_bkg(ji,jj,jk,jpphn) > 0.0 ) .AND. & 297 & ( tracer_bkg(ji,jj,jk,jpphd) > 0.0 ) .AND. & 391 IF ( ( tracer_bkg(ji,jj,jk,jp_fabm_p1n) > 0.0 ) .AND. & 392 & ( tracer_bkg(ji,jj,jk,jp_fabm_p2n) > 0.0 ) .AND. & 393 & ( tracer_bkg(ji,jj,jk,jp_fabm_p3n) > 0.0 ) .AND. & 394 & ( tracer_bkg(ji,jj,jk,jp_fabm_p4n) > 0.0 ) .AND. & 298 395 & ( pinc_chltot(ji,jj) /= 0.0 ) ) THEN 299 396 IF ( ld_chltot ) THEN 300 397 ! Phytoplankton nitrogen split up based on existing ratios 301 zfrac_phn = tracer_bkg(ji,jj,jk,jpphn) / & 302 & (tracer_bkg(ji,jj,jk,jpphn) + tracer_bkg(ji,jj,jk,jpphd)) 303 zfrac_phd = tracer_bkg(ji,jj,jk,jpphd) / & 304 & (tracer_bkg(ji,jj,jk,jpphn) + tracer_bkg(ji,jj,jk,jpphd)) 305 ELSE IF ( ld_chldia .AND. ld_chlnon ) THEN 398 zfrac_p1n = tracer_bkg(ji,jj,jk,jp_fabm_p1n) / & 399 & ( tracer_bkg(ji,jj,jk,jp_fabm_p1n) + & 400 & tracer_bkg(ji,jj,jk,jp_fabm_p2n) + & 401 & tracer_bkg(ji,jj,jk,jp_fabm_p3n) + & 402 & tracer_bkg(ji,jj,jk,jp_fabm_p4n) ) 403 zfrac_p2n = tracer_bkg(ji,jj,jk,jp_fabm_p2n) / & 404 & ( tracer_bkg(ji,jj,jk,jp_fabm_p1n) + & 405 & tracer_bkg(ji,jj,jk,jp_fabm_p2n) + & 406 & tracer_bkg(ji,jj,jk,jp_fabm_p3n) + & 407 & tracer_bkg(ji,jj,jk,jp_fabm_p4n) ) 408 zfrac_p3n = tracer_bkg(ji,jj,jk,jp_fabm_p3n) / & 409 & ( tracer_bkg(ji,jj,jk,jp_fabm_p1n) + & 410 & tracer_bkg(ji,jj,jk,jp_fabm_p2n) + & 411 & tracer_bkg(ji,jj,jk,jp_fabm_p3n) + & 412 & tracer_bkg(ji,jj,jk,jp_fabm_p4n) ) 413 zfrac_p4n = tracer_bkg(ji,jj,jk,jp_fabm_p4n) / & 414 & ( tracer_bkg(ji,jj,jk,jp_fabm_p1n) + & 415 & tracer_bkg(ji,jj,jk,jp_fabm_p2n) + & 416 & tracer_bkg(ji,jj,jk,jp_fabm_p3n) + & 417 & tracer_bkg(ji,jj,jk,jp_fabm_p4n) ) 418 ELSE 306 419 ! Phytoplankton nitrogen split up based on assimilation increments 307 zfrac_phn = pinc_chlnon(ji,jj) / pinc_chltot(ji,jj) 308 zfrac_phd = pinc_chldia(ji,jj) / pinc_chltot(ji,jj) 420 zfrac_p1n = pinc_chldia(ji,jj) / pinc_chltot(ji,jj) 421 zfrac_p2n = pinc_chlnan(ji,jj) / pinc_chltot(ji,jj) 422 zfrac_p3n = pinc_chlpic(ji,jj) / pinc_chltot(ji,jj) 423 zfrac_p4n = pinc_chldin(ji,jj) / pinc_chltot(ji,jj) 309 424 ENDIF 310 311 ! Phytoplankton silicate split up based on existing ratios312 zrat_pds_phd = tracer_bkg(ji,jj,jk,jppds) / tracer_bkg(ji,jj,jk,jpphd)313 425 314 ! Chlorophyll split up based on existing ratios to phytoplankton nitrogen 315 ! Not using pinc_chltot directly as it's only 2D 316 ! This method should give same results at surface as splitting pinc_chltot would 317 zrat_chn_phn = tracer_bkg(ji,jj,jk,jpchn) / tracer_bkg(ji,jj,jk,jpphn) 318 zrat_chd_phd = tracer_bkg(ji,jj,jk,jpchd) / tracer_bkg(ji,jj,jk,jpphd) 426 ! Other phytoplankton variables split up based on existing ratios with nitrogen 427 zrat_chl1_p1n = tracer_bkg(ji,jj,jk,jp_fabm_chl1) / tracer_bkg(ji,jj,jk,jp_fabm_p1n) 428 zrat_p1c_p1n = tracer_bkg(ji,jj,jk,jp_fabm_p1c) / tracer_bkg(ji,jj,jk,jp_fabm_p1n) 429 zrat_p1p_p1n = tracer_bkg(ji,jj,jk,jp_fabm_p1p) / tracer_bkg(ji,jj,jk,jp_fabm_p1n) 430 zrat_p1s_p1n = tracer_bkg(ji,jj,jk,jp_fabm_p1s) / tracer_bkg(ji,jj,jk,jp_fabm_p1n) 431 zrat_chl2_p2n = tracer_bkg(ji,jj,jk,jp_fabm_chl2) / tracer_bkg(ji,jj,jk,jp_fabm_p2n) 432 zrat_p2c_p2n = tracer_bkg(ji,jj,jk,jp_fabm_p2c) / tracer_bkg(ji,jj,jk,jp_fabm_p2n) 433 zrat_p2p_p2n = tracer_bkg(ji,jj,jk,jp_fabm_p2p) / tracer_bkg(ji,jj,jk,jp_fabm_p2n) 434 zrat_chl3_p3n = tracer_bkg(ji,jj,jk,jp_fabm_chl3) / tracer_bkg(ji,jj,jk,jp_fabm_p3n) 435 zrat_p3c_p3n = tracer_bkg(ji,jj,jk,jp_fabm_p3c) / tracer_bkg(ji,jj,jk,jp_fabm_p3n) 436 zrat_p3p_p3n = tracer_bkg(ji,jj,jk,jp_fabm_p3p) / tracer_bkg(ji,jj,jk,jp_fabm_p3n) 437 zrat_chl4_p4n = tracer_bkg(ji,jj,jk,jp_fabm_chl4) / tracer_bkg(ji,jj,jk,jp_fabm_p4n) 438 zrat_p4c_p4n = tracer_bkg(ji,jj,jk,jp_fabm_p4c) / tracer_bkg(ji,jj,jk,jp_fabm_p4n) 439 zrat_p4p_p4n = tracer_bkg(ji,jj,jk,jp_fabm_p4p) / tracer_bkg(ji,jj,jk,jp_fabm_p4n) 319 440 320 phyto2d_balinc(ji,jj,jk,jpphn) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phn 321 phyto2d_balinc(ji,jj,jk,jpphd) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_phd 322 phyto2d_balinc(ji,jj,jk,jppds) = phyto2d_balinc(ji,jj,jk,jpphd) * zrat_pds_phd 323 phyto2d_balinc(ji,jj,jk,jpchn) = phyto2d_balinc(ji,jj,jk,jpphn) * zrat_chn_phn 324 phyto2d_balinc(ji,jj,jk,jpchd) = phyto2d_balinc(ji,jj,jk,jpphd) * zrat_chd_phd 441 phyto2d_balinc(ji,jj,jk,jp_fabm_p1n) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_p1n 442 phyto2d_balinc(ji,jj,jk,jp_fabm_p2n) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_p2n 443 phyto2d_balinc(ji,jj,jk,jp_fabm_p3n) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_p3n 444 phyto2d_balinc(ji,jj,jk,jp_fabm_p4n) = outincs(ji,jj,jk,i_tracer(2)) * zfrac_p4n 445 phyto2d_balinc(ji,jj,jk,jp_fabm_chl1) = phyto2d_balinc(ji,jj,jk,jp_fabm_p1n) * zrat_chl1_p1n 446 phyto2d_balinc(ji,jj,jk,jp_fabm_p1c) = phyto2d_balinc(ji,jj,jk,jp_fabm_p1n) * zrat_p1c_p1n 447 phyto2d_balinc(ji,jj,jk,jp_fabm_p1p) = phyto2d_balinc(ji,jj,jk,jp_fabm_p1n) * zrat_p1p_p1n 448 phyto2d_balinc(ji,jj,jk,jp_fabm_p1s) = phyto2d_balinc(ji,jj,jk,jp_fabm_p1n) * zrat_p1s_p1n 449 phyto2d_balinc(ji,jj,jk,jp_fabm_chl2) = phyto2d_balinc(ji,jj,jk,jp_fabm_p2n) * zrat_chl2_p2n 450 phyto2d_balinc(ji,jj,jk,jp_fabm_p2c) = phyto2d_balinc(ji,jj,jk,jp_fabm_p2n) * zrat_p2c_p2n 451 phyto2d_balinc(ji,jj,jk,jp_fabm_p2p) = phyto2d_balinc(ji,jj,jk,jp_fabm_p2n) * zrat_p2p_p2n 452 phyto2d_balinc(ji,jj,jk,jp_fabm_chl3) = phyto2d_balinc(ji,jj,jk,jp_fabm_p3n) * zrat_chl3_p3n 453 phyto2d_balinc(ji,jj,jk,jp_fabm_p3c) = phyto2d_balinc(ji,jj,jk,jp_fabm_p3n) * zrat_p3c_p3n 454 phyto2d_balinc(ji,jj,jk,jp_fabm_p3p) = phyto2d_balinc(ji,jj,jk,jp_fabm_p3n) * zrat_p3p_p3n 455 phyto2d_balinc(ji,jj,jk,jp_fabm_chl4) = phyto2d_balinc(ji,jj,jk,jp_fabm_p4n) * zrat_chl4_p4n 456 phyto2d_balinc(ji,jj,jk,jp_fabm_p4c) = phyto2d_balinc(ji,jj,jk,jp_fabm_p4n) * zrat_p4c_p4n 457 phyto2d_balinc(ji,jj,jk,jp_fabm_p4p) = phyto2d_balinc(ji,jj,jk,jp_fabm_p4n) * zrat_p4p_p4n 325 458 ENDIF 326 459 327 460 ! Zooplankton nitrogen split up based on existing ratios 328 IF ( ( tracer_bkg(ji,jj,jk,jpzmi) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpzme) > 0.0 ) ) THEN 329 zfrac_zmi = tracer_bkg(ji,jj,jk,jpzmi) / & 330 & (tracer_bkg(ji,jj,jk,jpzmi) + tracer_bkg(ji,jj,jk,jpzme)) 331 zfrac_zme = tracer_bkg(ji,jj,jk,jpzme) / & 332 & (tracer_bkg(ji,jj,jk,jpzmi) + tracer_bkg(ji,jj,jk,jpzme)) 333 phyto2d_balinc(ji,jj,jk,jpzmi) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zmi 334 phyto2d_balinc(ji,jj,jk,jpzme) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_zme 335 ENDIF 336 337 ! Nitrogen nutrient straight from balancing scheme 338 phyto2d_balinc(ji,jj,jk,jpdin) = outincs(ji,jj,jk,i_tracer(1)) 339 340 ! Nitrogen detritus straight from balancing scheme 341 phyto2d_balinc(ji,jj,jk,jpdet) = outincs(ji,jj,jk,i_tracer(4)) 461 ! Update carbon and phosphorus according to existing ratios 462 IF ( ( tracer_bkg(ji,jj,jk,jp_fabm_z4c) > 0.0 ) .AND. & 463 & ( tracer_bkg(ji,jj,jk,jp_fabm_z5n) > 0.0 ) .AND. & 464 & ( tracer_bkg(ji,jj,jk,jp_fabm_z6n) > 0.0 ) ) THEN 465 zfrac_z4n = ( tracer_bkg(ji,jj,jk,jp_fabm_z4c) * z4qnc ) / & 466 & ( ( tracer_bkg(ji,jj,jk,jp_fabm_z4c) * z4qnc ) + & 467 & tracer_bkg(ji,jj,jk,jp_fabm_z5n) + & 468 & tracer_bkg(ji,jj,jk,jp_fabm_z6n) ) 469 zfrac_z5n = tracer_bkg(ji,jj,jk,jp_fabm_z5n) / & 470 & ( ( tracer_bkg(ji,jj,jk,jp_fabm_z4c) * z4qnc ) + & 471 & tracer_bkg(ji,jj,jk,jp_fabm_z5n) + & 472 & tracer_bkg(ji,jj,jk,jp_fabm_z6n) ) 473 zfrac_z6n = tracer_bkg(ji,jj,jk,jp_fabm_z6n) / & 474 & ( ( tracer_bkg(ji,jj,jk,jp_fabm_z4c) * z4qnc ) + & 475 & tracer_bkg(ji,jj,jk,jp_fabm_z5n) + & 476 & tracer_bkg(ji,jj,jk,jp_fabm_z6n) ) 477 zrat_z4c_z4n = 1.0 / z4qnc 478 zrat_z5c_z5n = tracer_bkg(ji,jj,jk,jp_fabm_z5c) / tracer_bkg(ji,jj,jk,jp_fabm_z5n) 479 zrat_z5p_z5n = tracer_bkg(ji,jj,jk,jp_fabm_z5p) / tracer_bkg(ji,jj,jk,jp_fabm_z5n) 480 zrat_z6c_z6n = tracer_bkg(ji,jj,jk,jp_fabm_z6c) / tracer_bkg(ji,jj,jk,jp_fabm_z6n) 481 zrat_z6p_z6n = tracer_bkg(ji,jj,jk,jp_fabm_z6p) / tracer_bkg(ji,jj,jk,jp_fabm_z6n) 482 phyto2d_balinc(ji,jj,jk,jp_fabm_z5n) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_z5n 483 phyto2d_balinc(ji,jj,jk,jp_fabm_z6n) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_z6n 484 phyto2d_balinc(ji,jj,jk,jp_fabm_z4c) = outincs(ji,jj,jk,i_tracer(3)) * zfrac_z4n * zrat_z4c_z4n 485 phyto2d_balinc(ji,jj,jk,jp_fabm_z5c) = phyto2d_balinc(ji,jj,jk,jp_fabm_z5n) * zrat_z5c_z5n 486 phyto2d_balinc(ji,jj,jk,jp_fabm_z6c) = phyto2d_balinc(ji,jj,jk,jp_fabm_z6n) * zrat_z6c_z6n 487 phyto2d_balinc(ji,jj,jk,jp_fabm_z5p) = phyto2d_balinc(ji,jj,jk,jp_fabm_z5n) * zrat_z5p_z5n 488 phyto2d_balinc(ji,jj,jk,jp_fabm_z6p) = phyto2d_balinc(ji,jj,jk,jp_fabm_z6n) * zrat_z6p_z6n 489 ENDIF 490 491 ! Nitrogen nutrient split between nitrate and ammonium based on existing ratios 492 IF ( ( tracer_bkg(ji,jj,jk,jp_fabm_n3n) > 0.0 ) .AND. & 493 & ( tracer_bkg(ji,jj,jk,jp_fabm_n4n) > 0.0 ) ) THEN 494 zfrac_n3n = tracer_bkg(ji,jj,jk,jp_fabm_n3n) / & 495 & (tracer_bkg(ji,jj,jk,jp_fabm_n3n) + tracer_bkg(ji,jj,jk,jp_fabm_n4n)) 496 zfrac_n4n = tracer_bkg(ji,jj,jk,jp_fabm_n4n) / & 497 & (tracer_bkg(ji,jj,jk,jp_fabm_n3n) + tracer_bkg(ji,jj,jk,jp_fabm_n4n)) 498 phyto2d_balinc(ji,jj,jk,jp_fabm_n3n) = outincs(ji,jj,jk,i_tracer(1)) * zfrac_n3n 499 phyto2d_balinc(ji,jj,jk,jp_fabm_n4n) = outincs(ji,jj,jk,i_tracer(1)) * zfrac_n4n 500 ENDIF 501 502 ! Detritus nitrogen split up based on existing ratios 503 ! Update carbon and phosphorus according to existing ratios 504 IF ( ( tracer_bkg(ji,jj,jk,jp_fabm_r4n) > 0.0 ) .AND. & 505 & ( tracer_bkg(ji,jj,jk,jp_fabm_r6n) > 0.0 ) .AND. & 506 & ( tracer_bkg(ji,jj,jk,jp_fabm_r8n) > 0.0 ) ) THEN 507 zfrac_r4n = tracer_bkg(ji,jj,jk,jp_fabm_r4n) / & 508 & (tracer_bkg(ji,jj,jk,jp_fabm_r4n) + & 509 & tracer_bkg(ji,jj,jk,jp_fabm_r6n) + & 510 & tracer_bkg(ji,jj,jk,jp_fabm_r8n)) 511 zfrac_r6n = tracer_bkg(ji,jj,jk,jp_fabm_r6n) / & 512 & (tracer_bkg(ji,jj,jk,jp_fabm_r4n) + & 513 & tracer_bkg(ji,jj,jk,jp_fabm_r6n) + & 514 & tracer_bkg(ji,jj,jk,jp_fabm_r8n)) 515 zfrac_r8n = tracer_bkg(ji,jj,jk,jp_fabm_r8n) / & 516 & (tracer_bkg(ji,jj,jk,jp_fabm_r4n) + & 517 & tracer_bkg(ji,jj,jk,jp_fabm_r6n) + & 518 & tracer_bkg(ji,jj,jk,jp_fabm_r8n)) 519 zrat_r4c_r4n = tracer_bkg(ji,jj,jk,jp_fabm_r4c) / tracer_bkg(ji,jj,jk,jp_fabm_r4n) 520 zrat_r4p_r4n = tracer_bkg(ji,jj,jk,jp_fabm_r4p) / tracer_bkg(ji,jj,jk,jp_fabm_r4n) 521 zrat_r6c_r6n = tracer_bkg(ji,jj,jk,jp_fabm_r6c) / tracer_bkg(ji,jj,jk,jp_fabm_r6n) 522 zrat_r6p_r6n = tracer_bkg(ji,jj,jk,jp_fabm_r6p) / tracer_bkg(ji,jj,jk,jp_fabm_r6n) 523 zrat_r6s_r6n = tracer_bkg(ji,jj,jk,jp_fabm_r6s) / tracer_bkg(ji,jj,jk,jp_fabm_r6n) 524 zrat_r8c_r8n = tracer_bkg(ji,jj,jk,jp_fabm_r8c) / tracer_bkg(ji,jj,jk,jp_fabm_r8n) 525 zrat_r8p_r8n = tracer_bkg(ji,jj,jk,jp_fabm_r8p) / tracer_bkg(ji,jj,jk,jp_fabm_r8n) 526 zrat_r8s_r8n = tracer_bkg(ji,jj,jk,jp_fabm_r8s) / tracer_bkg(ji,jj,jk,jp_fabm_r8n) 527 phyto2d_balinc(ji,jj,jk,jp_fabm_r4n) = outincs(ji,jj,jk,i_tracer(1)) * zfrac_r4n 528 phyto2d_balinc(ji,jj,jk,jp_fabm_r6n) = outincs(ji,jj,jk,i_tracer(1)) * zfrac_r6n 529 phyto2d_balinc(ji,jj,jk,jp_fabm_r8n) = outincs(ji,jj,jk,i_tracer(1)) * zfrac_r8n 530 phyto2d_balinc(ji,jj,jk,jp_fabm_r4c) = phyto2d_balinc(ji,jj,jk,jp_fabm_r4n) * zrat_r4c_r4n 531 phyto2d_balinc(ji,jj,jk,jp_fabm_r4p) = phyto2d_balinc(ji,jj,jk,jp_fabm_r4n) * zrat_r4p_r4n 532 phyto2d_balinc(ji,jj,jk,jp_fabm_r6c) = phyto2d_balinc(ji,jj,jk,jp_fabm_r6n) * zrat_r6c_r6n 533 phyto2d_balinc(ji,jj,jk,jp_fabm_r6p) = phyto2d_balinc(ji,jj,jk,jp_fabm_r6n) * zrat_r6p_r6n 534 phyto2d_balinc(ji,jj,jk,jp_fabm_r6s) = phyto2d_balinc(ji,jj,jk,jp_fabm_r6n) * zrat_r6s_r6n 535 phyto2d_balinc(ji,jj,jk,jp_fabm_r8c) = phyto2d_balinc(ji,jj,jk,jp_fabm_r8n) * zrat_r8c_r8n 536 phyto2d_balinc(ji,jj,jk,jp_fabm_r8p) = phyto2d_balinc(ji,jj,jk,jp_fabm_r8n) * zrat_r8p_r8n 537 phyto2d_balinc(ji,jj,jk,jp_fabm_r8s) = phyto2d_balinc(ji,jj,jk,jp_fabm_r8n) * zrat_r8s_r8n 538 ENDIF 342 539 343 540 ! DIC straight from balancing scheme 344 phyto2d_balinc(ji,jj,jk,jp dic) = outincs(ji,jj,jk,i_tracer(5))541 phyto2d_balinc(ji,jj,jk,jp_fabm_o3c) = outincs(ji,jj,jk,i_tracer(5)) 345 542 346 543 ! Alkalinity straight from balancing scheme 347 phyto2d_balinc(ji,jj,jk,jpalk) = outincs(ji,jj,jk,i_tracer(6)) 348 349 ! Remove diatom silicate increment from nutrient silicate to conserve mass 350 IF ( ( tracer_bkg(ji,jj,jk,jpsil) - phyto2d_balinc(ji,jj,jk,jppds) ) > 0.0 ) THEN 351 phyto2d_balinc(ji,jj,jk,jpsil) = phyto2d_balinc(ji,jj,jk,jppds) * (-1.0) 352 ENDIF 353 354 ! Carbon detritus based on existing ratios 355 IF ( ( tracer_bkg(ji,jj,jk,jpdet) > 0.0 ) .AND. ( tracer_bkg(ji,jj,jk,jpdtc) > 0.0 ) ) THEN 356 zrat_dtc_det = tracer_bkg(ji,jj,jk,jpdtc) / tracer_bkg(ji,jj,jk,jpdet) 357 phyto2d_balinc(ji,jj,jk,jpdtc) = phyto2d_balinc(ji,jj,jk,jpdet) * zrat_dtc_det 358 ENDIF 359 360 ! Do nothing with iron or oxygen for the time being 361 phyto2d_balinc(ji,jj,jk,jpfer) = 0.0 362 phyto2d_balinc(ji,jj,jk,jpoxy) = 0.0 544 phyto2d_balinc(ji,jj,jk,jp_fabm_o3ba) = outincs(ji,jj,jk,i_tracer(6)) 545 546 ! Remove P/R silicon increments from silicate to conserve mass 547 zfrac = phyto2d_balinc(ji,jj,jk,jp_fabm_p1s) + & 548 & phyto2d_balinc(ji,jj,jk,jp_fabm_r6s) + & 549 & phyto2d_balinc(ji,jj,jk,jp_fabm_r8s) 550 IF ( ( tracer_bkg(ji,jj,jk,jp_fabm_n5s) - zfrac ) > 0.0 ) THEN 551 phyto2d_balinc(ji,jj,jk,jp_fabm_n5s) = zfrac * (-1.0) 552 ENDIF 553 554 ! Remove P/Z/R phosphorus increments from phosphate to conserve mass 555 zfrac = phyto2d_balinc(ji,jj,jk,jp_fabm_p1p) + & 556 & phyto2d_balinc(ji,jj,jk,jp_fabm_p2p) + & 557 & phyto2d_balinc(ji,jj,jk,jp_fabm_p3p) + & 558 & phyto2d_balinc(ji,jj,jk,jp_fabm_p4p) + & 559 & phyto2d_balinc(ji,jj,jk,jp_fabm_z5p) + & 560 & phyto2d_balinc(ji,jj,jk,jp_fabm_z6p) + & 561 & phyto2d_balinc(ji,jj,jk,jp_fabm_r4p) + & 562 & phyto2d_balinc(ji,jj,jk,jp_fabm_r6p) + & 563 & phyto2d_balinc(ji,jj,jk,jp_fabm_r8p) 564 IF ( ( tracer_bkg(ji,jj,jk,jp_fabm_n1p) - zfrac ) > 0.0 ) THEN 565 phyto2d_balinc(ji,jj,jk,jp_fabm_n1p) = zfrac * (-1.0) 566 ENDIF 363 567 364 568 END DO … … 366 570 END DO 367 571 368 ELSE ! No nitrogen balancing 369 370 ! Initialise individual chlorophyll increments to zero 371 phyto2d_balinc(:,:,:,jpchn) = 0.0 372 phyto2d_balinc(:,:,:,jpchd) = 0.0 572 ELSE ! No nitrogen balancing - just update phytoplankton 373 573 374 574 ! Split up total surface chlorophyll increments 375 575 DO jj = 1, jpj 376 576 DO ji = 1, jpi 377 IF ( ( tracer_bkg(ji,jj,1,jpchn) > 0.0 ) .AND. & 378 & ( tracer_bkg(ji,jj,1,jpchd) > 0.0 ) ) THEN 577 IF ( ( tracer_bkg(ji,jj,1,jp_fabm_chl1) > 0.0 ) .AND. & 578 & ( tracer_bkg(ji,jj,1,jp_fabm_chl2) > 0.0 ) .AND. & 579 & ( tracer_bkg(ji,jj,1,jp_fabm_chl3) > 0.0 ) .AND. & 580 & ( tracer_bkg(ji,jj,1,jp_fabm_chl4) > 0.0 ) ) THEN 379 581 IF ( ld_chltot ) THEN 380 582 ! Chlorophyll split up based on existing ratios 381 zfrac_chn = tracer_bkg(ji,jj,1,jpchn) / & 382 & ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd) ) 383 zfrac_chd = tracer_bkg(ji,jj,1,jpchd) / & 384 & ( tracer_bkg(ji,jj,1,jpchn) + tracer_bkg(ji,jj,1,jpchd) ) 385 phyto2d_balinc(ji,jj,1,jpchn) = pinc_chltot(ji,jj) * zfrac_chn 386 phyto2d_balinc(ji,jj,1,jpchd) = pinc_chltot(ji,jj) * zfrac_chd 583 zfrac_chl1 = tracer_bkg(ji,jj,1,jp_fabm_chl1) / & 584 & ( tracer_bkg(ji,jj,1,jp_fabm_chl1) + & 585 & tracer_bkg(ji,jj,1,jp_fabm_chl2) + & 586 & tracer_bkg(ji,jj,1,jp_fabm_chl3) + & 587 & tracer_bkg(ji,jj,1,jp_fabm_chl4) ) 588 zfrac_chl2 = tracer_bkg(ji,jj,1,jp_fabm_chl2) / & 589 & ( tracer_bkg(ji,jj,1,jp_fabm_chl1) + & 590 & tracer_bkg(ji,jj,1,jp_fabm_chl2) + & 591 & tracer_bkg(ji,jj,1,jp_fabm_chl3) + & 592 & tracer_bkg(ji,jj,1,jp_fabm_chl4) ) 593 zfrac_chl3 = tracer_bkg(ji,jj,1,jp_fabm_chl3) / & 594 & ( tracer_bkg(ji,jj,1,jp_fabm_chl1) + & 595 & tracer_bkg(ji,jj,1,jp_fabm_chl2) + & 596 & tracer_bkg(ji,jj,1,jp_fabm_chl3) + & 597 & tracer_bkg(ji,jj,1,jp_fabm_chl4) ) 598 zfrac_chl4 = tracer_bkg(ji,jj,1,jp_fabm_chl4) / & 599 & ( tracer_bkg(ji,jj,1,jp_fabm_chl1) + & 600 & tracer_bkg(ji,jj,1,jp_fabm_chl2) + & 601 & tracer_bkg(ji,jj,1,jp_fabm_chl3) + & 602 & tracer_bkg(ji,jj,1,jp_fabm_chl4) ) 603 phyto2d_balinc(ji,jj,1,jp_fabm_chl1) = pinc_chltot(ji,jj) * zfrac_chl1 604 phyto2d_balinc(ji,jj,1,jp_fabm_chl2) = pinc_chltot(ji,jj) * zfrac_chl2 605 phyto2d_balinc(ji,jj,1,jp_fabm_chl3) = pinc_chltot(ji,jj) * zfrac_chl3 606 phyto2d_balinc(ji,jj,1,jp_fabm_chl4) = pinc_chltot(ji,jj) * zfrac_chl4 387 607 ENDIF 388 608 IF( ld_chldia ) THEN 389 phyto2d_balinc(ji,jj,1,jpchd) = pinc_chldia(ji,jj) 390 ENDIF 391 IF( ld_chlnon ) THEN 392 phyto2d_balinc(ji,jj,1,jpchn) = pinc_chlnon(ji,jj) 609 phyto2d_balinc(ji,jj,1,jp_fabm_chl1) = pinc_chldia(ji,jj) 610 ENDIF 611 IF( ld_chlnan ) THEN 612 phyto2d_balinc(ji,jj,1,jp_fabm_chl2) = pinc_chlnan(ji,jj) 613 ENDIF 614 IF( ld_chlpic ) THEN 615 phyto2d_balinc(ji,jj,1,jp_fabm_chl3) = pinc_chlpic(ji,jj) 616 ENDIF 617 IF( ld_chldin ) THEN 618 phyto2d_balinc(ji,jj,1,jp_fabm_chl4) = pinc_chldin(ji,jj) 393 619 ENDIF 394 620 395 ! Maintain stoichiometric ratios of nitrogen and silicate 396 IF ( ld_chltot .OR. ld_chlnon ) THEN 397 zrat_phn_chn = tracer_bkg(ji,jj,1,jpphn) / tracer_bkg(ji,jj,1,jpchn) 398 phyto2d_balinc(ji,jj,1,jpphn) = phyto2d_balinc(ji,jj,1,jpchn) * zrat_phn_chn 399 ENDIF 621 ! Maintain stoichiometric ratios of carbon, nitrogen, phosphorus and silicon 400 622 IF ( ld_chltot .OR. ld_chldia ) THEN 401 zrat_phd_chd = tracer_bkg(ji,jj,1,jpphd) / tracer_bkg(ji,jj,1,jpchd) 402 phyto2d_balinc(ji,jj,1,jpphd) = phyto2d_balinc(ji,jj,1,jpchd) * zrat_phd_chd 403 zrat_pds_chd = tracer_bkg(ji,jj,1,jppds) / tracer_bkg(ji,jj,1,jpchd) 404 phyto2d_balinc(ji,jj,1,jppds) = phyto2d_balinc(ji,jj,1,jpchd) * zrat_pds_chd 623 zrat_p1c_chl1 = tracer_bkg(ji,jj,1,jp_fabm_p1c) / tracer_bkg(ji,jj,1,jp_fabm_chl1) 624 zrat_p1n_chl1 = tracer_bkg(ji,jj,1,jp_fabm_p1n) / tracer_bkg(ji,jj,1,jp_fabm_chl1) 625 zrat_p1p_chl1 = tracer_bkg(ji,jj,1,jp_fabm_p1p) / tracer_bkg(ji,jj,1,jp_fabm_chl1) 626 zrat_p1s_chl1 = tracer_bkg(ji,jj,1,jp_fabm_p1s) / tracer_bkg(ji,jj,1,jp_fabm_chl1) 627 phyto2d_balinc(ji,jj,1,jp_fabm_p1c) = phyto2d_balinc(ji,jj,1,jp_fabm_chl1) * zrat_p1c_chl1 628 phyto2d_balinc(ji,jj,1,jp_fabm_p1n) = phyto2d_balinc(ji,jj,1,jp_fabm_chl1) * zrat_p1n_chl1 629 phyto2d_balinc(ji,jj,1,jp_fabm_p1p) = phyto2d_balinc(ji,jj,1,jp_fabm_chl1) * zrat_p1p_chl1 630 phyto2d_balinc(ji,jj,1,jp_fabm_p1s) = phyto2d_balinc(ji,jj,1,jp_fabm_chl1) * zrat_p1s_chl1 631 ENDIF 632 IF ( ld_chltot .OR. ld_chlnan ) THEN 633 zrat_p2c_chl2 = tracer_bkg(ji,jj,1,jp_fabm_p2c) / tracer_bkg(ji,jj,1,jp_fabm_chl2) 634 zrat_p2n_chl2 = tracer_bkg(ji,jj,1,jp_fabm_p2n) / tracer_bkg(ji,jj,1,jp_fabm_chl2) 635 zrat_p2p_chl2 = tracer_bkg(ji,jj,1,jp_fabm_p2p) / tracer_bkg(ji,jj,1,jp_fabm_chl2) 636 phyto2d_balinc(ji,jj,1,jp_fabm_p2c) = phyto2d_balinc(ji,jj,1,jp_fabm_chl2) * zrat_p2c_chl2 637 phyto2d_balinc(ji,jj,1,jp_fabm_p2n) = phyto2d_balinc(ji,jj,1,jp_fabm_chl2) * zrat_p2n_chl2 638 phyto2d_balinc(ji,jj,1,jp_fabm_p2p) = phyto2d_balinc(ji,jj,1,jp_fabm_chl2) * zrat_p2p_chl2 639 ENDIF 640 IF ( ld_chltot .OR. ld_chlpic ) THEN 641 zrat_p3c_chl3 = tracer_bkg(ji,jj,1,jp_fabm_p3c) / tracer_bkg(ji,jj,1,jp_fabm_chl3) 642 zrat_p3n_chl3 = tracer_bkg(ji,jj,1,jp_fabm_p3n) / tracer_bkg(ji,jj,1,jp_fabm_chl3) 643 zrat_p3p_chl3 = tracer_bkg(ji,jj,1,jp_fabm_p3p) / tracer_bkg(ji,jj,1,jp_fabm_chl3) 644 phyto2d_balinc(ji,jj,1,jp_fabm_p3c) = phyto2d_balinc(ji,jj,1,jp_fabm_chl3) * zrat_p3c_chl3 645 phyto2d_balinc(ji,jj,1,jp_fabm_p3n) = phyto2d_balinc(ji,jj,1,jp_fabm_chl3) * zrat_p3n_chl3 646 phyto2d_balinc(ji,jj,1,jp_fabm_p3p) = phyto2d_balinc(ji,jj,1,jp_fabm_chl3) * zrat_p3p_chl3 647 ENDIF 648 IF ( ld_chltot .OR. ld_chldin ) THEN 649 zrat_p4c_chl4 = tracer_bkg(ji,jj,1,jp_fabm_p4c) / tracer_bkg(ji,jj,1,jp_fabm_chl4) 650 zrat_p4n_chl4 = tracer_bkg(ji,jj,1,jp_fabm_p4n) / tracer_bkg(ji,jj,1,jp_fabm_chl4) 651 zrat_p4p_chl4 = tracer_bkg(ji,jj,1,jp_fabm_p4p) / tracer_bkg(ji,jj,1,jp_fabm_chl4) 652 phyto2d_balinc(ji,jj,1,jp_fabm_p4c) = phyto2d_balinc(ji,jj,1,jp_fabm_chl4) * zrat_p4c_chl4 653 phyto2d_balinc(ji,jj,1,jp_fabm_p4n) = phyto2d_balinc(ji,jj,1,jp_fabm_chl4) * zrat_p4n_chl4 654 phyto2d_balinc(ji,jj,1,jp_fabm_p4p) = phyto2d_balinc(ji,jj,1,jp_fabm_chl4) * zrat_p4p_chl4 405 655 ENDIF 406 656 ENDIF … … 422 672 ! 423 673 DO jk = 2, jkmax 424 phyto2d_balinc(ji,jj,jk,jpchn) = phyto2d_balinc(ji,jj,1,jpchn) 425 phyto2d_balinc(ji,jj,jk,jpchd) = phyto2d_balinc(ji,jj,1,jpchd) 426 phyto2d_balinc(ji,jj,jk,jpphn) = phyto2d_balinc(ji,jj,1,jpphn) 427 phyto2d_balinc(ji,jj,jk,jpphd) = phyto2d_balinc(ji,jj,1,jpphd) 428 phyto2d_balinc(ji,jj,jk,jppds) = phyto2d_balinc(ji,jj,1,jppds) 674 phyto2d_balinc(ji,jj,jk,jp_fabm_chl1) = phyto2d_balinc(ji,jj,1,jp_fabm_chl1) 675 phyto2d_balinc(ji,jj,jk,jp_fabm_p1c) = phyto2d_balinc(ji,jj,1,jp_fabm_p1c) 676 phyto2d_balinc(ji,jj,jk,jp_fabm_p1n) = phyto2d_balinc(ji,jj,1,jp_fabm_p1n) 677 phyto2d_balinc(ji,jj,jk,jp_fabm_p1p) = phyto2d_balinc(ji,jj,1,jp_fabm_p1p) 678 phyto2d_balinc(ji,jj,jk,jp_fabm_p1s) = phyto2d_balinc(ji,jj,1,jp_fabm_p1s) 679 phyto2d_balinc(ji,jj,jk,jp_fabm_chl2) = phyto2d_balinc(ji,jj,1,jp_fabm_chl2) 680 phyto2d_balinc(ji,jj,jk,jp_fabm_p2c) = phyto2d_balinc(ji,jj,1,jp_fabm_p2c) 681 phyto2d_balinc(ji,jj,jk,jp_fabm_p2n) = phyto2d_balinc(ji,jj,1,jp_fabm_p2n) 682 phyto2d_balinc(ji,jj,jk,jp_fabm_p2p) = phyto2d_balinc(ji,jj,1,jp_fabm_p2p) 683 phyto2d_balinc(ji,jj,jk,jp_fabm_chl3) = phyto2d_balinc(ji,jj,1,jp_fabm_chl3) 684 phyto2d_balinc(ji,jj,jk,jp_fabm_p3c) = phyto2d_balinc(ji,jj,1,jp_fabm_p3c) 685 phyto2d_balinc(ji,jj,jk,jp_fabm_p3n) = phyto2d_balinc(ji,jj,1,jp_fabm_p3n) 686 phyto2d_balinc(ji,jj,jk,jp_fabm_p3p) = phyto2d_balinc(ji,jj,1,jp_fabm_p3p) 687 phyto2d_balinc(ji,jj,jk,jp_fabm_chl4) = phyto2d_balinc(ji,jj,1,jp_fabm_chl4) 688 phyto2d_balinc(ji,jj,jk,jp_fabm_p4c) = phyto2d_balinc(ji,jj,1,jp_fabm_p4c) 689 phyto2d_balinc(ji,jj,jk,jp_fabm_p4n) = phyto2d_balinc(ji,jj,1,jp_fabm_p4n) 690 phyto2d_balinc(ji,jj,jk,jp_fabm_p4p) = phyto2d_balinc(ji,jj,1,jp_fabm_p4p) 429 691 END DO 430 692 ! … … 432 694 END DO 433 695 434 ! Set other balancing increments to zero435 phyto2d_balinc(:,:,:,jpzmi) = 0.0436 phyto2d_balinc(:,:,:,jpzme) = 0.0437 phyto2d_balinc(:,:,:,jpdin) = 0.0438 phyto2d_balinc(:,:,:,jpsil) = 0.0439 phyto2d_balinc(:,:,:,jpfer) = 0.0440 phyto2d_balinc(:,:,:,jpdet) = 0.0441 phyto2d_balinc(:,:,:,jpdtc) = 0.0442 phyto2d_balinc(:,:,:,jpdic) = 0.0443 phyto2d_balinc(:,:,:,jpalk) = 0.0444 phyto2d_balinc(:,:,:,jpoxy) = 0.0445 446 696 ENDIF 447 448 ! If performing extra tidal mixing in the Indonesian Throughflow, 449 ! increments have been found to make the carbon cycle unstable 450 ! Therefore, mask these out 451 IF ( ln_tmx_itf ) THEN 452 DO jn = 1, jptra 453 DO jk = 1, jpk 454 phyto2d_balinc(:,:,jk,jn) = phyto2d_balinc(:,:,jk,jn) * ( 1.0 - mask_itf(:,:) ) 455 END DO 456 END DO 457 ENDIF 458 459 END SUBROUTINE asm_phyto2d_bal_medusa 697 698 END SUBROUTINE asm_phyto2d_bal_ersem 460 699 461 700 #else … … 464 703 !!---------------------------------------------------------------------- 465 704 CONTAINS 466 SUBROUTINE asm_phyto2d_bal_medusa( ld_chltot, & 467 & pinc_chltot, & 468 & ld_chldia, & 469 & pinc_chldia, & 470 & ld_chlnon, & 471 & pinc_chlnon, & 472 & ld_phytot, & 473 & pinc_phytot, & 474 & ld_phydia, & 475 & pinc_phydia, & 476 & ld_phynon, & 477 & pinc_phynon, & 478 & pincper, & 479 & p_maxchlinc, ld_phytobal, pmld, & 480 & pgrow_avg_bkg, ploss_avg_bkg, & 481 & phyt_avg_bkg, mld_max_bkg, & 482 & tracer_bkg, phyto2d_balinc ) 705 SUBROUTINE asm_phyto2d_bal_ersem( ld_chltot, & 706 & pinc_chltot, & 707 & ld_chldia, & 708 & pinc_chldia, & 709 & ld_chlnan, & 710 & pinc_chlnan, & 711 & ld_chlpic, & 712 & pinc_chlpic, & 713 & ld_chldin, & 714 & pinc_chldin, & 715 & pincper, & 716 & p_maxchlinc, ld_phytobal, pmld, & 717 & pgrow_avg_bkg, ploss_avg_bkg, & 718 & phyt_avg_bkg, mld_max_bkg, & 719 & totalk_bkg, & 720 & tracer_bkg, phyto2d_balinc ) 483 721 LOGICAL :: ld_chltot 484 722 REAL :: pinc_chltot(:,:) 485 723 LOGICAL :: ld_chldia 486 724 REAL :: pinc_chldia(:,:) 487 LOGICAL :: ld_chlnon 488 REAL :: pinc_chlnon(:,:) 489 LOGICAL :: ld_phytot 490 REAL :: pinc_phytot(:,:) 491 LOGICAL :: ld_phydia 492 REAL :: pinc_phydia(:,:) 493 LOGICAL :: ld_phynon 494 REAL :: pinc_phynon(:,:) 725 LOGICAL :: ld_chlnan 726 REAL :: pinc_chlnan(:,:) 727 LOGICAL :: ld_chlpic 728 REAL :: pinc_chlpic(:,:) 729 LOGICAL :: ld_chldin 730 REAL :: pinc_chldin(:,:) 495 731 REAL :: pincper 496 732 REAL :: p_maxchlinc … … 501 737 REAL :: phyt_avg_bkg(:,:) 502 738 REAL :: mld_max_bkg(:,:) 739 REAL :: totalk_bkg(:,:,:) 503 740 REAL :: tracer_bkg(:,:,:,:) 504 741 REAL :: phyto2d_balinc(:,:,:,:) 505 WRITE(*,*) 'asm_phyto2d_bal_ medusa: You should not have seen this print! error?'506 END SUBROUTINE asm_phyto2d_bal_ medusa742 WRITE(*,*) 'asm_phyto2d_bal_ersem: You should not have seen this print! error?' 743 END SUBROUTINE asm_phyto2d_bal_ersem 507 744 #endif 508 745 509 746 !!====================================================================== 510 END MODULE asmphyto2dbal_ medusa747 END MODULE asmphyto2dbal_ersem
Note: See TracChangeset
for help on using the changeset viewer.