156 | | REAL(wp) :: zdic, zalk, zoxy |
157 | | REAL(wp) :: ztmp, zsal |
158 | | REAL(wp) :: zpho |
159 | | # endif |
160 | | !! |
161 | | !! integrated source and sink terms |
162 | | REAL(wp) :: b0 |
163 | | !! AXY (23/08/13): changed from individual variables for each flux to |
164 | | !! an array that holds all fluxes |
165 | | REAL(wp), DIMENSION(jp_medusa) :: btra |
166 | | !! |
167 | | !! primary production and chl related quantities |
168 | | REAL(wp) :: fthetan,faln,fchn1,fchn,fjln,fprn,frn |
169 | | REAL(wp) :: fthetad,fald,fchd1,fchd,fjld,fprd,frd |
170 | | !! AXY (23/11/16): add in light-only limitation term (normalised 0-1 range) |
171 | | REAL(wp) :: fjlim_pn, fjlim_pd |
172 | | !! AXY (03/02/11): add in Liebig terms |
173 | | REAL(wp) :: fpnlim, fpdlim |
174 | | !! AXY (16/07/09): add in Eppley curve functionality |
175 | | REAL(wp) :: loc_T,fun_T,xvpnT,xvpdT |
176 | | INTEGER :: ieppley |
177 | | !! AXY (16/05/11): per Katya's prompting, add in new T-dependence |
178 | | !! for phytoplankton growth only (i.e. no change |
179 | | !! for remineralisation) |
180 | | REAL(wp) :: fun_Q10 |
181 | | !! AXY (01/03/10): add in mixed layer PP diagnostics |
182 | | REAL(wp), DIMENSION(jpi,jpj) :: fprn_ml,fprd_ml |
183 | | !! |
184 | | !! nutrient limiting factors |
185 | | REAL(wp) :: fnln,ffln !! N and Fe |
186 | | REAL(wp) :: fnld,ffld,fsld,fsld2 !! N, Fe and Si |
187 | | !! |
188 | | !! silicon cycle |
189 | | REAL(wp) :: fsin,fnsi,fsin1,fnsi1,fnsi2,fprds,fsdiss |
190 | | !! |
191 | | !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme |
192 | | REAL(wp) :: ffetop,ffebot,ffescav |
193 | | REAL(wp) :: xLgF, xFeT, xFeF, xFeL !! state variables for iron-ligand system |
194 | | REAL(wp), DIMENSION(jpi,jpj) :: xFree !! state variables for iron-ligand system |
195 | | REAL(wp) :: xb_coef_tmp, xb2M4ac !! iron-ligand parameters |
196 | | REAL(wp) :: xmaxFeF,fdeltaFe !! max Fe' parameters |
197 | | !! |
198 | | !! local parameters for Moore et al. (2004) alternative scavenging scheme |
199 | | REAL(wp) :: fbase_scav,fscal_sink,fscal_part,fscal_scav |
200 | | !! |
201 | | !! local parameters for Moore et al. (2008) alternative scavenging scheme |
202 | | REAL(wp) :: fscal_csink,fscal_sisink,fscal_casink |
203 | | !! |
204 | | !! local parameters for Galbraith et al. (2010) alternative scavenging scheme |
205 | | REAL(wp) :: xCscav1, xCscav2, xk_org, xORGscav !! organic portion of scavenging |
206 | | REAL(wp) :: xk_inorg, xINORGscav !! inorganic portion of scavenging |
207 | | !! |
208 | | !! microzooplankton grazing |
209 | | REAL(wp) :: fmi1,fmi,fgmipn,fgmid,fgmidc |
210 | | REAL(wp) :: finmi,ficmi,fstarmi,fmith,fmigrow,fmiexcr,fmiresp |
211 | | !! |
212 | | !! mesozooplankton grazing |
213 | | REAL(wp) :: fme1,fme,fgmepn,fgmepd,fgmepds,fgmezmi,fgmed,fgmedc |
214 | | REAL(wp) :: finme,ficme,fstarme,fmeth,fmegrow,fmeexcr,fmeresp |
215 | | !! |
216 | | !! mortality/Remineralisation (defunct parameter "fz" removed) |
217 | | REAL(wp) :: fdpn,fdpd,fdpds,fdzmi,fdzme,fdd |
| 161 | REAL(wp) :: zdic, zalk, zoxy |
| 162 | REAL(wp) :: ztmp, zsal |
| 163 | # endif |
| 164 | # if defined key_mocsy |
| 165 | REAL(wp) :: zpho |
| 166 | # endif |
| 167 | !! |
| 168 | !! integrated source and sink terms |
| 169 | REAL(wp) :: b0 |
| 170 | !! AXY (23/08/13): changed from individual variables for each flux to |
| 171 | !! an array that holds all fluxes |
| 172 | REAL(wp), DIMENSION(jp_medusa) :: btra |
| 173 | !! |
| 174 | !! primary production and chl related quantities |
| 175 | REAL(wp) :: fthetan,faln,fchn1,fchn,fjln,fprn,frn |
| 176 | REAL(wp) :: fthetad,fald,fchd1,fchd,fjld,fprd,frd |
| 177 | !! AXY (23/11/16): add in light-only limitation term (normalised 0-1 range) |
| 178 | REAL(wp) :: fjlim_pn, fjlim_pd |
| 179 | !! AXY (03/02/11): add in Liebig terms |
| 180 | REAL(wp) :: fpnlim, fpdlim |
| 181 | !! AXY (16/07/09): add in Eppley curve functionality |
| 182 | REAL(wp) :: loc_T,fun_T,xvpnT,xvpdT |
| 183 | INTEGER :: ieppley |
| 184 | !! AXY (16/05/11): per Katya's prompting, add in new T-dependence |
| 185 | !! for phytoplankton growth only (i.e. no change |
| 186 | !! for remineralisation) |
| 187 | REAL(wp) :: fun_Q10 |
| 188 | !! AXY (01/03/10): add in mixed layer PP diagnostics |
| 189 | REAL(wp), DIMENSION(jpi,jpj) :: fprn_ml,fprd_ml |
| 190 | !! |
| 191 | !! nutrient limiting factors |
| 192 | REAL(wp) :: fnln,ffln !! N and Fe |
| 193 | REAL(wp) :: fnld,ffld,fsld,fsld2 !! N, Fe and Si |
| 194 | !! |
| 195 | !! silicon cycle |
| 196 | REAL(wp) :: fsin,fnsi,fsin1,fnsi1,fnsi2,fprds,fsdiss |
| 197 | !! |
| 198 | !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme |
| 199 | REAL(wp) :: ffetop,ffebot,ffescav |
| 200 | REAL(wp) :: xLgF, xFeT, xFeF, xFeL !! state variables for iron-ligand system |
| 201 | REAL(wp), DIMENSION(jpi,jpj) :: xFree !! state variables for iron-ligand system |
| 202 | REAL(wp) :: xb_coef_tmp, xb2M4ac !! iron-ligand parameters |
| 203 | REAL(wp) :: xmaxFeF,fdeltaFe !! max Fe' parameters |
| 204 | !! |
| 205 | !! local parameters for Moore et al. (2004) alternative scavenging scheme |
| 206 | REAL(wp) :: fbase_scav,fscal_sink,fscal_part,fscal_scav |
| 207 | !! |
| 208 | !! local parameters for Moore et al. (2008) alternative scavenging scheme |
| 209 | REAL(wp) :: fscal_csink,fscal_sisink,fscal_casink |
| 210 | !! |
| 211 | !! local parameters for Galbraith et al. (2010) alternative scavenging scheme |
| 212 | REAL(wp) :: xCscav1, xCscav2, xk_org, xORGscav !! organic portion of scavenging |
| 213 | REAL(wp) :: xk_inorg, xINORGscav !! inorganic portion of scavenging |
| 214 | !! |
| 215 | !! microzooplankton grazing |
| 216 | REAL(wp) :: fmi1,fmi,fgmipn,fgmid,fgmidc |
| 217 | REAL(wp) :: finmi,ficmi,fstarmi,fmith,fmigrow,fmiexcr,fmiresp |
| 218 | !! |
| 219 | !! mesozooplankton grazing |
| 220 | REAL(wp) :: fme1,fme,fgmepn,fgmepd,fgmepds,fgmezmi,fgmed,fgmedc |
| 221 | REAL(wp) :: finme,ficme,fstarme,fmeth,fmegrow,fmeexcr,fmeresp |
| 222 | !! |
| 223 | !! mortality/Remineralisation (defunct parameter "fz" removed) |
| 224 | REAL(wp) :: fdpn,fdpd,fdpds,fdzmi,fdzme,fdd |
290 | | !! |
291 | | !! flags to help with calculating the position of the CCD |
292 | | INTEGER, DIMENSION(jpi,jpj) :: i2_omcal,i2_omarg |
293 | | !! |
294 | | !! ROAM air-sea flux and diagnostic parameters |
295 | | REAL(wp) :: f_wind |
296 | | !! AXY (24/11/16): add xCO2 variable for atmosphere (what we actually have) |
297 | | REAL(wp) :: f_xco2a |
298 | | REAL(wp) :: f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_co2flux |
299 | | REAL(wp) :: f_TDIC, f_TALK, f_dcf, f_henry |
300 | | REAL(wp) :: f_uwind, f_vwind, f_pp0 |
301 | | REAL(wp) :: f_kw660, f_o2flux, f_o2sat, f_o2sat3 |
302 | | REAL(wp), DIMENSION(jpi,jpj) :: f_omcal, f_omarg |
303 | | !! |
304 | | !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen |
305 | | REAL(wp) :: f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm |
306 | | REAL(wp) :: f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2 |
307 | | !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s |
308 | | REAL, PARAMETER :: weight_CO2_mol = 44.0095 !! g / mol |
309 | | REAL, PARAMETER :: secs_in_day = 86400.0 !! s / d |
310 | | REAL, PARAMETER :: CO2flux_conv = (1.e-6 * weight_CO2_mol) / secs_in_day |
311 | | !! |
312 | | INTEGER :: iters |
313 | | REAL(wp) :: f_year |
314 | | INTEGER :: i_year |
315 | | INTEGER :: iyr1, iyr2 |
316 | | !! |
317 | | !! carbon, alkalinity production and consumption |
318 | | REAL(wp) :: fc_prod, fc_cons, fa_prod, fa_cons |
319 | | REAL(wp), DIMENSION(jpi,jpj) :: fcomm_resp |
320 | | REAL(wp), DIMENSION(jpi,jpj) :: fcar_prod, fcar_cons |
321 | | !! |
322 | | !! oxygen production and consumption (and non-consumption) |
323 | | REAL(wp) :: fo2_prod, fo2_cons, fo2_ncons, fo2_ccons |
324 | | REAL(wp), DIMENSION(jpi,jpj) :: foxy_prod, foxy_cons, foxy_anox |
325 | | !! Jpalm (11-08-2014) |
326 | | !! add DMS in MEDUSA for UKESM1 model |
327 | | REAL(wp) :: dms_surf |
328 | | !! AXY (13/03/15): add in other DMS calculations |
329 | | REAL(wp) :: dms_andr, dms_simo, dms_aran, dms_hall, dms_nlim, dms_wtkn |
330 | | # endif |
331 | | !! |
332 | | !! benthic fluxes |
333 | | INTEGER :: ibenthic |
334 | | REAL(wp), DIMENSION(jpi,jpj) :: f_sbenin_n, f_sbenin_fe, f_sbenin_c |
335 | | REAL(wp), DIMENSION(jpi,jpj) :: f_fbenin_n, f_fbenin_fe, f_fbenin_si, f_fbenin_c, f_fbenin_ca |
336 | | REAL(wp), DIMENSION(jpi,jpj) :: f_benout_n, f_benout_fe, f_benout_si, f_benout_c, f_benout_ca |
337 | | REAL(wp) :: zfact |
338 | | !! |
339 | | !! benthic fluxes of CaCO3 that shouldn't happen because of lysocline |
340 | | REAL(wp), DIMENSION(jpi,jpj) :: f_benout_lyso_ca |
341 | | !! |
342 | | !! riverine fluxes |
343 | | REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk |
344 | | !! AXY (19/07/12): variables for local riverine fluxes to handle inputs below surface |
345 | | REAL(wp) :: f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk |
346 | | !! |
347 | | !! horizontal grid location |
348 | | REAL(wp) :: flatx, flonx |
349 | | !! |
350 | | !! Jpalm -- 11-10-2015 -- adapt diag to iom_use |
351 | | !! 2D var for diagnostics. |
352 | | REAL(wp), POINTER, DIMENSION(:,: ) :: fprn2d, fdpn2d, fprd2d, fdpd2d, fprds2d, fsdiss2d, fgmipn2d |
353 | | REAL(wp), POINTER, DIMENSION(:,: ) :: fgmid2d, fdzmi2d, fgmepn2d, fgmepd2d, fgmezmi2d, fgmed2d |
354 | | REAL(wp), POINTER, DIMENSION(:,: ) :: fdzme2d, fslown2d, fdd2d, ffetop2d, ffebot2d, ffescav2d |
355 | | REAL(wp), POINTER, DIMENSION(:,: ) :: fjln2d, fnln2d, ffln2d, fjld2d, fnld2d, ffld2d, fsld2d2 |
356 | | REAL(wp), POINTER, DIMENSION(:,: ) :: fsld2d, fregen2d, fregensi2d, ftempn2d, ftempsi2d, ftempfe2d |
357 | | REAL(wp), POINTER, DIMENSION(:,: ) :: ftempc2d, ftempca2d, freminn2d, freminsi2d, freminfe2d |
358 | | REAL(wp), POINTER, DIMENSION(:,: ) :: freminc2d, freminca2d |
359 | | REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d |
| 297 | !! |
| 298 | !! flags to help with calculating the position of the CCD |
| 299 | INTEGER, DIMENSION(jpi,jpj) :: i2_omcal,i2_omarg |
| 300 | !! |
| 301 | !! ROAM air-sea flux and diagnostic parameters |
| 302 | REAL(wp) :: f_wind |
| 303 | !! AXY (24/11/16): add xCO2 variable for atmosphere (what we actually have) |
| 304 | REAL(wp) :: f_xco2a |
| 305 | REAL(wp) :: f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_co2flux |
| 306 | REAL(wp) :: f_TDIC, f_TALK, f_dcf, f_henry |
| 307 | REAL(wp) :: f_uwind, f_vwind, f_pp0 |
| 308 | REAL(wp) :: f_kw660, f_o2flux, f_o2sat, f_o2sat3 |
| 309 | REAL(wp), DIMENSION(jpi,jpj) :: f_omcal, f_omarg |
| 310 | !! |
| 311 | !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen |
| 312 | REAL(wp) :: f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm |
| 313 | REAL(wp) :: f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2 |
| 314 | !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s |
| 315 | REAL, PARAMETER :: weight_CO2_mol = 44.0095 !! g / mol |
| 316 | REAL, PARAMETER :: secs_in_day = 86400.0 !! s / d |
| 317 | REAL, PARAMETER :: CO2flux_conv = (1.e-6 * weight_CO2_mol) / secs_in_day |
| 318 | |
| 319 | !! |
| 320 | INTEGER :: iters |
| 321 | REAL(wp) :: f_year |
| 322 | INTEGER :: i_year |
| 323 | INTEGER :: iyr1, iyr2 |
| 324 | !! |
| 325 | !! carbon, alkalinity production and consumption |
| 326 | REAL(wp) :: fc_prod, fc_cons, fa_prod, fa_cons |
| 327 | REAL(wp), DIMENSION(jpi,jpj) :: fcomm_resp |
| 328 | REAL(wp), DIMENSION(jpi,jpj) :: fcar_prod, fcar_cons |
| 329 | !! |
| 330 | !! oxygen production and consumption (and non-consumption) |
| 331 | REAL(wp) :: fo2_prod, fo2_cons, fo2_ncons, fo2_ccons |
| 332 | REAL(wp), DIMENSION(jpi,jpj) :: foxy_prod, foxy_cons, foxy_anox |
| 333 | !! Jpalm (11-08-2014) |
| 334 | !! add DMS in MEDUSA for UKESM1 model |
| 335 | REAL(wp) :: dms_surf |
| 336 | !! AXY (13/03/15): add in other DMS calculations |
| 337 | REAL(wp) :: dms_andr, dms_simo, dms_aran, dms_hall |
| 338 | |
| 339 | # endif |
| 340 | !! |
| 341 | !! benthic fluxes |
| 342 | INTEGER :: ibenthic |
| 343 | REAL(wp), DIMENSION(jpi,jpj) :: f_sbenin_n, f_sbenin_fe, f_sbenin_c |
| 344 | REAL(wp), DIMENSION(jpi,jpj) :: f_fbenin_n, f_fbenin_fe, f_fbenin_si, f_fbenin_c, f_fbenin_ca |
| 345 | REAL(wp), DIMENSION(jpi,jpj) :: f_benout_n, f_benout_fe, f_benout_si, f_benout_c, f_benout_ca |
| 346 | REAL(wp) :: zfact |
| 347 | !! |
| 348 | !! benthic fluxes of CaCO3 that shouldn't happen because of lysocline |
| 349 | REAL(wp), DIMENSION(jpi,jpj) :: f_benout_lyso_ca |
| 350 | !! |
| 351 | !! riverine fluxes |
| 352 | REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk |
| 353 | !! AXY (19/07/12): variables for local riverine fluxes to handle inputs below surface |
| 354 | REAL(wp) :: f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk |
| 355 | !! |
| 356 | !! Jpalm -- 11-10-2015 -- adapt diag to iom_use |
| 357 | !! 2D var for diagnostics. |
| 358 | REAL(wp), POINTER, DIMENSION(:,: ) :: fprn2d, fdpn2d, fprd2d, fdpd2d, fprds2d, fsdiss2d, fgmipn2d |
| 359 | REAL(wp), POINTER, DIMENSION(:,: ) :: fgmid2d, fdzmi2d, fgmepn2d, fgmepd2d, fgmezmi2d, fgmed2d |
| 360 | REAL(wp), POINTER, DIMENSION(:,: ) :: fdzme2d, fslown2d, fdd2d, ffetop2d, ffebot2d, ffescav2d |
| 361 | REAL(wp), POINTER, DIMENSION(:,: ) :: fjln2d, fnln2d, ffln2d, fjld2d, fnld2d, ffld2d, fsld2d2 |
| 362 | REAL(wp), POINTER, DIMENSION(:,: ) :: fsld2d, fregen2d, fregensi2d, ftempn2d, ftempsi2d, ftempfe2d |
| 363 | REAL(wp), POINTER, DIMENSION(:,: ) :: ftempc2d, ftempca2d, freminn2d, freminsi2d, freminfe2d |
| 364 | REAL(wp), POINTER, DIMENSION(:,: ) :: freminc2d, freminca2d |
| 365 | REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d |
491 | | fflx_c(:,:) = 0.0 !! carbon flux total |
492 | | fflx_a(:,:) = 0.0 !! alkalinity flux total |
493 | | fflx_o2(:,:) = 0.0 !! oxygen flux total |
494 | | ftot_c(:,:) = 0.0 !! carbon inventory |
495 | | ftot_a(:,:) = 0.0 !! alkalinity inventory |
496 | | ftot_o2(:,:) = 0.0 !! oxygen inventory |
497 | | fifd_c(:,:) = 0.0 !! carbon fast detritus production |
498 | | fifd_a(:,:) = 0.0 !! alkalinity fast detritus production |
499 | | fifd_o2(:,:) = 0.0 !! oxygen fast detritus production |
500 | | fofd_c(:,:) = 0.0 !! carbon fast detritus remineralisation |
501 | | fofd_a(:,:) = 0.0 !! alkalinity fast detritus remineralisation |
502 | | fofd_o2(:,:) = 0.0 !! oxygen fast detritus remineralisation |
503 | | !! |
504 | | fnit_prod(:,:) = 0.0 !! (organic) nitrogen production |
505 | | fnit_cons(:,:) = 0.0 !! (organic) nitrogen consumption |
506 | | fsil_prod(:,:) = 0.0 !! (inorganic) silicon production |
507 | | fsil_cons(:,:) = 0.0 !! (inorganic) silicon consumption |
508 | | fcar_prod(:,:) = 0.0 !! (organic) carbon production |
509 | | fcar_cons(:,:) = 0.0 !! (organic) carbon consumption |
510 | | !! |
511 | | foxy_prod(:,:) = 0.0 !! oxygen production |
512 | | foxy_cons(:,:) = 0.0 !! oxygen consumption |
513 | | foxy_anox(:,:) = 0.0 !! unrealised oxygen consumption |
514 | | !! |
515 | | # endif |
516 | | ftot_n(:,:) = 0.0 !! N inventory |
517 | | ftot_si(:,:) = 0.0 !! Si inventory |
518 | | ftot_fe(:,:) = 0.0 !! Fe inventory |
519 | | ftot_pn(:,:) = 0.0 !! integrated non-diatom phytoplankton |
520 | | ftot_pd(:,:) = 0.0 !! integrated diatom phytoplankton |
521 | | ftot_zmi(:,:) = 0.0 !! integrated microzooplankton |
522 | | ftot_zme(:,:) = 0.0 !! integrated mesozooplankton |
523 | | ftot_det(:,:) = 0.0 !! integrated slow detritus, nitrogen |
524 | | ftot_dtc(:,:) = 0.0 !! integrated slow detritus, carbon |
525 | | !! |
526 | | fzmi_i(:,:) = 0.0 !! material grazed by microzooplankton |
527 | | fzmi_o(:,:) = 0.0 !! ... sum of fate of this material |
528 | | fzme_i(:,:) = 0.0 !! material grazed by mesozooplankton |
529 | | fzme_o(:,:) = 0.0 !! ... sum of fate of this material |
530 | | !! |
531 | | f_sbenin_n(:,:) = 0.0 !! slow detritus N -> benthic pool |
532 | | f_sbenin_fe(:,:) = 0.0 !! slow detritus Fe -> benthic pool |
533 | | f_sbenin_c(:,:) = 0.0 !! slow detritus C -> benthic pool |
534 | | f_fbenin_n(:,:) = 0.0 !! fast detritus N -> benthic pool |
535 | | f_fbenin_fe(:,:) = 0.0 !! fast detritus Fe -> benthic pool |
536 | | f_fbenin_si(:,:) = 0.0 !! fast detritus Si -> benthic pool |
537 | | f_fbenin_c(:,:) = 0.0 !! fast detritus C -> benthic pool |
538 | | f_fbenin_ca(:,:) = 0.0 !! fast detritus Ca -> benthic pool |
539 | | !! |
540 | | f_benout_n(:,:) = 0.0 !! benthic N pool -> dissolved |
541 | | f_benout_fe(:,:) = 0.0 !! benthic Fe pool -> dissolved |
542 | | f_benout_si(:,:) = 0.0 !! benthic Si pool -> dissolved |
543 | | f_benout_c(:,:) = 0.0 !! benthic C pool -> dissolved |
544 | | f_benout_ca(:,:) = 0.0 !! benthic Ca pool -> dissolved |
545 | | !! |
546 | | f_benout_lyso_ca(:,:) = 0.0 !! benthic Ca pool -> dissolved (when it shouldn't!) |
547 | | !! |
548 | | f_runoff(:,:) = 0.0 !! riverine runoff |
549 | | f_riv_n(:,:) = 0.0 !! riverine N input |
550 | | f_riv_si(:,:) = 0.0 !! riverine Si input |
551 | | f_riv_c(:,:) = 0.0 !! riverine C input |
552 | | f_riv_alk(:,:) = 0.0 !! riverine alk input |
553 | | !! |
554 | | !! Jpalm -- 06-03-2017 -- Forgotten var to init |
555 | | f_omarg(:,:) = 0.0 !! |
556 | | f_omcal(:,:) = 0.0 |
557 | | xFree(:,:) = 0.0 !! state variables for iron-ligand system |
558 | | fcomm_resp(:,:) = 0.0 |
559 | | fprn_ml(:,:) = 0.0 !! mixed layer PP diagnostics |
560 | | fprd_ml(:,:) = 0.0 !! mixed layer PP diagnostics |
561 | | |
562 | | !!---------------------------------------------------------------------- |
563 | | !! allocate and initiate 2D diag |
564 | | !!---------------------------------------------------------------------- |
565 | | !! |
566 | | IF ( lk_iomput .AND. .NOT. ln_diatrc ) THEN |
567 | | !! Juju :: add kt condition !! |
568 | | if ( kt == nittrc000 ) CALL trc_nam_iom_medusa !! initialise iom_use test |
| 509 | fflx_c(:,:) = 0.0 !! carbon flux total |
| 510 | fflx_a(:,:) = 0.0 !! alkalinity flux total |
| 511 | fflx_o2(:,:) = 0.0 !! oxygen flux total |
| 512 | ftot_c(:,:) = 0.0 !! carbon inventory |
| 513 | ftot_a(:,:) = 0.0 !! alkalinity inventory |
| 514 | ftot_o2(:,:) = 0.0 !! oxygen inventory |
| 515 | fifd_c(:,:) = 0.0 !! carbon fast detritus production |
| 516 | fifd_a(:,:) = 0.0 !! alkalinity fast detritus production |
| 517 | fifd_o2(:,:) = 0.0 !! oxygen fast detritus production |
| 518 | fofd_c(:,:) = 0.0 !! carbon fast detritus remineralisation |
| 519 | fofd_a(:,:) = 0.0 !! alkalinity fast detritus remineralisation |
| 520 | fofd_o2(:,:) = 0.0 !! oxygen fast detritus remineralisation |
| 521 | !! |
| 522 | fnit_prod(:,:) = 0.0 !! (organic) nitrogen production |
| 523 | fnit_cons(:,:) = 0.0 !! (organic) nitrogen consumption |
| 524 | fsil_prod(:,:) = 0.0 !! (inorganic) silicon production |
| 525 | fsil_cons(:,:) = 0.0 !! (inorganic) silicon consumption |
| 526 | fcar_prod(:,:) = 0.0 !! (organic) carbon production |
| 527 | fcar_cons(:,:) = 0.0 !! (organic) carbon consumption |
| 528 | !! |
| 529 | foxy_prod(:,:) = 0.0 !! oxygen production |
| 530 | foxy_cons(:,:) = 0.0 !! oxygen consumption |
| 531 | foxy_anox(:,:) = 0.0 !! unrealised oxygen consumption |
| 532 | !! |
| 533 | # endif |
| 534 | ftot_n(:,:) = 0.0 !! N inventory |
| 535 | ftot_si(:,:) = 0.0 !! Si inventory |
| 536 | ftot_fe(:,:) = 0.0 !! Fe inventory |
| 537 | ftot_pn(:,:) = 0.0 !! integrated non-diatom phytoplankton |
| 538 | ftot_pd(:,:) = 0.0 !! integrated diatom phytoplankton |
| 539 | ftot_zmi(:,:) = 0.0 !! integrated microzooplankton |
| 540 | ftot_zme(:,:) = 0.0 !! integrated mesozooplankton |
| 541 | ftot_det(:,:) = 0.0 !! integrated slow detritus, nitrogen |
| 542 | ftot_dtc(:,:) = 0.0 !! integrated slow detritus, carbon |
| 543 | !! |
| 544 | fzmi_i(:,:) = 0.0 !! material grazed by microzooplankton |
| 545 | fzmi_o(:,:) = 0.0 !! ... sum of fate of this material |
| 546 | fzme_i(:,:) = 0.0 !! material grazed by mesozooplankton |
| 547 | fzme_o(:,:) = 0.0 !! ... sum of fate of this material |
| 548 | !! |
| 549 | f_sbenin_n(:,:) = 0.0 !! slow detritus N -> benthic pool |
| 550 | f_sbenin_fe(:,:) = 0.0 !! slow detritus Fe -> benthic pool |
| 551 | f_sbenin_c(:,:) = 0.0 !! slow detritus C -> benthic pool |
| 552 | f_fbenin_n(:,:) = 0.0 !! fast detritus N -> benthic pool |
| 553 | f_fbenin_fe(:,:) = 0.0 !! fast detritus Fe -> benthic pool |
| 554 | f_fbenin_si(:,:) = 0.0 !! fast detritus Si -> benthic pool |
| 555 | f_fbenin_c(:,:) = 0.0 !! fast detritus C -> benthic pool |
| 556 | f_fbenin_ca(:,:) = 0.0 !! fast detritus Ca -> benthic pool |
| 557 | !! |
| 558 | f_benout_n(:,:) = 0.0 !! benthic N pool -> dissolved |
| 559 | f_benout_fe(:,:) = 0.0 !! benthic Fe pool -> dissolved |
| 560 | f_benout_si(:,:) = 0.0 !! benthic Si pool -> dissolved |
| 561 | f_benout_c(:,:) = 0.0 !! benthic C pool -> dissolved |
| 562 | f_benout_ca(:,:) = 0.0 !! benthic Ca pool -> dissolved |
| 563 | !! |
| 564 | f_benout_lyso_ca(:,:) = 0.0 !! benthic Ca pool -> dissolved (when it shouldn't!) |
| 565 | !! |
| 566 | f_runoff(:,:) = 0.0 !! riverine runoff |
| 567 | f_riv_n(:,:) = 0.0 !! riverine N input |
| 568 | f_riv_si(:,:) = 0.0 !! riverine Si input |
| 569 | f_riv_c(:,:) = 0.0 !! riverine C input |
| 570 | f_riv_alk(:,:) = 0.0 !! riverine alk input |
| 571 | !! |
| 572 | !! Jpalm -- 06-03-2017 -- Forgotten var to init |
| 573 | f_omarg(:,:) = 0.0 !! |
| 574 | f_omcal(:,:) = 0.0 |
| 575 | xFree(:,:) = 0.0 !! state variables for iron-ligand system |
| 576 | fcomm_resp(:,:) = 0.0 |
| 577 | fprn_ml(:,:) = 0.0 !! mixed layer PP diagnostics |
| 578 | fprd_ml(:,:) = 0.0 !! mixed layer PP diagnostics |
| 579 | |
| 580 | !! |
| 581 | !! allocate and initiate 2D diag |
| 582 | !! ----------------------------- |
| 583 | !! Juju :: add kt condition !! |
| 584 | IF ( lk_iomput .AND. .NOT. ln_diatrc ) THEN |
| 585 | !! |
| 586 | if ( kt == nittrc000 ) CALL trc_nam_iom_medusa !! initialise iom_use test |
| 587 | !! |
| 588 | CALL wrk_alloc( jpi, jpj, zw2d ) |
| 589 | zw2d(:,:) = 0.0 !! |
| 590 | IF ( med_diag%PRN%dgsave ) THEN |
| 591 | CALL wrk_alloc( jpi, jpj, fprn2d ) |
| 592 | fprn2d(:,:) = 0.0 !! |
| 593 | ENDIF |
| 594 | IF ( med_diag%MPN%dgsave ) THEN |
| 595 | CALL wrk_alloc( jpi, jpj, fdpn2d ) |
| 596 | fdpn2d(:,:) = 0.0 !! |
| 597 | ENDIF |
| 598 | IF ( med_diag%PRD%dgsave ) THEN |
| 599 | CALL wrk_alloc( jpi, jpj, fprd2d ) |
| 600 | fprd2d(:,:) = 0.0 !! |
| 601 | ENDIF |
| 602 | IF( med_diag%MPD%dgsave ) THEN |
| 603 | CALL wrk_alloc( jpi, jpj, fdpd2d ) |
| 604 | fdpd2d(:,:) = 0.0 !! |
| 605 | ENDIF |
| 606 | IF( med_diag%OPAL%dgsave ) THEN |
| 607 | CALL wrk_alloc( jpi, jpj, fprds2d ) |
| 608 | fprds2d(:,:) = 0.0 !! |
| 609 | ENDIF |
| 610 | IF( med_diag%OPALDISS%dgsave ) THEN |
| 611 | CALL wrk_alloc( jpi, jpj, fsdiss2d ) |
| 612 | fsdiss2d(:,:) = 0.0 !! |
| 613 | ENDIF |
| 614 | IF( med_diag%GMIPn%dgsave ) THEN |
| 615 | CALL wrk_alloc( jpi, jpj, fgmipn2d ) |
| 616 | fgmipn2d(:,:) = 0.0 !! |
| 617 | ENDIF |
| 618 | IF( med_diag%GMID%dgsave ) THEN |
| 619 | CALL wrk_alloc( jpi, jpj, fgmid2d ) |
| 620 | fgmid2d(:,:) = 0.0 !! |
| 621 | ENDIF |
| 622 | IF( med_diag%MZMI%dgsave ) THEN |
| 623 | CALL wrk_alloc( jpi, jpj, fdzmi2d ) |
| 624 | fdzmi2d(:,:) = 0.0 !! |
| 625 | ENDIF |
| 626 | IF( med_diag%GMEPN%dgsave ) THEN |
| 627 | CALL wrk_alloc( jpi, jpj, fgmepn2d ) |
| 628 | fgmepn2d(:,:) = 0.0 !! |
| 629 | ENDIF |
| 630 | IF( med_diag%GMEPD%dgsave ) THEN |
| 631 | CALL wrk_alloc( jpi, jpj, fgmepd2d ) |
| 632 | fgmepd2d(:,:) = 0.0 !! |
| 633 | ENDIF |
| 634 | IF( med_diag%GMEZMI%dgsave ) THEN |
| 635 | CALL wrk_alloc( jpi, jpj, fgmezmi2d ) |
| 636 | fgmezmi2d(:,:) = 0.0 !! |
| 637 | ENDIF |
| 638 | IF( med_diag%GMED%dgsave ) THEN |
| 639 | CALL wrk_alloc( jpi, jpj, fgmed2d ) |
| 640 | fgmed2d(:,:) = 0.0 !! |
| 641 | ENDIF |
| 642 | IF( med_diag%MZME%dgsave ) THEN |
| 643 | CALL wrk_alloc( jpi, jpj, fdzme2d ) |
| 644 | fdzme2d(:,:) = 0.0 !! |
| 645 | ENDIF |
| 646 | IF( med_diag%DETN%dgsave ) THEN |
| 647 | CALL wrk_alloc( jpi, jpj, fslown2d ) |
| 648 | fslown2d(:,:) = 0.0 !! |
| 649 | ENDIF |
| 650 | IF( med_diag%MDET%dgsave ) THEN |
| 651 | CALL wrk_alloc( jpi, jpj, fdd2d ) |
| 652 | fdd2d(:,:) = 0.0 !! |
| 653 | ENDIF |
| 654 | IF( med_diag%AEOLIAN%dgsave ) THEN |
| 655 | CALL wrk_alloc( jpi, jpj, ffetop2d ) |
| 656 | ffetop2d(:,:) = 0.0 !! |
| 657 | ENDIF |
| 658 | IF( med_diag%BENTHIC%dgsave ) THEN |
| 659 | CALL wrk_alloc( jpi, jpj, ffebot2d ) |
| 660 | ffebot2d(:,:) = 0.0 !! |
| 661 | ENDIF |
| 662 | IF( med_diag%SCAVENGE%dgsave ) THEN |
| 663 | CALL wrk_alloc( jpi, jpj, ffescav2d ) |
| 664 | ffescav2d(:,:) = 0.0 !! |
| 665 | ENDIF |
| 666 | IF( med_diag%PN_JLIM%dgsave ) THEN |
| 667 | CALL wrk_alloc( jpi, jpj, fjln2d ) |
| 668 | fjln2d(:,:) = 0.0 !! |
| 669 | ENDIF |
| 670 | IF( med_diag%PN_NLIM%dgsave ) THEN |
| 671 | CALL wrk_alloc( jpi, jpj, fnln2d ) |
| 672 | fnln2d(:,:) = 0.0 !! |
| 673 | ENDIF |
| 674 | IF( med_diag%PN_FELIM%dgsave ) THEN |
| 675 | CALL wrk_alloc( jpi, jpj, ffln2d ) |
| 676 | ffln2d(:,:) = 0.0 !! |
| 677 | ENDIF |
| 678 | IF( med_diag%PD_JLIM%dgsave ) THEN |
| 679 | CALL wrk_alloc( jpi, jpj, fjld2d ) |
| 680 | fjld2d(:,:) = 0.0 !! |
| 681 | ENDIF |
| 682 | IF( med_diag%PD_NLIM%dgsave ) THEN |
| 683 | CALL wrk_alloc( jpi, jpj, fnld2d ) |
| 684 | fnld2d(:,:) = 0.0 !! |
| 685 | ENDIF |
| 686 | IF( med_diag%PD_FELIM%dgsave ) THEN |
| 687 | CALL wrk_alloc( jpi, jpj, ffld2d ) |
| 688 | ffld2d(:,:) = 0.0 !! |
| 689 | ENDIF |
| 690 | IF( med_diag%PD_SILIM%dgsave ) THEN |
| 691 | CALL wrk_alloc( jpi, jpj, fsld2d2 ) |
| 692 | fsld2d2(:,:) = 0.0 !! |
| 693 | ENDIF |
| 694 | IF( med_diag%PDSILIM2%dgsave ) THEN |
| 695 | CALL wrk_alloc( jpi, jpj, fsld2d ) |
| 696 | fsld2d(:,:) = 0.0 !! |
| 697 | ENDIF |
| 698 | !! |
| 699 | !! skip SDT_XXXX diagnostics here |
| 700 | !! |
| 701 | IF( med_diag%TOTREG_N%dgsave ) THEN |
| 702 | CALL wrk_alloc( jpi, jpj, fregen2d ) |
| 703 | fregen2d(:,:) = 0.0 !! |
| 704 | ENDIF |
| 705 | IF( med_diag%TOTRG_SI%dgsave ) THEN |
| 706 | CALL wrk_alloc( jpi, jpj, fregensi2d ) |
| 707 | fregensi2d(:,:) = 0.0 !! |
| 708 | ENDIF |
| 709 | !! |
| 710 | !! skip REG_XXXX diagnostics here |
| 711 | !! |
| 712 | IF( med_diag%FASTN%dgsave ) THEN |
| 713 | CALL wrk_alloc( jpi, jpj, ftempn2d ) |
| 714 | ftempn2d(:,:) = 0.0 !! |
| 715 | ENDIF |
| 716 | IF( med_diag%FASTSI%dgsave ) THEN |
| 717 | CALL wrk_alloc( jpi, jpj, ftempsi2d ) |
| 718 | ftempsi2d(:,:) = 0.0 !! |
| 719 | ENDIF |
| 720 | IF( med_diag%FASTFE%dgsave ) THEN |
| 721 | CALL wrk_alloc( jpi, jpj, ftempfe2d ) |
| 722 | ftempfe2d(:,:) = 0.0 !! |
| 723 | ENDIF |
| 724 | IF( med_diag%FASTC%dgsave ) THEN |
| 725 | CALL wrk_alloc( jpi, jpj, ftempc2d ) |
| 726 | ftempc2d(:,:) = 0.0 !! |
| 727 | ENDIF |
| 728 | IF( med_diag%FASTCA%dgsave ) THEN |
| 729 | CALL wrk_alloc( jpi, jpj, ftempca2d ) |
| 730 | ftempca2d(:,:) = 0.0 !! |
| 731 | ENDIF |
| 732 | !! |
| 733 | !! skip FDT_XXXX, RG_XXXXF, FDS_XXXX, RGS_XXXXF diagnostics here |
| 734 | !! |
| 735 | IF( med_diag%REMINN%dgsave ) THEN |
| 736 | CALL wrk_alloc( jpi, jpj, freminn2d ) |
| 737 | freminn2d(:,:) = 0.0 !! |
| 738 | ENDIF |
| 739 | IF( med_diag%REMINSI%dgsave ) THEN |
| 740 | CALL wrk_alloc( jpi, jpj, freminsi2d ) |
| 741 | freminsi2d(:,:) = 0.0 !! |
| 742 | ENDIF |
| 743 | IF( med_diag%REMINFE%dgsave ) THEN |
| 744 | CALL wrk_alloc( jpi, jpj, freminfe2d ) |
| 745 | freminfe2d(:,:) = 0.0 !! |
| 746 | ENDIF |
| 747 | IF( med_diag%REMINC%dgsave ) THEN |
| 748 | CALL wrk_alloc( jpi, jpj, freminc2d ) |
| 749 | freminc2d(:,:) = 0.0 !! |
| 750 | ENDIF |
| 751 | IF( med_diag%REMINCA%dgsave ) THEN |
| 752 | CALL wrk_alloc( jpi, jpj, freminca2d ) |
| 753 | freminca2d(:,:) = 0.0 !! |
| 754 | ENDIF |
| 755 | # if defined key_roam |
| 756 | !! |
| 757 | !! skip SEAFLRXX, MED_XXXX, INTFLX_XX, INT_XX, ML_XXX, OCAL_XXX, FE_XXXX, MED_XZE, WIND diagnostics here |
| 758 | !! |
| 759 | IF( med_diag%RR_0100%dgsave ) THEN |
| 760 | CALL wrk_alloc( jpi, jpj, ffastca2d ) |
| 761 | ffastca2d(:,:) = 0.0 !! |
| 762 | ENDIF |
| 763 | |
| 764 | IF( med_diag%ATM_PCO2%dgsave ) THEN |
| 765 | CALL wrk_alloc( jpi, jpj, f_pco2a2d ) |
| 766 | f_pco2a2d(:,:) = 0.0 !! |
| 767 | ENDIF |
| 768 | !! |
| 769 | !! skip OCN_PH diagnostic here |
| 770 | !! |
| 771 | IF( med_diag%OCN_PCO2%dgsave ) THEN |
| 772 | CALL wrk_alloc( jpi, jpj, f_pco2w2d ) |
| 773 | f_pco2w2d(:,:) = 0.0 !! |
| 774 | ENDIF |
| 775 | !! |
| 776 | !! skip OCNH2CO3, OCN_HCO3, OCN_CO3 diagnostics here |
| 777 | !! |
| 778 | IF( med_diag%CO2FLUX%dgsave ) THEN |
| 779 | CALL wrk_alloc( jpi, jpj, f_co2flux2d ) |
| 780 | f_co2flux2d(:,:) = 0.0 !! |
| 781 | ENDIF |
| 782 | !! |
| 783 | !! skip OM_XXX diagnostics here |
| 784 | !! |
| 785 | IF( med_diag%TCO2%dgsave ) THEN |
| 786 | CALL wrk_alloc( jpi, jpj, f_TDIC2d ) |
| 787 | f_TDIC2d(:,:) = 0.0 !! |
| 788 | ENDIF |
| 789 | IF( med_diag%TALK%dgsave ) THEN |
| 790 | CALL wrk_alloc( jpi, jpj, f_TALK2d ) |
| 791 | f_TALK2d(:,:) = 0.0 !! |
| 792 | ENDIF |
| 793 | IF( med_diag%KW660%dgsave ) THEN |
| 794 | CALL wrk_alloc( jpi, jpj, f_kw6602d ) |
| 795 | f_kw6602d(:,:) = 0.0 !! |
| 796 | ENDIF |
| 797 | IF( med_diag%ATM_PP0%dgsave ) THEN |
| 798 | CALL wrk_alloc( jpi, jpj, f_pp02d ) |
| 799 | f_pp02d(:,:) = 0.0 !! |
| 800 | ENDIF |
| 801 | IF( med_diag%O2FLUX%dgsave ) THEN |
| 802 | CALL wrk_alloc( jpi, jpj, f_o2flux2d ) |
| 803 | f_o2flux2d(:,:) = 0.0 !! |
| 804 | ENDIF |
| 805 | IF( med_diag%O2SAT%dgsave ) THEN |
| 806 | CALL wrk_alloc( jpi, jpj, f_o2sat2d ) |
| 807 | f_o2sat2d(:,:) = 0.0 !! |
| 808 | ENDIF |
| 809 | !! |
| 810 | !! skip XXX_CCD diagnostics here |
| 811 | !! |
| 812 | IF( med_diag%SFR_OCAL%dgsave ) THEN |
| 813 | CALL wrk_alloc( jpi, jpj, sfr_ocal2d ) |
| 814 | sfr_ocal2d(:,:) = 0.0 !! |
| 815 | ENDIF |
| 816 | IF( med_diag%SFR_OARG%dgsave ) THEN |
| 817 | CALL wrk_alloc( jpi, jpj, sfr_oarg2d ) |
| 818 | sfr_oarg2d(:,:) = 0.0 !! |
| 819 | ENDIF |
| 820 | !! |
| 821 | !! skip XX_PROD, XX_CONS, O2_ANOX, RR_XXXX diagnostics here |
| 822 | !! |
| 823 | IF( med_diag%IBEN_N%dgsave ) THEN |
| 824 | CALL wrk_alloc( jpi, jpj, iben_n2d ) |
| 825 | iben_n2d(:,:) = 0.0 !! |
| 826 | ENDIF |
| 827 | IF( med_diag%IBEN_FE%dgsave ) THEN |
| 828 | CALL wrk_alloc( jpi, jpj, iben_fe2d ) |
| 829 | iben_fe2d(:,:) = 0.0 !! |
| 830 | ENDIF |
| 831 | IF( med_diag%IBEN_C%dgsave ) THEN |
| 832 | CALL wrk_alloc( jpi, jpj, iben_c2d ) |
| 833 | iben_c2d(:,:) = 0.0 !! |
| 834 | ENDIF |
| 835 | IF( med_diag%IBEN_SI%dgsave ) THEN |
| 836 | CALL wrk_alloc( jpi, jpj, iben_si2d ) |
| 837 | iben_si2d(:,:) = 0.0 !! |
| 838 | ENDIF |
| 839 | IF( med_diag%IBEN_CA%dgsave ) THEN |
| 840 | CALL wrk_alloc( jpi, jpj, iben_ca2d ) |
| 841 | iben_ca2d(:,:) = 0.0 !! |
| 842 | ENDIF |
| 843 | IF( med_diag%OBEN_N%dgsave ) THEN |
| 844 | CALL wrk_alloc( jpi, jpj, oben_n2d ) |
| 845 | oben_n2d(:,:) = 0.0 !! |
| 846 | ENDIF |
| 847 | IF( med_diag%OBEN_FE%dgsave ) THEN |
| 848 | CALL wrk_alloc( jpi, jpj, oben_fe2d ) |
| 849 | oben_fe2d(:,:) = 0.0 !! |
| 850 | ENDIF |
| 851 | IF( med_diag%OBEN_C%dgsave ) THEN |
| 852 | CALL wrk_alloc( jpi, jpj, oben_c2d ) |
| 853 | oben_c2d(:,:) = 0.0 !! |
| 854 | ENDIF |
| 855 | IF( med_diag%OBEN_SI%dgsave ) THEN |
| 856 | CALL wrk_alloc( jpi, jpj, oben_si2d ) |
| 857 | oben_si2d(:,:) = 0.0 !! |
| 858 | ENDIF |
| 859 | IF( med_diag%OBEN_CA%dgsave ) THEN |
| 860 | CALL wrk_alloc( jpi, jpj, oben_ca2d ) |
| 861 | oben_ca2d(:,:) = 0.0 !! |
| 862 | ENDIF |
| 863 | !! |
| 864 | !! skip BEN_XX diagnostics here |
| 865 | !! |
| 866 | IF( med_diag%RIV_N%dgsave ) THEN |
| 867 | CALL wrk_alloc( jpi, jpj, rivn2d ) |
| 868 | rivn2d(:,:) = 0.0 !! |
| 869 | ENDIF |
| 870 | IF( med_diag%RIV_SI%dgsave ) THEN |
| 871 | CALL wrk_alloc( jpi, jpj, rivsi2d ) |
| 872 | rivsi2d(:,:) = 0.0 !! |
| 873 | ENDIF |
| 874 | IF( med_diag%RIV_C%dgsave ) THEN |
| 875 | CALL wrk_alloc( jpi, jpj, rivc2d ) |
| 876 | rivc2d(:,:) = 0.0 !! |
| 877 | ENDIF |
| 878 | IF( med_diag%RIV_ALK%dgsave ) THEN |
| 879 | CALL wrk_alloc( jpi, jpj, rivalk2d ) |
| 880 | rivalk2d(:,:) = 0.0 !! |
| 881 | ENDIF |
| 882 | IF( med_diag%DETC%dgsave ) THEN |
| 883 | CALL wrk_alloc( jpi, jpj, fslowc2d ) |
| 884 | fslowc2d(:,:) = 0.0 !! |
| 885 | ENDIF |
| 886 | !! |
| 887 | !! skip SDC_XXXX, INVTXXX diagnostics here |
| 888 | !! |
| 889 | IF( med_diag%LYSO_CA%dgsave ) THEN |
| 890 | CALL wrk_alloc( jpi, jpj, lyso_ca2d ) |
| 891 | lyso_ca2d(:,:) = 0.0 !! |
| 892 | ENDIF |
| 893 | !! |
| 894 | !! skip COM_RESP diagnostic here |
| 895 | !! |
| 896 | IF( med_diag%PN_LLOSS%dgsave ) THEN |
| 897 | CALL wrk_alloc( jpi, jpj, fdpn22d ) |
| 898 | fdpn22d(:,:) = 0.0 !! |
| 899 | ENDIF |
| 900 | IF( med_diag%PD_LLOSS%dgsave ) THEN |
| 901 | CALL wrk_alloc( jpi, jpj, fdpd22d ) |
| 902 | fdpd22d(:,:) = 0.0 !! |
| 903 | ENDIF |
| 904 | IF( med_diag%ZI_LLOSS%dgsave ) THEN |
| 905 | CALL wrk_alloc( jpi, jpj, fdzmi22d ) |
| 906 | fdzmi22d(:,:) = 0.0 !! |
| 907 | ENDIF |
| 908 | IF( med_diag%ZE_LLOSS%dgsave ) THEN |
| 909 | CALL wrk_alloc( jpi, jpj, fdzme22d ) |
| 910 | fdzme22d(:,:) = 0.0 !! |
| 911 | ENDIF |
| 912 | IF( med_diag%ZI_MES_N%dgsave ) THEN |
| 913 | CALL wrk_alloc( jpi, jpj, zimesn2d ) |
| 914 | zimesn2d(:,:) = 0.0 !! |
| 915 | ENDIF |
| 916 | IF( med_diag%ZI_MES_D%dgsave ) THEN |
| 917 | CALL wrk_alloc( jpi, jpj, zimesd2d ) |
| 918 | zimesd2d(:,:) = 0.0 !! |
| 919 | ENDIF |
| 920 | IF( med_diag%ZI_MES_C%dgsave ) THEN |
| 921 | CALL wrk_alloc( jpi, jpj, zimesc2d ) |
| 922 | zimesc2d(:,:) = 0.0 !! |
| 923 | ENDIF |
| 924 | IF( med_diag%ZI_MESDC%dgsave ) THEN |
| 925 | CALL wrk_alloc( jpi, jpj, zimesdc2d ) |
| 926 | zimesdc2d(:,:) = 0.0 !! |
| 927 | ENDIF |
| 928 | IF( med_diag%ZI_EXCR%dgsave ) THEN |
| 929 | CALL wrk_alloc( jpi, jpj, ziexcr2d ) |
| 930 | ziexcr2d(:,:) = 0.0 !! |
| 931 | ENDIF |
| 932 | IF( med_diag%ZI_RESP%dgsave ) THEN |
| 933 | CALL wrk_alloc( jpi, jpj, ziresp2d ) |
| 934 | ziresp2d(:,:) = 0.0 !! |
| 935 | ENDIF |
| 936 | IF( med_diag%ZI_GROW%dgsave ) THEN |
| 937 | CALL wrk_alloc( jpi, jpj, zigrow2d ) |
| 938 | zigrow2d(:,:) = 0.0 !! |
| 939 | ENDIF |
| 940 | IF( med_diag%ZE_MES_N%dgsave ) THEN |
| 941 | CALL wrk_alloc( jpi, jpj, zemesn2d ) |
| 942 | zemesn2d(:,:) = 0.0 !! |
| 943 | ENDIF |
| 944 | IF( med_diag%ZE_MES_D%dgsave ) THEN |
| 945 | CALL wrk_alloc( jpi, jpj, zemesd2d ) |
| 946 | zemesd2d(:,:) = 0.0 !! |
| 947 | ENDIF |
| 948 | IF( med_diag%ZE_MES_C%dgsave ) THEN |
| 949 | CALL wrk_alloc( jpi, jpj, zemesc2d ) |
| 950 | zemesc2d(:,:) = 0.0 !! |
| 951 | ENDIF |
| 952 | IF( med_diag%ZE_MESDC%dgsave ) THEN |
| 953 | CALL wrk_alloc( jpi, jpj, zemesdc2d ) |
| 954 | zemesdc2d(:,:) = 0.0 !! |
| 955 | ENDIF |
| 956 | IF( med_diag%ZE_EXCR%dgsave ) THEN |
| 957 | CALL wrk_alloc( jpi, jpj, zeexcr2d ) |
| 958 | zeexcr2d(:,:) = 0.0 !! |
| 959 | ENDIF |
| 960 | IF( med_diag%ZE_RESP%dgsave ) THEN |
| 961 | CALL wrk_alloc( jpi, jpj, zeresp2d ) |
| 962 | zeresp2d(:,:) = 0.0 !! |
| 963 | ENDIF |
| 964 | IF( med_diag%ZE_GROW%dgsave ) THEN |
| 965 | CALL wrk_alloc( jpi, jpj, zegrow2d ) |
| 966 | zegrow2d(:,:) = 0.0 !! |
| 967 | ENDIF |
| 968 | IF( med_diag%MDETC%dgsave ) THEN |
| 969 | CALL wrk_alloc( jpi, jpj, mdetc2d ) |
| 970 | mdetc2d(:,:) = 0.0 !! |
| 971 | ENDIF |
| 972 | IF( med_diag%GMIDC%dgsave ) THEN |
| 973 | CALL wrk_alloc( jpi, jpj, gmidc2d ) |
| 974 | gmidc2d(:,:) = 0.0 !! |
| 975 | ENDIF |
| 976 | IF( med_diag%GMEDC%dgsave ) THEN |
| 977 | CALL wrk_alloc( jpi, jpj, gmedc2d ) |
| 978 | gmedc2d(:,:) = 0.0 !! |
| 979 | ENDIF |
| 980 | !! |
| 981 | !! skip INT_XXX diagnostics here |
| 982 | !! |
| 983 | IF (jdms .eq. 1) THEN |
| 984 | IF( med_diag%DMS_SURF%dgsave ) THEN |
| 985 | CALL wrk_alloc( jpi, jpj, dms_surf2d ) |
| 986 | dms_surf2d(:,:) = 0.0 !! |
| 987 | ENDIF |
| 988 | IF( med_diag%DMS_ANDR%dgsave ) THEN |
| 989 | CALL wrk_alloc( jpi, jpj, dms_andr2d ) |
| 990 | dms_andr2d(:,:) = 0.0 !! |
| 991 | ENDIF |
| 992 | IF( med_diag%DMS_SIMO%dgsave ) THEN |
| 993 | CALL wrk_alloc( jpi, jpj, dms_simo2d ) |
| 994 | dms_simo2d(:,:) = 0.0 !! |
| 995 | ENDIF |
| 996 | IF( med_diag%DMS_ARAN%dgsave ) THEN |
| 997 | CALL wrk_alloc( jpi, jpj, dms_aran2d ) |
| 998 | dms_aran2d(:,:) = 0.0 !! |
| 999 | ENDIF |
| 1000 | IF( med_diag%DMS_HALL%dgsave ) THEN |
| 1001 | CALL wrk_alloc( jpi, jpj, dms_hall2d ) |
| 1002 | dms_hall2d(:,:) = 0.0 !! |
| 1003 | ENDIF |
| 1004 | ENDIF |
| 1005 | !! |
| 1006 | !! AXY (24/11/16): extra MOCSY diagnostics, 2D |
| 1007 | IF( med_diag%ATM_XCO2%dgsave ) THEN |
| 1008 | CALL wrk_alloc( jpi, jpj, f_xco2a_2d ) |
| 1009 | f_xco2a_2d(:,:) = 0.0 !! |
| 1010 | ENDIF |
| 1011 | IF( med_diag%OCN_FCO2%dgsave ) THEN |
| 1012 | CALL wrk_alloc( jpi, jpj, f_fco2w_2d ) |
| 1013 | f_fco2w_2d(:,:) = 0.0 !! |
| 1014 | ENDIF |
| 1015 | IF( med_diag%ATM_FCO2%dgsave ) THEN |
| 1016 | CALL wrk_alloc( jpi, jpj, f_fco2a_2d ) |
| 1017 | f_fco2a_2d(:,:) = 0.0 !! |
| 1018 | ENDIF |
| 1019 | IF( med_diag%OCN_RHOSW%dgsave ) THEN |
| 1020 | CALL wrk_alloc( jpi, jpj, f_ocnrhosw_2d ) |
| 1021 | f_ocnrhosw_2d(:,:) = 0.0 !! |
| 1022 | ENDIF |
| 1023 | IF( med_diag%OCN_SCHCO2%dgsave ) THEN |
| 1024 | CALL wrk_alloc( jpi, jpj, f_ocnschco2_2d ) |
| 1025 | f_ocnschco2_2d(:,:) = 0.0 !! |
| 1026 | ENDIF |
| 1027 | IF( med_diag%OCN_KWCO2%dgsave ) THEN |
| 1028 | CALL wrk_alloc( jpi, jpj, f_ocnkwco2_2d ) |
| 1029 | f_ocnkwco2_2d(:,:) = 0.0 !! |
| 1030 | ENDIF |
| 1031 | IF( med_diag%OCN_K0%dgsave ) THEN |
| 1032 | CALL wrk_alloc( jpi, jpj, f_ocnk0_2d ) |
| 1033 | f_ocnk0_2d(:,:) = 0.0 !! |
| 1034 | ENDIF |
| 1035 | IF( med_diag%CO2STARAIR%dgsave ) THEN |
| 1036 | CALL wrk_alloc( jpi, jpj, f_co2starair_2d ) |
| 1037 | f_co2starair_2d(:,:) = 0.0 !! |
| 1038 | ENDIF |
| 1039 | IF( med_diag%OCN_DPCO2%dgsave ) THEN |
| 1040 | CALL wrk_alloc( jpi, jpj, f_ocndpco2_2d ) |
| 1041 | f_ocndpco2_2d(:,:) = 0.0 !! |
| 1042 | ENDIF |
| 1043 | # endif |
| 1044 | IF( med_diag%TPP3%dgsave ) THEN |
| 1045 | CALL wrk_alloc( jpi, jpj, jpk, tpp3d ) |
| 1046 | tpp3d(:,:,:) = 0.0 !! |
| 1047 | ENDIF |
| 1048 | IF( med_diag%DETFLUX3%dgsave ) THEN |
| 1049 | CALL wrk_alloc( jpi, jpj, jpk, detflux3d ) |
| 1050 | detflux3d(:,:,:) = 0.0 !! |
| 1051 | ENDIF |
| 1052 | IF( med_diag%REMIN3N%dgsave ) THEN |
| 1053 | CALL wrk_alloc( jpi, jpj, jpk, remin3dn ) |
| 1054 | remin3dn(:,:,:) = 0.0 !! |
| 1055 | ENDIF |
| 1056 | !! |
| 1057 | !! AXY (10/11/16): CMIP6 diagnostics, 2D |
| 1058 | !! JPALM -- 17-11-16 -- put fgco2 alloc out of diag request |
| 1059 | !! needed for coupling/passed through restart |
| 1060 | !! IF( med_diag%FGCO2%dgsave ) THEN |
| 1061 | CALL wrk_alloc( jpi, jpj, fgco2 ) |
| 1062 | fgco2(:,:) = 0.0 !! |
| 1063 | !! ENDIF |
| 1064 | IF( med_diag%INTDISSIC%dgsave ) THEN |
| 1065 | CALL wrk_alloc( jpi, jpj, intdissic ) |
| 1066 | intdissic(:,:) = 0.0 !! |
| 1067 | ENDIF |
| 1068 | IF( med_diag%INTDISSIN%dgsave ) THEN |
| 1069 | CALL wrk_alloc( jpi, jpj, intdissin ) |
| 1070 | intdissin(:,:) = 0.0 !! |
| 1071 | ENDIF |
| 1072 | IF( med_diag%INTDISSISI%dgsave ) THEN |
| 1073 | CALL wrk_alloc( jpi, jpj, intdissisi ) |
| 1074 | intdissisi(:,:) = 0.0 !! |
| 1075 | ENDIF |
| 1076 | IF( med_diag%INTTALK%dgsave ) THEN |
| 1077 | CALL wrk_alloc( jpi, jpj, inttalk ) |
| 1078 | inttalk(:,:) = 0.0 !! |
| 1079 | ENDIF |
| 1080 | IF( med_diag%O2min%dgsave ) THEN |
| 1081 | CALL wrk_alloc( jpi, jpj, o2min ) |
| 1082 | o2min(:,:) = 1.e3 !! set to high value as we're looking for min(o2) |
| 1083 | ENDIF |
| 1084 | IF( med_diag%ZO2min%dgsave ) THEN |
| 1085 | CALL wrk_alloc( jpi, jpj, zo2min ) |
| 1086 | zo2min(:,:) = 0.0 !! |
| 1087 | ENDIF |
| 1088 | IF( med_diag%FBDDTALK%dgsave ) THEN |
| 1089 | CALL wrk_alloc( jpi, jpj, fbddtalk ) |
| 1090 | fbddtalk(:,:) = 0.0 !! |
| 1091 | ENDIF |
| 1092 | IF( med_diag%FBDDTDIC%dgsave ) THEN |
| 1093 | CALL wrk_alloc( jpi, jpj, fbddtdic ) |
| 1094 | fbddtdic(:,:) = 0.0 !! |
| 1095 | ENDIF |
| 1096 | IF( med_diag%FBDDTDIFE%dgsave ) THEN |
| 1097 | CALL wrk_alloc( jpi, jpj, fbddtdife ) |
| 1098 | fbddtdife(:,:) = 0.0 !! |
| 1099 | ENDIF |
| 1100 | IF( med_diag%FBDDTDIN%dgsave ) THEN |
| 1101 | CALL wrk_alloc( jpi, jpj, fbddtdin ) |
| 1102 | fbddtdin(:,:) = 0.0 !! |
| 1103 | ENDIF |
| 1104 | IF( med_diag%FBDDTDISI%dgsave ) THEN |
| 1105 | CALL wrk_alloc( jpi, jpj, fbddtdisi ) |
| 1106 | fbddtdisi(:,:) = 0.0 !! |
| 1107 | ENDIF |
| 1108 | !! |
| 1109 | !! AXY (10/11/16): CMIP6 diagnostics, 3D |
| 1110 | IF( med_diag%TPPD3%dgsave ) THEN |
| 1111 | CALL wrk_alloc( jpi, jpj, jpk, tppd3 ) |
| 1112 | tppd3(:,:,:) = 0.0 !! |
| 1113 | ENDIF |
| 1114 | IF( med_diag%BDDTALK3%dgsave ) THEN |
| 1115 | CALL wrk_alloc( jpi, jpj, jpk, bddtalk3 ) |
| 1116 | bddtalk3(:,:,:) = 0.0 !! |
| 1117 | ENDIF |
| 1118 | IF( med_diag%BDDTDIC3%dgsave ) THEN |
| 1119 | CALL wrk_alloc( jpi, jpj, jpk, bddtdic3 ) |
| 1120 | bddtdic3(:,:,:) = 0.0 !! |
| 1121 | ENDIF |
| 1122 | IF( med_diag%BDDTDIFE3%dgsave ) THEN |
| 1123 | CALL wrk_alloc( jpi, jpj, jpk, bddtdife3 ) |
| 1124 | bddtdife3(:,:,:) = 0.0 !! |
| 1125 | ENDIF |
| 1126 | IF( med_diag%BDDTDIN3%dgsave ) THEN |
| 1127 | CALL wrk_alloc( jpi, jpj, jpk, bddtdin3 ) |
| 1128 | bddtdin3(:,:,:) = 0.0 !! |
| 1129 | ENDIF |
| 1130 | IF( med_diag%BDDTDISI3%dgsave ) THEN |
| 1131 | CALL wrk_alloc( jpi, jpj, jpk, bddtdisi3 ) |
| 1132 | bddtdisi3(:,:,:) = 0.0 !! |
| 1133 | ENDIF |
| 1134 | IF( med_diag%FD_NIT3%dgsave ) THEN |
| 1135 | CALL wrk_alloc( jpi, jpj, jpk, fd_nit3 ) |
| 1136 | fd_nit3(:,:,:) = 0.0 !! |
| 1137 | ENDIF |
| 1138 | IF( med_diag%FD_SIL3%dgsave ) THEN |
| 1139 | CALL wrk_alloc( jpi, jpj, jpk, fd_sil3 ) |
| 1140 | fd_sil3(:,:,:) = 0.0 !! |
| 1141 | ENDIF |
| 1142 | IF( med_diag%FD_CAR3%dgsave ) THEN |
| 1143 | CALL wrk_alloc( jpi, jpj, jpk, fd_car3 ) |
| 1144 | fd_car3(:,:,:) = 0.0 !! |
| 1145 | ENDIF |
| 1146 | IF( med_diag%FD_CAL3%dgsave ) THEN |
| 1147 | CALL wrk_alloc( jpi, jpj, jpk, fd_cal3 ) |
| 1148 | fd_cal3(:,:,:) = 0.0 !! |
| 1149 | ENDIF |
| 1150 | IF( med_diag%DCALC3%dgsave ) THEN |
| 1151 | CALL wrk_alloc( jpi, jpj, jpk, dcalc3 ) |
| 1152 | dcalc3(:,:,: ) = 0.0 !! |
| 1153 | ENDIF |
| 1154 | IF( med_diag%EXPC3%dgsave ) THEN |
| 1155 | CALL wrk_alloc( jpi, jpj, jpk, expc3 ) |
| 1156 | expc3(:,:,: ) = 0.0 !! |
| 1157 | ENDIF |
| 1158 | IF( med_diag%EXPN3%dgsave ) THEN |
| 1159 | CALL wrk_alloc( jpi, jpj, jpk, expn3 ) |
| 1160 | expn3(:,:,: ) = 0.0 !! |
| 1161 | ENDIF |
| 1162 | IF( med_diag%FEDISS3%dgsave ) THEN |
| 1163 | CALL wrk_alloc( jpi, jpj, jpk, fediss3 ) |
| 1164 | fediss3(:,:,: ) = 0.0 !! |
| 1165 | ENDIF |
| 1166 | IF( med_diag%FESCAV3%dgsave ) THEN |
| 1167 | CALL wrk_alloc( jpi, jpj, jpk, fescav3 ) |
| 1168 | fescav3(:,:,: ) = 0.0 !! |
| 1169 | ENDIF |
| 1170 | IF( med_diag%MIGRAZP3%dgsave ) THEN |
| 1171 | CALL wrk_alloc( jpi, jpj, jpk, migrazp3 ) |
| 1172 | migrazp3(:,:,: ) = 0.0 !! |
| 1173 | ENDIF |
| 1174 | IF( med_diag%MIGRAZD3%dgsave ) THEN |
| 1175 | CALL wrk_alloc( jpi, jpj, jpk, migrazd3 ) |
| 1176 | migrazd3(:,:,: ) = 0.0 !! |
| 1177 | ENDIF |
| 1178 | IF( med_diag%MEGRAZP3%dgsave ) THEN |
| 1179 | CALL wrk_alloc( jpi, jpj, jpk, megrazp3 ) |
| 1180 | megrazp3(:,:,: ) = 0.0 !! |
| 1181 | ENDIF |
| 1182 | IF( med_diag%MEGRAZD3%dgsave ) THEN |
| 1183 | CALL wrk_alloc( jpi, jpj, jpk, megrazd3 ) |
| 1184 | megrazd3(:,:,: ) = 0.0 !! |
| 1185 | ENDIF |
| 1186 | IF( med_diag%MEGRAZZ3%dgsave ) THEN |
| 1187 | CALL wrk_alloc( jpi, jpj, jpk, megrazz3 ) |
| 1188 | megrazz3(:,:,: ) = 0.0 !! |
| 1189 | ENDIF |
| 1190 | IF( med_diag%O2SAT3%dgsave ) THEN |
| 1191 | CALL wrk_alloc( jpi, jpj, jpk, o2sat3 ) |
| 1192 | o2sat3(:,:,: ) = 0.0 !! |
| 1193 | ENDIF |
| 1194 | IF( med_diag%PBSI3%dgsave ) THEN |
| 1195 | CALL wrk_alloc( jpi, jpj, jpk, pbsi3 ) |
| 1196 | pbsi3(:,:,: ) = 0.0 !! |
| 1197 | ENDIF |
| 1198 | IF( med_diag%PCAL3%dgsave ) THEN |
| 1199 | CALL wrk_alloc( jpi, jpj, jpk, pcal3 ) |
| 1200 | pcal3(:,:,: ) = 0.0 !! |
| 1201 | ENDIF |
| 1202 | IF( med_diag%REMOC3%dgsave ) THEN |
| 1203 | CALL wrk_alloc( jpi, jpj, jpk, remoc3 ) |
| 1204 | remoc3(:,:,: ) = 0.0 !! |
| 1205 | ENDIF |
| 1206 | IF( med_diag%PNLIMJ3%dgsave ) THEN |
| 1207 | CALL wrk_alloc( jpi, jpj, jpk, pnlimj3 ) |
| 1208 | pnlimj3(:,:,: ) = 0.0 !! |
| 1209 | ENDIF |
| 1210 | IF( med_diag%PNLIMN3%dgsave ) THEN |
| 1211 | CALL wrk_alloc( jpi, jpj, jpk, pnlimn3 ) |
| 1212 | pnlimn3(:,:,: ) = 0.0 !! |
| 1213 | ENDIF |
| 1214 | IF( med_diag%PNLIMFE3%dgsave ) THEN |
| 1215 | CALL wrk_alloc( jpi, jpj, jpk, pnlimfe3 ) |
| 1216 | pnlimfe3(:,:,: ) = 0.0 !! |
| 1217 | ENDIF |
| 1218 | IF( med_diag%PDLIMJ3%dgsave ) THEN |
| 1219 | CALL wrk_alloc( jpi, jpj, jpk, pdlimj3 ) |
| 1220 | pdlimj3(:,:,: ) = 0.0 !! |
| 1221 | ENDIF |
| 1222 | IF( med_diag%PDLIMN3%dgsave ) THEN |
| 1223 | CALL wrk_alloc( jpi, jpj, jpk, pdlimn3 ) |
| 1224 | pdlimn3(:,:,: ) = 0.0 !! |
| 1225 | ENDIF |
| 1226 | IF( med_diag%PDLIMFE3%dgsave ) THEN |
| 1227 | CALL wrk_alloc( jpi, jpj, jpk, pdlimfe3 ) |
| 1228 | pdlimfe3(:,:,: ) = 0.0 !! |
| 1229 | ENDIF |
| 1230 | IF( med_diag%PDLIMSI3%dgsave ) THEN |
| 1231 | CALL wrk_alloc( jpi, jpj, jpk, pdlimsi3 ) |
| 1232 | pdlimsi3(:,:,: ) = 0.0 !! |
| 1233 | ENDIF |
| 1234 | |
| 1235 | ENDIF |
| 1236 | !! lk_iomput |
570 | | CALL wrk_alloc( jpi, jpj, zw2d ) |
571 | | zw2d(:,:) = 0.0 !! |
572 | | IF ( med_diag%PRN%dgsave ) THEN |
573 | | CALL wrk_alloc( jpi, jpj, fprn2d ) |
574 | | fprn2d(:,:) = 0.0 !! |
575 | | ENDIF |
576 | | IF ( med_diag%MPN%dgsave ) THEN |
577 | | CALL wrk_alloc( jpi, jpj, fdpn2d ) |
578 | | fdpn2d(:,:) = 0.0 !! |
579 | | ENDIF |
580 | | IF ( med_diag%PRD%dgsave ) THEN |
581 | | CALL wrk_alloc( jpi, jpj, fprd2d ) |
582 | | fprd2d(:,:) = 0.0 !! |
583 | | ENDIF |
584 | | IF( med_diag%MPD%dgsave ) THEN |
585 | | CALL wrk_alloc( jpi, jpj, fdpd2d ) |
586 | | fdpd2d(:,:) = 0.0 !! |
587 | | ENDIF |
588 | | IF( med_diag%OPAL%dgsave ) THEN |
589 | | CALL wrk_alloc( jpi, jpj, fprds2d ) |
590 | | fprds2d(:,:) = 0.0 !! |
591 | | ENDIF |
592 | | IF( med_diag%OPALDISS%dgsave ) THEN |
593 | | CALL wrk_alloc( jpi, jpj, fsdiss2d ) |
594 | | fsdiss2d(:,:) = 0.0 !! |
595 | | ENDIF |
596 | | IF( med_diag%GMIPn%dgsave ) THEN |
597 | | CALL wrk_alloc( jpi, jpj, fgmipn2d ) |
598 | | fgmipn2d(:,:) = 0.0 !! |
599 | | ENDIF |
600 | | IF( med_diag%GMID%dgsave ) THEN |
601 | | CALL wrk_alloc( jpi, jpj, fgmid2d ) |
602 | | fgmid2d(:,:) = 0.0 !! |
603 | | ENDIF |
604 | | IF( med_diag%MZMI%dgsave ) THEN |
605 | | CALL wrk_alloc( jpi, jpj, fdzmi2d ) |
606 | | fdzmi2d(:,:) = 0.0 !! |
607 | | ENDIF |
608 | | IF( med_diag%GMEPN%dgsave ) THEN |
609 | | CALL wrk_alloc( jpi, jpj, fgmepn2d ) |
610 | | fgmepn2d(:,:) = 0.0 !! |
611 | | ENDIF |
612 | | IF( med_diag%GMEPD%dgsave ) THEN |
613 | | CALL wrk_alloc( jpi, jpj, fgmepd2d ) |
614 | | fgmepd2d(:,:) = 0.0 !! |
615 | | ENDIF |
616 | | IF( med_diag%GMEZMI%dgsave ) THEN |
617 | | CALL wrk_alloc( jpi, jpj, fgmezmi2d ) |
618 | | fgmezmi2d(:,:) = 0.0 !! |
619 | | ENDIF |
620 | | IF( med_diag%GMED%dgsave ) THEN |
621 | | CALL wrk_alloc( jpi, jpj, fgmed2d ) |
622 | | fgmed2d(:,:) = 0.0 !! |
623 | | ENDIF |
624 | | IF( med_diag%MZME%dgsave ) THEN |
625 | | CALL wrk_alloc( jpi, jpj, fdzme2d ) |
626 | | fdzme2d(:,:) = 0.0 !! |
627 | | ENDIF |
628 | | IF( med_diag%DETN%dgsave ) THEN |
629 | | CALL wrk_alloc( jpi, jpj, fslown2d ) |
630 | | fslown2d(:,:) = 0.0 !! |
631 | | ENDIF |
632 | | IF( med_diag%MDET%dgsave ) THEN |
633 | | CALL wrk_alloc( jpi, jpj, fdd2d ) |
634 | | fdd2d(:,:) = 0.0 !! |
635 | | ENDIF |
636 | | IF( med_diag%AEOLIAN%dgsave ) THEN |
637 | | CALL wrk_alloc( jpi, jpj, ffetop2d ) |
638 | | ffetop2d(:,:) = 0.0 !! |
639 | | ENDIF |
640 | | IF( med_diag%BENTHIC%dgsave ) THEN |
641 | | CALL wrk_alloc( jpi, jpj, ffebot2d ) |
642 | | ffebot2d(:,:) = 0.0 !! |
643 | | ENDIF |
644 | | IF( med_diag%SCAVENGE%dgsave ) THEN |
645 | | CALL wrk_alloc( jpi, jpj, ffescav2d ) |
646 | | ffescav2d(:,:) = 0.0 !! |
647 | | ENDIF |
648 | | IF( med_diag%PN_JLIM%dgsave ) THEN |
649 | | CALL wrk_alloc( jpi, jpj, fjln2d ) |
650 | | fjln2d(:,:) = 0.0 !! |
651 | | ENDIF |
652 | | IF( med_diag%PN_NLIM%dgsave ) THEN |
653 | | CALL wrk_alloc( jpi, jpj, fnln2d ) |
654 | | fnln2d(:,:) = 0.0 !! |
655 | | ENDIF |
656 | | IF( med_diag%PN_FELIM%dgsave ) THEN |
657 | | CALL wrk_alloc( jpi, jpj, ffln2d ) |
658 | | ffln2d(:,:) = 0.0 !! |
659 | | ENDIF |
660 | | IF( med_diag%PD_JLIM%dgsave ) THEN |
661 | | CALL wrk_alloc( jpi, jpj, fjld2d ) |
662 | | fjld2d(:,:) = 0.0 !! |
663 | | ENDIF |
664 | | IF( med_diag%PD_NLIM%dgsave ) THEN |
665 | | CALL wrk_alloc( jpi, jpj, fnld2d ) |
666 | | fnld2d(:,:) = 0.0 !! |
667 | | ENDIF |
668 | | IF( med_diag%PD_FELIM%dgsave ) THEN |
669 | | CALL wrk_alloc( jpi, jpj, ffld2d ) |
670 | | ffld2d(:,:) = 0.0 !! |
671 | | ENDIF |
672 | | IF( med_diag%PD_SILIM%dgsave ) THEN |
673 | | CALL wrk_alloc( jpi, jpj, fsld2d2 ) |
674 | | fsld2d2(:,:) = 0.0 !! |
675 | | ENDIF |
676 | | IF( med_diag%PDSILIM2%dgsave ) THEN |
677 | | CALL wrk_alloc( jpi, jpj, fsld2d ) |
678 | | fsld2d(:,:) = 0.0 !! |
679 | | ENDIF |
680 | | !! |
681 | | !! skip SDT_XXXX diagnostics here |
682 | | !! |
683 | | IF( med_diag%TOTREG_N%dgsave ) THEN |
684 | | CALL wrk_alloc( jpi, jpj, fregen2d ) |
685 | | fregen2d(:,:) = 0.0 !! |
686 | | ENDIF |
687 | | IF( med_diag%TOTRG_SI%dgsave ) THEN |
688 | | CALL wrk_alloc( jpi, jpj, fregensi2d ) |
689 | | fregensi2d(:,:) = 0.0 !! |
690 | | ENDIF |
691 | | !! |
692 | | !! skip REG_XXXX diagnostics here |
693 | | !! |
694 | | IF( med_diag%FASTN%dgsave ) THEN |
695 | | CALL wrk_alloc( jpi, jpj, ftempn2d ) |
696 | | ftempn2d(:,:) = 0.0 !! |
697 | | ENDIF |
698 | | IF( med_diag%FASTSI%dgsave ) THEN |
699 | | CALL wrk_alloc( jpi, jpj, ftempsi2d ) |
700 | | ftempsi2d(:,:) = 0.0 !! |
701 | | ENDIF |
702 | | IF( med_diag%FASTFE%dgsave ) THEN |
703 | | CALL wrk_alloc( jpi, jpj, ftempfe2d ) |
704 | | ftempfe2d(:,:) = 0.0 !! |
705 | | ENDIF |
706 | | IF( med_diag%FASTC%dgsave ) THEN |
707 | | CALL wrk_alloc( jpi, jpj, ftempc2d ) |
708 | | ftempc2d(:,:) = 0.0 !! |
709 | | ENDIF |
710 | | IF( med_diag%FASTCA%dgsave ) THEN |
711 | | CALL wrk_alloc( jpi, jpj, ftempca2d ) |
712 | | ftempca2d(:,:) = 0.0 !! |
713 | | ENDIF |
714 | | !! |
715 | | !! skip FDT_XXXX, RG_XXXXF, FDS_XXXX, RGS_XXXXF diagnostics here |
716 | | !! |
717 | | IF( med_diag%REMINN%dgsave ) THEN |
718 | | CALL wrk_alloc( jpi, jpj, freminn2d ) |
719 | | freminn2d(:,:) = 0.0 !! |
720 | | ENDIF |
721 | | IF( med_diag%REMINSI%dgsave ) THEN |
722 | | CALL wrk_alloc( jpi, jpj, freminsi2d ) |
723 | | freminsi2d(:,:) = 0.0 !! |
724 | | ENDIF |
725 | | IF( med_diag%REMINFE%dgsave ) THEN |
726 | | CALL wrk_alloc( jpi, jpj, freminfe2d ) |
727 | | freminfe2d(:,:) = 0.0 !! |
728 | | ENDIF |
729 | | IF( med_diag%REMINC%dgsave ) THEN |
730 | | CALL wrk_alloc( jpi, jpj, freminc2d ) |
731 | | freminc2d(:,:) = 0.0 !! |
732 | | ENDIF |
733 | | IF( med_diag%REMINCA%dgsave ) THEN |
734 | | CALL wrk_alloc( jpi, jpj, freminca2d ) |
735 | | freminca2d(:,:) = 0.0 !! |
736 | | ENDIF |
737 | | # if defined key_roam |
738 | | !! |
739 | | !! skip SEAFLRXX, MED_XXXX, INTFLX_XX, INT_XX, ML_XXX, OCAL_XXX, FE_XXXX, MED_XZE, WIND diagnostics here |
740 | | !! |
741 | | IF( med_diag%RR_0100%dgsave ) THEN |
742 | | CALL wrk_alloc( jpi, jpj, ffastca2d ) |
743 | | ffastca2d(:,:) = 0.0 !! |
744 | | ENDIF |
745 | | |
746 | | IF( med_diag%ATM_PCO2%dgsave ) THEN |
747 | | CALL wrk_alloc( jpi, jpj, f_pco2a2d ) |
748 | | f_pco2a2d(:,:) = 0.0 !! |
749 | | ENDIF |
750 | | !! |
751 | | !! skip OCN_PH diagnostic here |
752 | | !! |
753 | | IF( med_diag%OCN_PCO2%dgsave ) THEN |
754 | | CALL wrk_alloc( jpi, jpj, f_pco2w2d ) |
755 | | f_pco2w2d(:,:) = 0.0 !! |
756 | | ENDIF |
757 | | !! |
758 | | !! skip OCNH2CO3, OCN_HCO3, OCN_CO3 diagnostics here |
759 | | !! |
760 | | IF( med_diag%CO2FLUX%dgsave ) THEN |
761 | | CALL wrk_alloc( jpi, jpj, f_co2flux2d ) |
762 | | f_co2flux2d(:,:) = 0.0 !! |
763 | | ENDIF |
764 | | !! |
765 | | !! skip OM_XXX diagnostics here |
766 | | !! |
767 | | IF( med_diag%TCO2%dgsave ) THEN |
768 | | CALL wrk_alloc( jpi, jpj, f_TDIC2d ) |
769 | | f_TDIC2d(:,:) = 0.0 !! |
770 | | ENDIF |
771 | | IF( med_diag%TALK%dgsave ) THEN |
772 | | CALL wrk_alloc( jpi, jpj, f_TALK2d ) |
773 | | f_TALK2d(:,:) = 0.0 !! |
774 | | ENDIF |
775 | | IF( med_diag%KW660%dgsave ) THEN |
776 | | CALL wrk_alloc( jpi, jpj, f_kw6602d ) |
777 | | f_kw6602d(:,:) = 0.0 !! |
778 | | ENDIF |
779 | | IF( med_diag%ATM_PP0%dgsave ) THEN |
780 | | CALL wrk_alloc( jpi, jpj, f_pp02d ) |
781 | | f_pp02d(:,:) = 0.0 !! |
782 | | ENDIF |
783 | | IF( med_diag%O2FLUX%dgsave ) THEN |
784 | | CALL wrk_alloc( jpi, jpj, f_o2flux2d ) |
785 | | f_o2flux2d(:,:) = 0.0 !! |
786 | | ENDIF |
787 | | IF( med_diag%O2SAT%dgsave ) THEN |
788 | | CALL wrk_alloc( jpi, jpj, f_o2sat2d ) |
789 | | f_o2sat2d(:,:) = 0.0 !! |
790 | | ENDIF |
791 | | !! |
792 | | !! skip XXX_CCD diagnostics here |
793 | | !! |
794 | | IF( med_diag%SFR_OCAL%dgsave ) THEN |
795 | | CALL wrk_alloc( jpi, jpj, sfr_ocal2d ) |
796 | | sfr_ocal2d(:,:) = 0.0 !! |
797 | | ENDIF |
798 | | IF( med_diag%SFR_OARG%dgsave ) THEN |
799 | | CALL wrk_alloc( jpi, jpj, sfr_oarg2d ) |
800 | | sfr_oarg2d(:,:) = 0.0 !! |
801 | | ENDIF |
802 | | !! |
803 | | !! skip XX_PROD, XX_CONS, O2_ANOX, RR_XXXX diagnostics here |
804 | | !! |
805 | | IF( med_diag%IBEN_N%dgsave ) THEN |
806 | | CALL wrk_alloc( jpi, jpj, iben_n2d ) |
807 | | iben_n2d(:,:) = 0.0 !! |
808 | | ENDIF |
809 | | IF( med_diag%IBEN_FE%dgsave ) THEN |
810 | | CALL wrk_alloc( jpi, jpj, iben_fe2d ) |
811 | | iben_fe2d(:,:) = 0.0 !! |
812 | | ENDIF |
813 | | IF( med_diag%IBEN_C%dgsave ) THEN |
814 | | CALL wrk_alloc( jpi, jpj, iben_c2d ) |
815 | | iben_c2d(:,:) = 0.0 !! |
816 | | ENDIF |
817 | | IF( med_diag%IBEN_SI%dgsave ) THEN |
818 | | CALL wrk_alloc( jpi, jpj, iben_si2d ) |
819 | | iben_si2d(:,:) = 0.0 !! |
820 | | ENDIF |
821 | | IF( med_diag%IBEN_CA%dgsave ) THEN |
822 | | CALL wrk_alloc( jpi, jpj, iben_ca2d ) |
823 | | iben_ca2d(:,:) = 0.0 !! |
824 | | ENDIF |
825 | | IF( med_diag%OBEN_N%dgsave ) THEN |
826 | | CALL wrk_alloc( jpi, jpj, oben_n2d ) |
827 | | oben_n2d(:,:) = 0.0 !! |
828 | | ENDIF |
829 | | IF( med_diag%OBEN_FE%dgsave ) THEN |
830 | | CALL wrk_alloc( jpi, jpj, oben_fe2d ) |
831 | | oben_fe2d(:,:) = 0.0 !! |
832 | | ENDIF |
833 | | IF( med_diag%OBEN_C%dgsave ) THEN |
834 | | CALL wrk_alloc( jpi, jpj, oben_c2d ) |
835 | | oben_c2d(:,:) = 0.0 !! |
836 | | ENDIF |
837 | | IF( med_diag%OBEN_SI%dgsave ) THEN |
838 | | CALL wrk_alloc( jpi, jpj, oben_si2d ) |
839 | | oben_si2d(:,:) = 0.0 !! |
840 | | ENDIF |
841 | | IF( med_diag%OBEN_CA%dgsave ) THEN |
842 | | CALL wrk_alloc( jpi, jpj, oben_ca2d ) |
843 | | oben_ca2d(:,:) = 0.0 !! |
844 | | ENDIF |
845 | | !! |
846 | | !! skip BEN_XX diagnostics here |
847 | | !! |
848 | | IF( med_diag%RIV_N%dgsave ) THEN |
849 | | CALL wrk_alloc( jpi, jpj, rivn2d ) |
850 | | rivn2d(:,:) = 0.0 !! |
851 | | ENDIF |
852 | | IF( med_diag%RIV_SI%dgsave ) THEN |
853 | | CALL wrk_alloc( jpi, jpj, rivsi2d ) |
854 | | rivsi2d(:,:) = 0.0 !! |
855 | | ENDIF |
856 | | IF( med_diag%RIV_C%dgsave ) THEN |
857 | | CALL wrk_alloc( jpi, jpj, rivc2d ) |
858 | | rivc2d(:,:) = 0.0 !! |
859 | | ENDIF |
860 | | IF( med_diag%RIV_ALK%dgsave ) THEN |
861 | | CALL wrk_alloc( jpi, jpj, rivalk2d ) |
862 | | rivalk2d(:,:) = 0.0 !! |
863 | | ENDIF |
864 | | IF( med_diag%DETC%dgsave ) THEN |
865 | | CALL wrk_alloc( jpi, jpj, fslowc2d ) |
866 | | fslowc2d(:,:) = 0.0 !! |
867 | | ENDIF |
868 | | !! |
869 | | !! skip SDC_XXXX, INVTXXX diagnostics here |
870 | | !! |
871 | | IF( med_diag%LYSO_CA%dgsave ) THEN |
872 | | CALL wrk_alloc( jpi, jpj, lyso_ca2d ) |
873 | | lyso_ca2d(:,:) = 0.0 !! |
874 | | ENDIF |
875 | | !! |
876 | | !! skip COM_RESP diagnostic here |
877 | | !! |
878 | | IF( med_diag%PN_LLOSS%dgsave ) THEN |
879 | | CALL wrk_alloc( jpi, jpj, fdpn22d ) |
880 | | fdpn22d(:,:) = 0.0 !! |
881 | | ENDIF |
882 | | IF( med_diag%PD_LLOSS%dgsave ) THEN |
883 | | CALL wrk_alloc( jpi, jpj, fdpd22d ) |
884 | | fdpd22d(:,:) = 0.0 !! |
885 | | ENDIF |
886 | | IF( med_diag%ZI_LLOSS%dgsave ) THEN |
887 | | CALL wrk_alloc( jpi, jpj, fdzmi22d ) |
888 | | fdzmi22d(:,:) = 0.0 !! |
889 | | ENDIF |
890 | | IF( med_diag%ZE_LLOSS%dgsave ) THEN |
891 | | CALL wrk_alloc( jpi, jpj, fdzme22d ) |
892 | | fdzme22d(:,:) = 0.0 !! |
893 | | ENDIF |
894 | | IF( med_diag%ZI_MES_N%dgsave ) THEN |
895 | | CALL wrk_alloc( jpi, jpj, zimesn2d ) |
896 | | zimesn2d(:,:) = 0.0 !! |
897 | | ENDIF |
898 | | IF( med_diag%ZI_MES_D%dgsave ) THEN |
899 | | CALL wrk_alloc( jpi, jpj, zimesd2d ) |
900 | | zimesd2d(:,:) = 0.0 !! |
901 | | ENDIF |
902 | | IF( med_diag%ZI_MES_C%dgsave ) THEN |
903 | | CALL wrk_alloc( jpi, jpj, zimesc2d ) |
904 | | zimesc2d(:,:) = 0.0 !! |
905 | | ENDIF |
906 | | IF( med_diag%ZI_MESDC%dgsave ) THEN |
907 | | CALL wrk_alloc( jpi, jpj, zimesdc2d ) |
908 | | zimesdc2d(:,:) = 0.0 !! |
909 | | ENDIF |
910 | | IF( med_diag%ZI_EXCR%dgsave ) THEN |
911 | | CALL wrk_alloc( jpi, jpj, ziexcr2d ) |
912 | | ziexcr2d(:,:) = 0.0 !! |
913 | | ENDIF |
914 | | IF( med_diag%ZI_RESP%dgsave ) THEN |
915 | | CALL wrk_alloc( jpi, jpj, ziresp2d ) |
916 | | ziresp2d(:,:) = 0.0 !! |
917 | | ENDIF |
918 | | IF( med_diag%ZI_GROW%dgsave ) THEN |
919 | | CALL wrk_alloc( jpi, jpj, zigrow2d ) |
920 | | zigrow2d(:,:) = 0.0 !! |
921 | | ENDIF |
922 | | IF( med_diag%ZE_MES_N%dgsave ) THEN |
923 | | CALL wrk_alloc( jpi, jpj, zemesn2d ) |
924 | | zemesn2d(:,:) = 0.0 !! |
925 | | ENDIF |
926 | | IF( med_diag%ZE_MES_D%dgsave ) THEN |
927 | | CALL wrk_alloc( jpi, jpj, zemesd2d ) |
928 | | zemesd2d(:,:) = 0.0 !! |
929 | | ENDIF |
930 | | IF( med_diag%ZE_MES_C%dgsave ) THEN |
931 | | CALL wrk_alloc( jpi, jpj, zemesc2d ) |
932 | | zemesc2d(:,:) = 0.0 !! |
933 | | ENDIF |
934 | | IF( med_diag%ZE_MESDC%dgsave ) THEN |
935 | | CALL wrk_alloc( jpi, jpj, zemesdc2d ) |
936 | | zemesdc2d(:,:) = 0.0 !! |
937 | | ENDIF |
938 | | IF( med_diag%ZE_EXCR%dgsave ) THEN |
939 | | CALL wrk_alloc( jpi, jpj, zeexcr2d ) |
940 | | zeexcr2d(:,:) = 0.0 !! |
941 | | ENDIF |
942 | | IF( med_diag%ZE_RESP%dgsave ) THEN |
943 | | CALL wrk_alloc( jpi, jpj, zeresp2d ) |
944 | | zeresp2d(:,:) = 0.0 !! |
945 | | ENDIF |
946 | | IF( med_diag%ZE_GROW%dgsave ) THEN |
947 | | CALL wrk_alloc( jpi, jpj, zegrow2d ) |
948 | | zegrow2d(:,:) = 0.0 !! |
949 | | ENDIF |
950 | | IF( med_diag%MDETC%dgsave ) THEN |
951 | | CALL wrk_alloc( jpi, jpj, mdetc2d ) |
952 | | mdetc2d(:,:) = 0.0 !! |
953 | | ENDIF |
954 | | IF( med_diag%GMIDC%dgsave ) THEN |
955 | | CALL wrk_alloc( jpi, jpj, gmidc2d ) |
956 | | gmidc2d(:,:) = 0.0 !! |
957 | | ENDIF |
958 | | IF( med_diag%GMEDC%dgsave ) THEN |
959 | | CALL wrk_alloc( jpi, jpj, gmedc2d ) |
960 | | gmedc2d(:,:) = 0.0 !! |
961 | | ENDIF |
962 | | !! |
963 | | !! skip INT_XXX diagnostics here |
964 | | !! |
965 | | IF (jdms .eq. 1) THEN |
966 | | IF( med_diag%DMS_SURF%dgsave ) THEN |
967 | | CALL wrk_alloc( jpi, jpj, dms_surf2d ) |
968 | | dms_surf2d(:,:) = 0.0 !! |
969 | | ENDIF |
970 | | IF( med_diag%DMS_ANDR%dgsave ) THEN |
971 | | CALL wrk_alloc( jpi, jpj, dms_andr2d ) |
972 | | dms_andr2d(:,:) = 0.0 !! |
973 | | ENDIF |
974 | | IF( med_diag%DMS_SIMO%dgsave ) THEN |
975 | | CALL wrk_alloc( jpi, jpj, dms_simo2d ) |
976 | | dms_simo2d(:,:) = 0.0 !! |
977 | | ENDIF |
978 | | IF( med_diag%DMS_ARAN%dgsave ) THEN |
979 | | CALL wrk_alloc( jpi, jpj, dms_aran2d ) |
980 | | dms_aran2d(:,:) = 0.0 !! |
981 | | ENDIF |
982 | | IF( med_diag%DMS_HALL%dgsave ) THEN |
983 | | CALL wrk_alloc( jpi, jpj, dms_hall2d ) |
984 | | dms_hall2d(:,:) = 0.0 !! |
985 | | ENDIF |
986 | | ENDIF |
987 | | !! |
988 | | !! AXY (24/11/16): extra MOCSY diagnostics, 2D |
989 | | IF( med_diag%ATM_XCO2%dgsave ) THEN |
990 | | CALL wrk_alloc( jpi, jpj, f_xco2a_2d ) |
991 | | f_xco2a_2d(:,:) = 0.0 !! |
992 | | ENDIF |
993 | | IF( med_diag%OCN_FCO2%dgsave ) THEN |
994 | | CALL wrk_alloc( jpi, jpj, f_fco2w_2d ) |
995 | | f_fco2w_2d(:,:) = 0.0 !! |
996 | | ENDIF |
997 | | IF( med_diag%ATM_FCO2%dgsave ) THEN |
998 | | CALL wrk_alloc( jpi, jpj, f_fco2a_2d ) |
999 | | f_fco2a_2d(:,:) = 0.0 !! |
1000 | | ENDIF |
1001 | | IF( med_diag%OCN_RHOSW%dgsave ) THEN |
1002 | | CALL wrk_alloc( jpi, jpj, f_ocnrhosw_2d ) |
1003 | | f_ocnrhosw_2d(:,:) = 0.0 !! |
1004 | | ENDIF |
1005 | | IF( med_diag%OCN_SCHCO2%dgsave ) THEN |
1006 | | CALL wrk_alloc( jpi, jpj, f_ocnschco2_2d ) |
1007 | | f_ocnschco2_2d(:,:) = 0.0 !! |
1008 | | ENDIF |
1009 | | IF( med_diag%OCN_KWCO2%dgsave ) THEN |
1010 | | CALL wrk_alloc( jpi, jpj, f_ocnkwco2_2d ) |
1011 | | f_ocnkwco2_2d(:,:) = 0.0 !! |
1012 | | ENDIF |
1013 | | IF( med_diag%OCN_K0%dgsave ) THEN |
1014 | | CALL wrk_alloc( jpi, jpj, f_ocnk0_2d ) |
1015 | | f_ocnk0_2d(:,:) = 0.0 !! |
1016 | | ENDIF |
1017 | | IF( med_diag%CO2STARAIR%dgsave ) THEN |
1018 | | CALL wrk_alloc( jpi, jpj, f_co2starair_2d ) |
1019 | | f_co2starair_2d(:,:) = 0.0 !! |
1020 | | ENDIF |
1021 | | IF( med_diag%OCN_DPCO2%dgsave ) THEN |
1022 | | CALL wrk_alloc( jpi, jpj, f_ocndpco2_2d ) |
1023 | | f_ocndpco2_2d(:,:) = 0.0 !! |
1024 | | ENDIF |
1025 | | # endif |
1026 | | IF( med_diag%TPP3%dgsave ) THEN |
1027 | | CALL wrk_alloc( jpi, jpj, jpk, tpp3d ) |
1028 | | tpp3d(:,:,:) = 0.0 !! |
1029 | | ENDIF |
1030 | | IF( med_diag%DETFLUX3%dgsave ) THEN |
1031 | | CALL wrk_alloc( jpi, jpj, jpk, detflux3d ) |
1032 | | detflux3d(:,:,:) = 0.0 !! |
1033 | | ENDIF |
1034 | | IF( med_diag%REMIN3N%dgsave ) THEN |
1035 | | CALL wrk_alloc( jpi, jpj, jpk, remin3dn ) |
1036 | | remin3dn(:,:,:) = 0.0 !! |
1037 | | ENDIF |
1038 | | !! |
1039 | | !! AXY (10/11/16): CMIP6 diagnostics, 2D |
1040 | | !! JPALM -- 17-11-16 -- put fgco2 alloc out of diag request |
1041 | | !! needed for coupling/passed through restart |
1042 | | !! IF( med_diag%FGCO2%dgsave ) THEN |
1043 | | CALL wrk_alloc( jpi, jpj, fgco2 ) |
1044 | | fgco2(:,:) = 0.0 !! |
1045 | | !! ENDIF |
1046 | | IF( med_diag%INTDISSIC%dgsave ) THEN |
1047 | | CALL wrk_alloc( jpi, jpj, intdissic ) |
1048 | | intdissic(:,:) = 0.0 !! |
1049 | | ENDIF |
1050 | | IF( med_diag%INTDISSIN%dgsave ) THEN |
1051 | | CALL wrk_alloc( jpi, jpj, intdissin ) |
1052 | | intdissin(:,:) = 0.0 !! |
1053 | | ENDIF |
1054 | | IF( med_diag%INTDISSISI%dgsave ) THEN |
1055 | | CALL wrk_alloc( jpi, jpj, intdissisi ) |
1056 | | intdissisi(:,:) = 0.0 !! |
1057 | | ENDIF |
1058 | | IF( med_diag%INTTALK%dgsave ) THEN |
1059 | | CALL wrk_alloc( jpi, jpj, inttalk ) |
1060 | | inttalk(:,:) = 0.0 !! |
1061 | | ENDIF |
1062 | | IF( med_diag%O2min%dgsave ) THEN |
1063 | | CALL wrk_alloc( jpi, jpj, o2min ) |
1064 | | o2min(:,:) = 1.e3 !! set to high value as we're looking for min(o2) |
1065 | | ENDIF |
1066 | | IF( med_diag%ZO2min%dgsave ) THEN |
1067 | | CALL wrk_alloc( jpi, jpj, zo2min ) |
1068 | | zo2min(:,:) = 0.0 !! |
1069 | | ENDIF |
1070 | | IF( med_diag%FBDDTALK%dgsave ) THEN |
1071 | | CALL wrk_alloc( jpi, jpj, fbddtalk ) |
1072 | | fbddtalk(:,:) = 0.0 !! |
1073 | | ENDIF |
1074 | | IF( med_diag%FBDDTDIC%dgsave ) THEN |
1075 | | CALL wrk_alloc( jpi, jpj, fbddtdic ) |
1076 | | fbddtdic(:,:) = 0.0 !! |
1077 | | ENDIF |
1078 | | IF( med_diag%FBDDTDIFE%dgsave ) THEN |
1079 | | CALL wrk_alloc( jpi, jpj, fbddtdife ) |
1080 | | fbddtdife(:,:) = 0.0 !! |
1081 | | ENDIF |
1082 | | IF( med_diag%FBDDTDIN%dgsave ) THEN |
1083 | | CALL wrk_alloc( jpi, jpj, fbddtdin ) |
1084 | | fbddtdin(:,:) = 0.0 !! |
1085 | | ENDIF |
1086 | | IF( med_diag%FBDDTDISI%dgsave ) THEN |
1087 | | CALL wrk_alloc( jpi, jpj, fbddtdisi ) |
1088 | | fbddtdisi(:,:) = 0.0 !! |
1089 | | ENDIF |
1090 | | !! |
1091 | | !! AXY (10/11/16): CMIP6 diagnostics, 3D |
1092 | | IF( med_diag%TPPD3%dgsave ) THEN |
1093 | | CALL wrk_alloc( jpi, jpj, jpk, tppd3 ) |
1094 | | tppd3(:,:,:) = 0.0 !! |
1095 | | ENDIF |
1096 | | IF( med_diag%BDDTALK3%dgsave ) THEN |
1097 | | CALL wrk_alloc( jpi, jpj, jpk, bddtalk3 ) |
1098 | | bddtalk3(:,:,:) = 0.0 !! |
1099 | | ENDIF |
1100 | | IF( med_diag%BDDTDIC3%dgsave ) THEN |
1101 | | CALL wrk_alloc( jpi, jpj, jpk, bddtdic3 ) |
1102 | | bddtdic3(:,:,:) = 0.0 !! |
1103 | | ENDIF |
1104 | | IF( med_diag%BDDTDIFE3%dgsave ) THEN |
1105 | | CALL wrk_alloc( jpi, jpj, jpk, bddtdife3 ) |
1106 | | bddtdife3(:,:,:) = 0.0 !! |
1107 | | ENDIF |
1108 | | IF( med_diag%BDDTDIN3%dgsave ) THEN |
1109 | | CALL wrk_alloc( jpi, jpj, jpk, bddtdin3 ) |
1110 | | bddtdin3(:,:,:) = 0.0 !! |
1111 | | ENDIF |
1112 | | IF( med_diag%BDDTDISI3%dgsave ) THEN |
1113 | | CALL wrk_alloc( jpi, jpj, jpk, bddtdisi3 ) |
1114 | | bddtdisi3(:,:,:) = 0.0 !! |
1115 | | ENDIF |
1116 | | IF( med_diag%FD_NIT3%dgsave ) THEN |
1117 | | CALL wrk_alloc( jpi, jpj, jpk, fd_nit3 ) |
1118 | | fd_nit3(:,:,:) = 0.0 !! |
1119 | | ENDIF |
1120 | | IF( med_diag%FD_SIL3%dgsave ) THEN |
1121 | | CALL wrk_alloc( jpi, jpj, jpk, fd_sil3 ) |
1122 | | fd_sil3(:,:,:) = 0.0 !! |
1123 | | ENDIF |
1124 | | IF( med_diag%FD_CAR3%dgsave ) THEN |
1125 | | CALL wrk_alloc( jpi, jpj, jpk, fd_car3 ) |
1126 | | fd_car3(:,:,:) = 0.0 !! |
1127 | | ENDIF |
1128 | | IF( med_diag%FD_CAL3%dgsave ) THEN |
1129 | | CALL wrk_alloc( jpi, jpj, jpk, fd_cal3 ) |
1130 | | fd_cal3(:,:,:) = 0.0 !! |
1131 | | ENDIF |
1132 | | IF( med_diag%DCALC3%dgsave ) THEN |
1133 | | CALL wrk_alloc( jpi, jpj, jpk, dcalc3 ) |
1134 | | dcalc3(:,:,: ) = 0.0 !! |
1135 | | ENDIF |
1136 | | IF( med_diag%EXPC3%dgsave ) THEN |
1137 | | CALL wrk_alloc( jpi, jpj, jpk, expc3 ) |
1138 | | expc3(:,:,: ) = 0.0 !! |
1139 | | ENDIF |
1140 | | IF( med_diag%EXPN3%dgsave ) THEN |
1141 | | CALL wrk_alloc( jpi, jpj, jpk, expn3 ) |
1142 | | expn3(:,:,: ) = 0.0 !! |
1143 | | ENDIF |
1144 | | IF( med_diag%FEDISS3%dgsave ) THEN |
1145 | | CALL wrk_alloc( jpi, jpj, jpk, fediss3 ) |
1146 | | fediss3(:,:,: ) = 0.0 !! |
1147 | | ENDIF |
1148 | | IF( med_diag%FESCAV3%dgsave ) THEN |
1149 | | CALL wrk_alloc( jpi, jpj, jpk, fescav3 ) |
1150 | | fescav3(:,:,: ) = 0.0 !! |
1151 | | ENDIF |
1152 | | IF( med_diag%MIGRAZP3%dgsave ) THEN |
1153 | | CALL wrk_alloc( jpi, jpj, jpk, migrazp3 ) |
1154 | | migrazp3(:,:,: ) = 0.0 !! |
1155 | | ENDIF |
1156 | | IF( med_diag%MIGRAZD3%dgsave ) THEN |
1157 | | CALL wrk_alloc( jpi, jpj, jpk, migrazd3 ) |
1158 | | migrazd3(:,:,: ) = 0.0 !! |
1159 | | ENDIF |
1160 | | IF( med_diag%MEGRAZP3%dgsave ) THEN |
1161 | | CALL wrk_alloc( jpi, jpj, jpk, megrazp3 ) |
1162 | | megrazp3(:,:,: ) = 0.0 !! |
1163 | | ENDIF |
1164 | | IF( med_diag%MEGRAZD3%dgsave ) THEN |
1165 | | CALL wrk_alloc( jpi, jpj, jpk, megrazd3 ) |
1166 | | megrazd3(:,:,: ) = 0.0 !! |
1167 | | ENDIF |
1168 | | IF( med_diag%MEGRAZZ3%dgsave ) THEN |
1169 | | CALL wrk_alloc( jpi, jpj, jpk, megrazz3 ) |
1170 | | megrazz3(:,:,: ) = 0.0 !! |
1171 | | ENDIF |
1172 | | IF( med_diag%O2SAT3%dgsave ) THEN |
1173 | | CALL wrk_alloc( jpi, jpj, jpk, o2sat3 ) |
1174 | | o2sat3(:,:,: ) = 0.0 !! |
1175 | | ENDIF |
1176 | | IF( med_diag%PBSI3%dgsave ) THEN |
1177 | | CALL wrk_alloc( jpi, jpj, jpk, pbsi3 ) |
1178 | | pbsi3(:,:,: ) = 0.0 !! |
1179 | | ENDIF |
1180 | | IF( med_diag%PCAL3%dgsave ) THEN |
1181 | | CALL wrk_alloc( jpi, jpj, jpk, pcal3 ) |
1182 | | pcal3(:,:,: ) = 0.0 !! |
1183 | | ENDIF |
1184 | | IF( med_diag%REMOC3%dgsave ) THEN |
1185 | | CALL wrk_alloc( jpi, jpj, jpk, remoc3 ) |
1186 | | remoc3(:,:,: ) = 0.0 !! |
1187 | | ENDIF |
1188 | | IF( med_diag%PNLIMJ3%dgsave ) THEN |
1189 | | CALL wrk_alloc( jpi, jpj, jpk, pnlimj3 ) |
1190 | | pnlimj3(:,:,: ) = 0.0 !! |
1191 | | ENDIF |
1192 | | IF( med_diag%PNLIMN3%dgsave ) THEN |
1193 | | CALL wrk_alloc( jpi, jpj, jpk, pnlimn3 ) |
1194 | | pnlimn3(:,:,: ) = 0.0 !! |
1195 | | ENDIF |
1196 | | IF( med_diag%PNLIMFE3%dgsave ) THEN |
1197 | | CALL wrk_alloc( jpi, jpj, jpk, pnlimfe3 ) |
1198 | | pnlimfe3(:,:,: ) = 0.0 !! |
1199 | | ENDIF |
1200 | | IF( med_diag%PDLIMJ3%dgsave ) THEN |
1201 | | CALL wrk_alloc( jpi, jpj, jpk, pdlimj3 ) |
1202 | | pdlimj3(:,:,: ) = 0.0 !! |
1203 | | ENDIF |
1204 | | IF( med_diag%PDLIMN3%dgsave ) THEN |
1205 | | CALL wrk_alloc( jpi, jpj, jpk, pdlimn3 ) |
1206 | | pdlimn3(:,:,: ) = 0.0 !! |
1207 | | ENDIF |
1208 | | IF( med_diag%PDLIMFE3%dgsave ) THEN |
1209 | | CALL wrk_alloc( jpi, jpj, jpk, pdlimfe3 ) |
1210 | | pdlimfe3(:,:,: ) = 0.0 !! |
1211 | | ENDIF |
1212 | | IF( med_diag%PDLIMSI3%dgsave ) THEN |
1213 | | CALL wrk_alloc( jpi, jpj, jpk, pdlimsi3 ) |
1214 | | pdlimsi3(:,:,: ) = 0.0 !! |
1215 | | ENDIF |
1216 | | ENDIF !! lk_iomput |
1217 | | !! |
1269 | | !! AXY (20/11/14): alter to call on first MEDUSA timestep and then every |
1270 | | !! month (this is hardwired as 960 timesteps but should |
1271 | | !! be calculated and done properly |
1272 | | !! IF( kt == nit000 .or. mod(kt,1920) == 0 ) THEN |
1273 | | !! IF( kt == nittrc000 .or. mod(kt,960) == 0 ) THEN |
1274 | | !!============================= |
1275 | | !! Jpalm -- 07-10-2016 -- need to change carb-chem frequency call : |
1276 | | !! we don't want to call on the first time-step of all run submission, |
1277 | | !! but only on the very first time-step, and then every month |
1278 | | !! So we call on nittrc000 if not restarted run, |
1279 | | !! else if one month after last call. |
1280 | | !! assume one month is 30d --> 3600*24*30 : 2592000s |
1281 | | !! try to call carb-chem at 1st month's tm-stp : x * 30d + 1*rdt(i.e: mod = rdt) |
1282 | | !! ++ need to pass carb-chem output var through restarts |
1283 | | IF ( ( kt == nittrc000 .AND. .NOT.ln_rsttr ) .OR. mod(kt*rdt,2592000.) == rdt ) THEN |
1284 | | !!---------------------------------------------------------------------- |
1285 | | !! Calculate the carbonate chemistry for the whole ocean on the first |
1286 | | !! simulation timestep and every month subsequently; the resulting 3D |
1287 | | !! field of omega calcite is used to determine the depth of the CCD |
1288 | | !!---------------------------------------------------------------------- |
1289 | | !! |
1290 | | IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt |
1291 | | CALL flush(numout) |
1292 | | !! blank flags |
1293 | | i2_omcal(:,:) = 0 |
1294 | | i2_omarg(:,:) = 0 |
1295 | | !! loop over 3D space |
1296 | | DO jk = 1,jpk |
1297 | | DO jj = 2,jpjm1 |
1298 | | DO ji = 2,jpim1 |
1299 | | !! OPEN wet point IF..THEN loop |
1300 | | if (tmask(ji,jj,jk).eq.1) then |
1301 | | IF ( lk_oasis ) THEN |
1302 | | f_xco2a = PCO2a_in_cpl(ji,jj) !! use 2D atm xCO2 from atm coupling |
1303 | | ENDIF |
1304 | | !! AXY (06/04/17): where am I? |
1305 | | flatx = gphit(ji,jj) |
1306 | | !! do carbonate chemistry |
1307 | | !! |
1308 | | fdep2 = fsdept(ji,jj,jk) !! set up level midpoint |
1309 | | !! AXY (28/11/16): seafloor depth; previously mbathy(ji,jj) - 1, now mbathy(ji,jj) |
1310 | | jmbathy = mbathy(ji,jj) |
1311 | | !! |
1312 | | !! set up required state variables |
1313 | | zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon |
1314 | | zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity |
1315 | | ztmp = tsn(ji,jj,jk,jp_tem) !! temperature |
1316 | | zsal = tsn(ji,jj,jk,jp_sal) !! salinity |
1317 | | zsil = max(0.,trn(ji,jj,jk,jpsil)) !! silicic acid |
1318 | | zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield |
1319 | | !! |
1320 | | !! AXY (28/02/14): check input fields |
1321 | | if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then |
1322 | | IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 3D, ', & |
1323 | | tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (', & |
1324 | | ji, ',', jj, ',', jk, ') at time', kt |
1325 | | IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 3D, ', & |
1326 | | tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) |
1327 | | ztmp = tsb(ji,jj,jk,jp_tem) !! temperature |
1328 | | endif |
1329 | | if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then |
1330 | | IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 3D, ', & |
1331 | | tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (', & |
1332 | | ji, ',', jj, ',', jk, ') at time', kt |
1333 | | endif |
1334 | | !! |
1335 | | !! blank input variables not used at this stage (they relate to air-sea flux) |
1336 | | f_kw660 = 1.0 |
1337 | | f_pp0 = 1.0 |
1338 | | !! |
1339 | | !! calculate carbonate chemistry at grid cell midpoint |
1340 | | !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate |
1341 | | !! chemistry package |
1342 | | CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho, & ! inputs |
1343 | | f_pp0, fdep2, flatx, f_kw660, f_xco2a, 1, & ! inputs |
1344 | | f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj), & ! outputs |
1345 | | f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut, & ! outputs |
1346 | | f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0, & ! outputs |
1347 | | f_co2starair, f_co2flux, f_dpco2 ) ! outputs |
1348 | | !! |
1349 | | f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg |
1350 | | f_TALK = (zalk / f_rhosw) * 1000. ! meq / m3 -> ueq / kg |
1351 | | f_dcf = f_rhosw |
1352 | | !! |
1353 | | !! store 3D outputs |
1354 | | f3_pH(ji,jj,jk) = f_ph |
1355 | | f3_h2co3(ji,jj,jk) = f_h2co3 |
1356 | | f3_hco3(ji,jj,jk) = f_hco3 |
1357 | | f3_co3(ji,jj,jk) = f_co3 |
1358 | | f3_omcal(ji,jj,jk) = f_omcal(ji,jj) |
1359 | | f3_omarg(ji,jj,jk) = f_omarg(ji,jj) |
1360 | | !! |
1361 | | !! CCD calculation: calcite |
1362 | | if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then |
1363 | | if (jk .eq. 1) then |
1364 | | f2_ccd_cal(ji,jj) = fdep2 |
1365 | | else |
1366 | | fq0 = f3_omcal(ji,jj,jk-1) - f_omcal(ji,jj) |
1367 | | fq1 = f3_omcal(ji,jj,jk-1) - 1.0 |
1368 | | fq2 = fq1 / (fq0 + tiny(fq0)) |
1369 | | fq3 = fdep2 - fsdept(ji,jj,jk-1) |
1370 | | fq4 = fq2 * fq3 |
1371 | | f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk-1) + fq4 |
1372 | | endif |
1373 | | i2_omcal(ji,jj) = 1 |
1374 | | endif |
1375 | | if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then |
1376 | | !! reached seafloor and still no dissolution; set to seafloor (W-point) |
1377 | | f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1) |
1378 | | i2_omcal(ji,jj) = 1 |
1379 | | endif |
1380 | | !! |
1381 | | !! CCD calculation: aragonite |
1382 | | if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then |
1383 | | if (jk .eq. 1) then |
1384 | | f2_ccd_arg(ji,jj) = fdep2 |
1385 | | else |
1386 | | fq0 = f3_omarg(ji,jj,jk-1) - f_omarg(ji,jj) |
1387 | | fq1 = f3_omarg(ji,jj,jk-1) - 1.0 |
1388 | | fq2 = fq1 / (fq0 + tiny(fq0)) |
1389 | | fq3 = fdep2 - fsdept(ji,jj,jk-1) |
1390 | | fq4 = fq2 * fq3 |
1391 | | f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk-1) + fq4 |
1392 | | endif |
1393 | | i2_omarg(ji,jj) = 1 |
1394 | | endif |
1395 | | if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then |
1396 | | !! reached seafloor and still no dissolution; set to seafloor (W-point) |
1397 | | f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1) |
1398 | | i2_omarg(ji,jj) = 1 |
1399 | | endif |
1400 | | endif |
1401 | | ENDDO |
1402 | | ENDDO |
1403 | | ENDDO |
1404 | | ENDIF |
1405 | | # endif |
1406 | | |
1407 | | # if defined key_debug_medusa |
1408 | | IF ( lwp ) write (numout,*) 'trc_bio_medusa: ready for full domain calculations' |
1409 | | CALL flush(numout) |
1410 | | # endif |
1411 | | |
1412 | | !!---------------------------------------------------------------------- |
1413 | | !! MEDUSA has unified equation through the water column |
1414 | | !! (Diff. from LOBSTER which has two sets: bio- and non-bio layers) |
1415 | | !! Statement below in LOBSTER is different: DO jk = 1, jpkbm1 |
1416 | | !!---------------------------------------------------------------------- |
1417 | | !! |
1418 | | !! NOTE: the ordering of the loops below differs from that of some other |
1419 | | !! models; looping over the vertical dimension is the outermost loop and |
1420 | | !! this complicates some calculations (e.g. storage of vertical fluxes |
1421 | | !! that can otherwise be done via a singular variable require 2D fields |
1422 | | !! here); however, these issues are relatively easily resolved, but the |
1423 | | !! loops CANNOT be reordered without potentially causing code efficiency |
1424 | | !! problems (e.g. array indexing means that reordering the loops would |
1425 | | !! require skipping between widely-spaced memory location; potentially |
1426 | | !! outside those immediately cached) |
1427 | | !! |
1428 | | !! OPEN vertical loop |
1429 | | DO jk = 1,jpk |
1430 | | !! OPEN horizontal loops |
1431 | | DO jj = 2,jpjm1 |
1432 | | DO ji = 2,jpim1 |
1433 | | !! OPEN wet point IF..THEN loop |
1434 | | if (tmask(ji,jj,jk).eq.1) then |
1435 | | !!====================================================================== |
1436 | | !! SETUP LOCAL GRID CELL |
1437 | | !!====================================================================== |
1438 | | !! |
1439 | | !!--------------------------------------------------------------------- |
1440 | | !! Some notes on grid vertical structure |
1441 | | !! - fsdepw(ji,jj,jk) is the depth of the upper surface of level jk |
1442 | | !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of level jk |
1443 | | !! - fse3t(ji,jj,jk) is the thickness of level jk |
1444 | | !!--------------------------------------------------------------------- |
1445 | | !! |
1446 | | !! AXY (11/12/08): set up level thickness |
1447 | | fthk = fse3t(ji,jj,jk) |
1448 | | !! AXY (25/02/10): set up level depth (top of level) |
1449 | | fdep = fsdepw(ji,jj,jk) |
1450 | | !! AXY (01/03/10): set up level depth (bottom of level) |
1451 | | fdep1 = fdep + fthk |
1452 | | !! AXY (17/05/13): where am I? |
1453 | | flatx = gphit(ji,jj) |
1454 | | flonx = glamt(ji,jj) |
1455 | | !! AXY (28/11/16): local seafloor depth |
1456 | | !! previously mbathy(ji,jj) - 1, now mbathy(ji,jj) |
1457 | | jmbathy = mbathy(ji,jj) |
1458 | | !! |
1459 | | !! set up model tracers |
1460 | | !! negative values of state variables are not allowed to |
1461 | | !! contribute to the calculated fluxes |
1462 | | zchn = max(0.,trn(ji,jj,jk,jpchn)) !! non-diatom chlorophyll |
1463 | | zchd = max(0.,trn(ji,jj,jk,jpchd)) !! diatom chlorophyll |
1464 | | zphn = max(0.,trn(ji,jj,jk,jpphn)) !! non-diatoms |
1465 | | zphd = max(0.,trn(ji,jj,jk,jpphd)) !! diatoms |
1466 | | zpds = max(0.,trn(ji,jj,jk,jppds)) !! diatom silicon |
1467 | | !! AXY (28/01/10): probably need to take account of chl/biomass connection |
1468 | | if (zchn.eq.0.) zphn = 0. |
1469 | | if (zchd.eq.0.) zphd = 0. |
1470 | | if (zphn.eq.0.) zchn = 0. |
1471 | | if (zphd.eq.0.) zchd = 0. |
1472 | | !! AXY (23/01/14): duh - why did I forget diatom silicon? |
1473 | | if (zpds.eq.0.) zphd = 0. |
1474 | | if (zphd.eq.0.) zpds = 0. |
1475 | | zzmi = max(0.,trn(ji,jj,jk,jpzmi)) !! microzooplankton |
1476 | | zzme = max(0.,trn(ji,jj,jk,jpzme)) !! mesozooplankton |
1477 | | zdet = max(0.,trn(ji,jj,jk,jpdet)) !! detrital nitrogen |
1478 | | zdin = max(0.,trn(ji,jj,jk,jpdin)) !! dissolved inorganic nitrogen |
1479 | | zsil = max(0.,trn(ji,jj,jk,jpsil)) !! dissolved silicic acid |
1480 | | zfer = max(0.,trn(ji,jj,jk,jpfer)) !! dissolved "iron" |
1481 | | # if defined key_roam |
1482 | | zdtc = max(0.,trn(ji,jj,jk,jpdtc)) !! detrital carbon |
1483 | | zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon |
1484 | | zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity |
1485 | | zoxy = max(0.,trn(ji,jj,jk,jpoxy)) !! oxygen |
1486 | | # if defined key_axy_carbchem |
1487 | | zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield |
| 1324 | !! AXY (20/11/14): alter to call on first MEDUSA timestep and then every |
| 1325 | !! month (this is hardwired as 960 timesteps but should |
| 1326 | !! be calculated and done properly |
| 1327 | !! IF( kt == nit000 .or. mod(kt,1920) == 0 ) THEN |
| 1328 | !! IF( kt == nittrc000 .or. mod(kt,960) == 0 ) THEN |
| 1329 | !!============================= |
| 1330 | !! Jpalm -- 07-10-2016 -- need to change carb-chem frequency call : |
| 1331 | !! we don't want to call on the first time-step of all run submission, |
| 1332 | !! but only on the very first time-step, and then every month |
| 1333 | !! So we call on nittrc000 if not restarted run, |
| 1334 | !! else if one month after last call. |
| 1335 | !! assume one month is 30d --> 3600*24*30 : 2592000s |
| 1336 | !! try to call carb-chem at 1st month's tm-stp : x * 30d + 1*rdt(i.e: mod = rdt) |
| 1337 | !! ++ need to pass carb-chem output var through restarts |
| 1338 | If ( ( kt == nittrc000 .AND. .NOT.ln_rsttr ) .OR. mod(kt*rdt,2592000.) == rdt ) THEN |
| 1339 | !!---------------------------------------------------------------------- |
| 1340 | !! Calculate the carbonate chemistry for the whole ocean on the first |
| 1341 | !! simulation timestep and every month subsequently; the resulting 3D |
| 1342 | !! field of omega calcite is used to determine the depth of the CCD |
| 1343 | !!---------------------------------------------------------------------- |
| 1344 | !! |
| 1345 | IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt |
| 1346 | CALL flush(numout) |
| 1347 | !! blank flags |
| 1348 | i2_omcal(:,:) = 0 |
| 1349 | i2_omarg(:,:) = 0 |
| 1350 | !! loop over 3D space |
| 1351 | DO jk = 1,jpk |
| 1352 | DO jj = 2,jpjm1 |
| 1353 | DO ji = 2,jpim1 |
| 1354 | !! OPEN wet point IF..THEN loop |
| 1355 | if (tmask(ji,jj,jk).eq.1) then |
| 1356 | IF (lk_oasis) THEN |
| 1357 | f_xco2a = PCO2a_in_cpl(ji,jj) !! use 2D atm xCO2 from atm coupling |
| 1358 | ENDIF |
| 1359 | !! do carbonate chemistry |
| 1360 | !! |
| 1361 | fdep2 = fsdept(ji,jj,jk) !! set up level midpoint |
| 1362 | !! AXY (28/11/16): local seafloor depth |
| 1363 | !! previously mbathy(ji,jj) - 1, now mbathy(ji,jj) |
| 1364 | jmbathy = mbathy(ji,jj) |
| 1365 | !! |
| 1366 | !! set up required state variables |
| 1367 | zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon |
| 1368 | zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity |
| 1369 | ztmp = tsn(ji,jj,jk,jp_tem) !! temperature |
| 1370 | zsal = tsn(ji,jj,jk,jp_sal) !! salinity |
| 1371 | # if defined key_mocsy |
| 1372 | zsil = max(0.,trn(ji,jj,jk,jpsil)) !! silicic acid |
| 1373 | zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield |
1507 | | endif |
| 1389 | endif |
| 1390 | !! |
| 1391 | !! blank input variables not used at this stage (they relate to air-sea flux) |
| 1392 | f_kw660 = 1.0 |
| 1393 | f_pp0 = 1.0 |
| 1394 | !! |
| 1395 | !! calculate carbonate chemistry at grid cell midpoint |
| 1396 | # if defined key_mocsy |
| 1397 | !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate |
| 1398 | !! chemistry package |
| 1399 | CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho, & ! inputs |
| 1400 | f_pp0, fdep2, gphit(ji,jj), f_kw660, f_xco2a, 1, & ! inputs |
| 1401 | f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj), & ! outputs |
| 1402 | f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut, & ! outputs |
| 1403 | f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0, & ! outputs |
| 1404 | f_co2starair, f_co2flux, f_dpco2 ) ! outputs |
| 1405 | !! |
| 1406 | f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg |
| 1407 | f_TALK = (zalk / f_rhosw) * 1000. ! meq / m3 -> ueq / kg |
| 1408 | f_dcf = f_rhosw |
| 1409 | # else |
| 1410 | !! AXY (22/06/15): use old PML carbonate chemistry package (the |
| 1411 | !! MEDUSA-2 default) |
| 1412 | CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, f_kw660, & ! inputs |
| 1413 | f_xco2a, f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj), & ! outputs |
| 1414 | f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters) ! outputs |
| 1415 | !! |
| 1416 | !! AXY (28/02/14): check output fields |
| 1417 | if (iters .eq. 25) then |
| 1418 | IF(lwp) WRITE(numout,*) ' trc_bio_medusa: 3D ITERS WARNING, ', & |
| 1419 | iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt |
| 1420 | endif |
| 1421 | # endif |
| 1422 | !! |
| 1423 | !! store 3D outputs |
| 1424 | f3_pH(ji,jj,jk) = f_ph |
| 1425 | f3_h2co3(ji,jj,jk) = f_h2co3 |
| 1426 | f3_hco3(ji,jj,jk) = f_hco3 |
| 1427 | f3_co3(ji,jj,jk) = f_co3 |
| 1428 | f3_omcal(ji,jj,jk) = f_omcal(ji,jj) |
| 1429 | f3_omarg(ji,jj,jk) = f_omarg(ji,jj) |
| 1430 | !! |
| 1431 | !! CCD calculation: calcite |
| 1432 | if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then |
| 1433 | if (jk .eq. 1) then |
| 1434 | f2_ccd_cal(ji,jj) = fdep2 |
| 1435 | else |
| 1436 | fq0 = f3_omcal(ji,jj,jk-1) - f_omcal(ji,jj) |
| 1437 | fq1 = f3_omcal(ji,jj,jk-1) - 1.0 |
| 1438 | fq2 = fq1 / (fq0 + tiny(fq0)) |
| 1439 | fq3 = fdep2 - fsdept(ji,jj,jk-1) |
| 1440 | fq4 = fq2 * fq3 |
| 1441 | f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk-1) + fq4 |
| 1442 | endif |
| 1443 | i2_omcal(ji,jj) = 1 |
| 1444 | endif |
| 1445 | if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then |
| 1446 | !! reached seafloor and still no dissolution; set to seafloor (W-point) |
| 1447 | f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1) |
| 1448 | i2_omcal(ji,jj) = 1 |
| 1449 | endif |
| 1450 | !! |
| 1451 | !! CCD calculation: aragonite |
| 1452 | if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then |
| 1453 | if (jk .eq. 1) then |
| 1454 | f2_ccd_arg(ji,jj) = fdep2 |
| 1455 | else |
| 1456 | fq0 = f3_omarg(ji,jj,jk-1) - f_omarg(ji,jj) |
| 1457 | fq1 = f3_omarg(ji,jj,jk-1) - 1.0 |
| 1458 | fq2 = fq1 / (fq0 + tiny(fq0)) |
| 1459 | fq3 = fdep2 - fsdept(ji,jj,jk-1) |
| 1460 | fq4 = fq2 * fq3 |
| 1461 | f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk-1) + fq4 |
| 1462 | endif |
| 1463 | i2_omarg(ji,jj) = 1 |
| 1464 | endif |
| 1465 | if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then |
| 1466 | !! reached seafloor and still no dissolution; set to seafloor (W-point) |
| 1467 | f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1) |
| 1468 | i2_omarg(ji,jj) = 1 |
| 1469 | endif |
| 1470 | endif |
| 1471 | ENDDO |
| 1472 | ENDDO |
| 1473 | ENDDO |
| 1474 | ENDIF |
| 1475 | # endif |
| 1476 | |
| 1477 | # if defined key_debug_medusa |
| 1478 | IF (lwp) write (numout,*) 'trc_bio_medusa: ready for full domain calculations' |
| 1479 | CALL flush(numout) |
| 1480 | # endif |
| 1481 | |
| 1482 | !!---------------------------------------------------------------------- |
| 1483 | !! MEDUSA has unified equation through the water column |
| 1484 | !! (Diff. from LOBSTER which has two sets: bio- and non-bio layers) |
| 1485 | !! Statement below in LOBSTER is different: DO jk = 1, jpkbm1 |
| 1486 | !!---------------------------------------------------------------------- |
| 1487 | !! |
| 1488 | !! NOTE: the ordering of the loops below differs from that of some other |
| 1489 | !! models; looping over the vertical dimension is the outermost loop and |
| 1490 | !! this complicates some calculations (e.g. storage of vertical fluxes |
| 1491 | !! that can otherwise be done via a singular variable require 2D fields |
| 1492 | !! here); however, these issues are relatively easily resolved, but the |
| 1493 | !! loops CANNOT be reordered without potentially causing code efficiency |
| 1494 | !! problems (e.g. array indexing means that reordering the loops would |
| 1495 | !! require skipping between widely-spaced memory location; potentially |
| 1496 | !! outside those immediately cached) |
| 1497 | !! |
| 1498 | !! OPEN vertical loop |
| 1499 | DO jk = 1,jpk |
| 1500 | !! OPEN horizontal loops |
| 1501 | DO jj = 2,jpjm1 |
| 1502 | DO ji = 2,jpim1 |
| 1503 | !! OPEN wet point IF..THEN loop |
| 1504 | if (tmask(ji,jj,jk).eq.1) then |
| 1505 | !!====================================================================== |
| 1506 | !! SETUP LOCAL GRID CELL |
| 1507 | !!====================================================================== |
| 1508 | !! |
| 1509 | !!--------------------------------------------------------------------- |
| 1510 | !! Some notes on grid vertical structure |
| 1511 | !! - fsdepw(ji,jj,jk) is the depth of the upper surface of level jk |
| 1512 | !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of level jk |
| 1513 | !! - fse3t(ji,jj,jk) is the thickness of level jk |
| 1514 | !!--------------------------------------------------------------------- |
| 1515 | !! |
| 1516 | !! AXY (11/12/08): set up level thickness |
| 1517 | fthk = fse3t(ji,jj,jk) |
| 1518 | !! AXY (25/02/10): set up level depth (top of level) |
| 1519 | fdep = fsdepw(ji,jj,jk) |
| 1520 | !! AXY (01/03/10): set up level depth (bottom of level) |
| 1521 | fdep1 = fdep + fthk |
| 1522 | !! AXY (28/11/16): local seafloor depth |
| 1523 | !! previously mbathy(ji,jj) - 1, now mbathy(ji,jj) |
| 1524 | jmbathy = mbathy(ji,jj) |
| 1525 | !! |
| 1526 | !! set up model tracers |
| 1527 | !! negative values of state variables are not allowed to |
| 1528 | !! contribute to the calculated fluxes |
| 1529 | zchn = max(0.,trn(ji,jj,jk,jpchn)) !! non-diatom chlorophyll |
| 1530 | zchd = max(0.,trn(ji,jj,jk,jpchd)) !! diatom chlorophyll |
| 1531 | zphn = max(0.,trn(ji,jj,jk,jpphn)) !! non-diatoms |
| 1532 | zphd = max(0.,trn(ji,jj,jk,jpphd)) !! diatoms |
| 1533 | zpds = max(0.,trn(ji,jj,jk,jppds)) !! diatom silicon |
| 1534 | !! AXY (28/01/10): probably need to take account of chl/biomass connection |
| 1535 | if (zchn.eq.0.) zphn = 0. |
| 1536 | if (zchd.eq.0.) zphd = 0. |
| 1537 | if (zphn.eq.0.) zchn = 0. |
| 1538 | if (zphd.eq.0.) zchd = 0. |
| 1539 | !! AXY (23/01/14): duh - why did I forget diatom silicon? |
| 1540 | if (zpds.eq.0.) zphd = 0. |
| 1541 | if (zphd.eq.0.) zpds = 0. |
| 1542 | zzmi = max(0.,trn(ji,jj,jk,jpzmi)) !! microzooplankton |
| 1543 | zzme = max(0.,trn(ji,jj,jk,jpzme)) !! mesozooplankton |
| 1544 | zdet = max(0.,trn(ji,jj,jk,jpdet)) !! detrital nitrogen |
| 1545 | zdin = max(0.,trn(ji,jj,jk,jpdin)) !! dissolved inorganic nitrogen |
| 1546 | zsil = max(0.,trn(ji,jj,jk,jpsil)) !! dissolved silicic acid |
| 1547 | zfer = max(0.,trn(ji,jj,jk,jpfer)) !! dissolved "iron" |
| 1548 | # if defined key_roam |
| 1549 | zdtc = max(0.,trn(ji,jj,jk,jpdtc)) !! detrital carbon |
| 1550 | zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon |
| 1551 | zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity |
| 1552 | zoxy = max(0.,trn(ji,jj,jk,jpoxy)) !! oxygen |
| 1553 | # if defined key_axy_carbchem && defined key_mocsy |
| 1554 | zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield |
| 1555 | # endif |
| 1556 | !! |
| 1557 | !! also need physical parameters for gas exchange calculations |
| 1558 | ztmp = tsn(ji,jj,jk,jp_tem) |
| 1559 | zsal = tsn(ji,jj,jk,jp_sal) |
| 1560 | !! |
| 1561 | !! AXY (28/02/14): check input fields |
| 1562 | if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then |
| 1563 | IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 2D, ', & |
| 1564 | tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (', & |
| 1565 | ji, ',', jj, ',', jk, ') at time', kt |
| 1566 | IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 2D, ', & |
| 1567 | tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) |
| 1568 | ztmp = tsb(ji,jj,jk,jp_tem) !! temperature |
| 1569 | endif |
| 1570 | if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then |
| 1571 | IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 2D, ', & |
| 1572 | tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (', & |
| 1573 | ji, ',', jj, ',', jk, ') at time', kt |
| 1574 | endif |
1850 | | ENDIF |
1851 | | !! |
1852 | | endif |
1853 | | !! End jk = 1 loop within ROAM key |
1854 | | |
1855 | | !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic |
1856 | | IF ( med_diag%O2SAT3%dgsave ) THEN |
1857 | | call oxy_sato( ztmp, zsal, f_o2sat3 ) |
1858 | | o2sat3(ji, jj, jk) = f_o2sat3 |
1859 | | ENDIF |
1860 | | |
1861 | | # endif |
1862 | | |
1863 | | !!====================================================================== |
1864 | | !! AXY (07/04/17): possible subroutine block; riverine inputs (or delete; it's unused presently) |
1865 | | !!====================================================================== |
1866 | | if ( jk .eq. 1 ) then |
1867 | | !!---------------------------------------------------------------------- |
1868 | | !! River inputs |
1869 | | !!---------------------------------------------------------------------- |
1870 | | !! |
1871 | | !! runoff comes in as kg / m2 / s |
1872 | | !! used and written out as m3 / m2 / d (= m / d) |
1873 | | !! where 1000 kg / m2 / d = 1 m3 / m2 / d = 1 m / d |
1874 | | !! |
1875 | | !! AXY (17/07/14): the compiler doesn't like this line for some reason; |
1876 | | !! as MEDUSA doesn't even use runoff for riverine inputs, |
1877 | | !! a temporary solution is to switch off runoff entirely |
1878 | | !! here; again, this change is one of several that will |
1879 | | !! need revisiting once MEDUSA has bedded down in UKESM1; |
1880 | | !! particularly so if the land scheme provides information |
1881 | | !! concerning nutrient fluxes |
1882 | | !! |
1883 | | !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. * 60. * 24. |
1884 | | f_runoff(ji,jj) = 0.0 |
1885 | | !! |
1886 | | !! nutrients are added via rivers to the model in one of two ways: |
1887 | | !! 1. via river concentration; i.e. the average nutrient concentration |
1888 | | !! of a river water is described by a spatial file, and this is |
1889 | | !! multiplied by runoff to give a nutrient flux |
1890 | | !! 2. via direct river flux; i.e. the average nutrient flux due to |
1891 | | !! rivers is described by a spatial file, and this is simply applied |
1892 | | !! as a direct nutrient flux (i.e. it does not relate or respond to |
1893 | | !! model runoff) |
1894 | | !! nutrient fields are derived from the GlobalNEWS 2 database; carbon and |
1895 | | !! alkalinity are derived from continent-scale DIC estimates (Huang et al., |
1896 | | !! 2012) and some Arctic river alkalinity estimates (Katya?) |
1897 | | !! |
1898 | | !! as of 19/07/12, riverine nutrients can now be spread vertically across |
1899 | | !! several grid cells rather than just poured into the surface box; this |
1900 | | !! block of code is still executed, however, to set up the total amounts |
1901 | | !! of nutrient entering via rivers |
1902 | | !! |
1903 | | !! nitrogen |
1904 | | if (jriver_n .eq. 1) then |
1905 | | !! river concentration specified; use runoff to calculate input |
1906 | | f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj) |
1907 | | elseif (jriver_n .eq. 2) then |
1908 | | !! river flux specified; independent of runoff |
1909 | | f_riv_n(ji,jj) = riv_n(ji,jj) |
1910 | | endif |
1911 | | !! |
1912 | | !! silicon |
1913 | | if (jriver_si .eq. 1) then |
1914 | | !! river concentration specified; use runoff to calculate input |
1915 | | f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj) |
1916 | | elseif (jriver_si .eq. 2) then |
1917 | | !! river flux specified; independent of runoff |
1918 | | f_riv_si(ji,jj) = riv_si(ji,jj) |
1919 | | endif |
1920 | | !! |
1921 | | !! carbon |
1922 | | if (jriver_c .eq. 1) then |
1923 | | !! river concentration specified; use runoff to calculate input |
1924 | | f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj) |
1925 | | elseif (jriver_c .eq. 2) then |
1926 | | !! river flux specified; independent of runoff |
1927 | | f_riv_c(ji,jj) = riv_c(ji,jj) |
1928 | | endif |
1929 | | !! |
1930 | | !! alkalinity |
1931 | | if (jriver_alk .eq. 1) then |
1932 | | !! river concentration specified; use runoff to calculate input |
1933 | | f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj) |
1934 | | elseif (jriver_alk .eq. 2) then |
1935 | | !! river flux specified; independent of runoff |
1936 | | f_riv_alk(ji,jj) = riv_alk(ji,jj) |
1937 | | endif |
1938 | | |
1939 | | endif |
1940 | | |
1941 | | !!====================================================================== |
1942 | | !! AXY (07/04/17): possible subroutine block; phytoplankton growth |
1943 | | !!====================================================================== |
1944 | | |
1945 | | !!---------------------------------------------------------------------- |
1946 | | !! Chlorophyll calculations |
1947 | | !!---------------------------------------------------------------------- |
1948 | | !! |
1949 | | !! non-diatoms |
1950 | | if (zphn.GT.rsmall) then |
1951 | | fthetan = max(tiny(zchn), (zchn * xxi) / (zphn + tiny(zphn))) |
1952 | | faln = xaln * fthetan |
1953 | | else |
1954 | | fthetan = 0. |
1955 | | faln = 0. |
1956 | | endif |
1957 | | !! |
1958 | | !! diatoms |
1959 | | if (zphd.GT.rsmall) then |
1960 | | fthetad = max(tiny(zchd), (zchd * xxi) / (zphd + tiny(zphd))) |
1961 | | fald = xald * fthetad |
1962 | | else |
1963 | | fthetad = 0. |
1964 | | fald = 0. |
1965 | | endif |
1966 | | |
1967 | | !!---------------------------------------------------------------------- |
1968 | | !! Phytoplankton light limitation |
1969 | | !!---------------------------------------------------------------------- |
1970 | | !! |
1971 | | !! It is assumed xpar is the depth-averaged (vertical layer) PAR |
1972 | | !! Light limitation (check self-shading) in W/m2 |
1973 | | !! |
1974 | | !! Note that there is no temperature dependence in phytoplankton |
1975 | | !! growth rate or any other function. |
1976 | | !! In calculation of Chl/Phy ratio tiny(phyto) is introduced to avoid |
1977 | | !! NaNs in case of Phy==0. |
1978 | | !! |
1979 | | !! fthetad and fthetan are Chl:C ratio (gChl/gC) in diat and non-diat: |
1980 | | !! for 1:1 Chl:P ratio (mgChl/mmolN) theta=0.012 |
1981 | | !! |
1982 | | !! AXY (16/07/09) |
1983 | | !! temperature for new Eppley style phytoplankton growth |
1984 | | loc_T = tsn(ji,jj,jk,jp_tem) |
1985 | | fun_T = 1.066**(1.0 * loc_T) |
1986 | | !! AXY (16/05/11): add in new Q10 (1.5, not 2.0) for |
1987 | | !phytoplankton |
1988 | | !! growth; remin. unaffected |
1989 | | fun_Q10 = xq10**((loc_T - 0.0) / 10.0) |
1990 | | if (jphy.eq.1) then |
1991 | | xvpnT = xvpn * fun_T |
1992 | | xvpdT = xvpd * fun_T |
1993 | | elseif (jphy.eq.2) then |
1994 | | xvpnT = xvpn * fun_Q10 |
1995 | | xvpdT = xvpd * fun_Q10 |
1996 | | else |
1997 | | xvpnT = xvpn |
1998 | | xvpdT = xvpd |
1999 | | endif |
2000 | | !! |
2001 | | !! non-diatoms |
2002 | | fchn1 = (xvpnT * xvpnT) + (faln * faln * xpar(ji,jj,jk) * xpar(ji,jj,jk)) |
2003 | | if (fchn1.GT.rsmall) then |
2004 | | fchn = xvpnT / (sqrt(fchn1) + tiny(fchn1)) |
2005 | | else |
2006 | | fchn = 0. |
2007 | | endif |
2008 | | fjln = fchn * faln * xpar(ji,jj,jk) !! non-diatom J term |
2009 | | fjlim_pn = fjln / xvpnT |
2010 | | !! |
2011 | | !! diatoms |
2012 | | fchd1 = (xvpdT * xvpdT) + (fald * fald * xpar(ji,jj,jk) * xpar(ji,jj,jk)) |
2013 | | if (fchd1.GT.rsmall) then |
2014 | | fchd = xvpdT / (sqrt(fchd1) + tiny(fchd1)) |
2015 | | else |
2016 | | fchd = 0. |
2017 | | endif |
2018 | | fjld = fchd * fald * xpar(ji,jj,jk) !! diatom J term |
2019 | | fjlim_pd = fjld / xvpdT |
2020 | | |
2021 | | !!---------------------------------------------------------------------- |
2022 | | !! Phytoplankton nutrient limitation |
2023 | | !!---------------------------------------------------------------------- |
2024 | | !! |
2025 | | !! non-diatoms (N, Fe) |
2026 | | fnln = zdin / (zdin + xnln) !! non-diatom Qn term |
2027 | | ffln = zfer / (zfer + xfln) !! non-diatom Qf term |
2028 | | !! |
2029 | | !! diatoms (N, Si, Fe) |
2030 | | fnld = zdin / (zdin + xnld) !! diatom Qn term |
2031 | | fsld = zsil / (zsil + xsld) !! diatom Qs term |
2032 | | ffld = zfer / (zfer + xfld) !! diatom Qf term |
2033 | | |
2034 | | !!---------------------------------------------------------------------- |
2035 | | !! Primary production (non-diatoms) |
2036 | | !! (note: still needs multiplying by phytoplankton concentration) |
2037 | | !!---------------------------------------------------------------------- |
2038 | | !! |
2039 | | if (jliebig .eq. 0) then |
2040 | | !! multiplicative nutrient limitation |
2041 | | fpnlim = fnln * ffln |
2042 | | elseif (jliebig .eq. 1) then |
2043 | | !! Liebig Law (= most limiting) nutrient limitation |
2044 | | fpnlim = min(fnln, ffln) |
2045 | | endif |
2046 | | fprn = fjln * fpnlim |
2047 | | |
2048 | | !!---------------------------------------------------------------------- |
2049 | | !! Primary production (diatoms) |
2050 | | !! (note: still needs multiplying by phytoplankton concentration) |
2051 | | !! |
2052 | | !! production here is split between nitrogen production and that of |
2053 | | !! silicon; depending upon the "intracellular" ratio of Si:N, model |
2054 | | !! diatoms will uptake nitrogen/silicon differentially; this borrows |
2055 | | !! from the diatom model of Mongin et al. (2006) |
2056 | | !!---------------------------------------------------------------------- |
2057 | | !! |
2058 | | if (jliebig .eq. 0) then |
2059 | | !! multiplicative nutrient limitation |
2060 | | fpdlim = fnld * ffld |
2061 | | elseif (jliebig .eq. 1) then |
2062 | | !! Liebig Law (= most limiting) nutrient limitation |
2063 | | fpdlim = min(fnld, ffld) |
2064 | | endif |
2065 | | !! |
2066 | | if (zphd.GT.rsmall .AND. zpds.GT.rsmall) then |
2067 | | !! "intracellular" elemental ratios |
2068 | | ! fsin = zpds / (zphd + tiny(zphd)) |
2069 | | ! fnsi = zphd / (zpds + tiny(zpds)) |
2070 | | fsin = 0.0 |
2071 | | IF( zphd .GT. rsmall) fsin = zpds / zphd |
2072 | | fnsi = 0.0 |
2073 | | IF( zpds .GT. rsmall) fnsi = zphd / zpds |
2074 | | !! AXY (23/02/10): these next variables derive from Mongin et al. (2003) |
2075 | | fsin1 = 3.0 * xsin0 !! = 0.6 |
2076 | | fnsi1 = 1.0 / fsin1 !! = 1.667 |
2077 | | fnsi2 = 1.0 / xsin0 !! = 5.0 |
2078 | | !! |
2079 | | !! conditionalities based on ratios |
2080 | | !! nitrogen (and iron and carbon) |
2081 | | if (fsin.le.xsin0) then |
2082 | | fprd = 0.0 |
2083 | | fsld2 = 0.0 |
2084 | | elseif (fsin.lt.fsin1) then |
2085 | | fprd = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) * (fjld * fpdlim) |
2086 | | fsld2 = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) |
2087 | | elseif (fsin.ge.fsin1) then |
2088 | | fprd = (fjld * fpdlim) |
2089 | | fsld2 = 1.0 |
2090 | | endif |
2091 | | !! |
2092 | | !! silicon |
2093 | | if (fsin.lt.fnsi1) then |
2094 | | fprds = (fjld * fsld) |
2095 | | elseif (fsin.lt.fnsi2) then |
2096 | | fprds = xuif * ((fnsi - xnsi0) / (fnsi + tiny(fnsi))) * (fjld * fsld) |
2097 | | else |
2098 | | fprds = 0.0 |
2099 | | endif |
2100 | | else |
2101 | | fsin = 0.0 |
2102 | | fnsi = 0.0 |
2103 | | fprd = 0.0 |
2104 | | fsld2 = 0.0 |
2105 | | fprds = 0.0 |
2106 | | endif |
2107 | | |
2108 | | !!---------------------------------------------------------------------- |
2109 | | !! Mixed layer primary production |
2110 | | !! this block calculates the amount of primary production that occurs |
2111 | | !! within the upper mixed layer; this allows the separate diagnosis |
2112 | | !! of "sub-surface" primary production; it does assume that short- |
2113 | | !! term variability in mixed layer depth doesn't mess with things |
2114 | | !! though |
2115 | | !!---------------------------------------------------------------------- |
2116 | | !! |
2117 | | if (fdep1.le.hmld(ji,jj)) then |
2118 | | !! this level is entirely in the mixed layer |
2119 | | fq0 = 1.0 |
2120 | | elseif (fdep.ge.hmld(ji,jj)) then |
2121 | | !! this level is entirely below the mixed layer |
2122 | | fq0 = 0.0 |
2123 | | else |
2124 | | !! this level straddles the mixed layer |
2125 | | fq0 = (hmld(ji,jj) - fdep) / fthk |
2126 | | endif |
2127 | | !! |
2128 | | fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn * zphn * fthk * fq0) |
2129 | | fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd * zphd * fthk * fq0) |
2130 | | |
2131 | | !!---------------------------------------------------------------------- |
2132 | | !! Vertical Integral -- |
2133 | | !!---------------------------------------------------------------------- |
2134 | | ftot_pn(ji,jj) = ftot_pn(ji,jj) + (zphn * fthk) !! vertical integral non-diatom phytoplankton |
2135 | | ftot_pd(ji,jj) = ftot_pd(ji,jj) + (zphd * fthk) !! vertical integral diatom phytoplankton |
2136 | | ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk) !! vertical integral microzooplankton |
2137 | | ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk) !! vertical integral mesozooplankton |
2138 | | ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk) !! vertical integral slow detritus, nitrogen |
2139 | | ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk) !! vertical integral slow detritus, carbon |
2140 | | |
2141 | | !!---------------------------------------------------------------------- |
2142 | | !! More chlorophyll calculations |
2143 | | !!---------------------------------------------------------------------- |
2144 | | !! |
2145 | | !! frn = (xthetam / fthetan) * (fprn / (fthetan * xpar(ji,jj,jk))) |
2146 | | !! frd = (xthetam / fthetad) * (fprd / (fthetad * xpar(ji,jj,jk))) |
2147 | | frn = (xthetam * fchn * fnln * ffln ) / (fthetan + tiny(fthetan)) |
2148 | | !! AXY (12/05/09): there's potentially a problem here; fsld, silicic acid |
2149 | | !! limitation, is used in the following line to regulate chlorophyll |
2150 | | !! growth in a manner that is inconsistent with its use in the regulation |
2151 | | !! of biomass growth; the Mongin term term used in growth is more complex |
2152 | | !! than the simple multiplicative function used below |
2153 | | !! frd = (xthetam * fchd * fnld * ffld * fsld) / (fthetad + tiny(fthetad)) |
2154 | | !! AXY (12/05/09): this replacement line uses the new variable, fsld2, to |
2155 | | !! regulate chlorophyll growth |
2156 | | frd = (xthetamd * fchd * fnld * ffld * fsld2) / (fthetad + tiny(fthetad)) |
2157 | | |
2158 | | !!====================================================================== |
2159 | | !! AXY (07/04/17): possible subroutine block; zooplankton grazing |
2160 | | !!====================================================================== |
2161 | | |
2162 | | !!---------------------------------------------------------------------- |
2163 | | !! Zooplankton Grazing |
2164 | | !! this code supplements the base grazing model with one that |
2165 | | !! considers the C:N ratio of grazed food and balances this against |
2166 | | !! the requirements of zooplankton growth; this model is derived |
2167 | | !! from that of Anderson & Pondaven (2003) |
2168 | | !! |
2169 | | !! the current version of the code assumes a fixed C:N ratio for |
2170 | | !! detritus (in contrast to Anderson & Pondaven, 2003), though the |
2171 | | !! full equations are retained for future extension |
2172 | | !!---------------------------------------------------------------------- |
2173 | | !! |
2174 | | !!---------------------------------------------------------------------- |
2175 | | !! Microzooplankton first |
2176 | | !!---------------------------------------------------------------------- |
2177 | | !! |
2178 | | fmi1 = (xkmi * xkmi) + (xpmipn * zphn * zphn) + (xpmid * zdet * zdet) |
2179 | | fmi = xgmi * zzmi / fmi1 |
2180 | | fgmipn = fmi * xpmipn * zphn * zphn !! grazing on non-diatoms |
2181 | | fgmid = fmi * xpmid * zdet * zdet !! grazing on detrital nitrogen |
| 1958 | ENDIF |
| 1959 | !! |
| 1960 | endif |
| 1961 | !! End jk = 1 loop within ROAM key |
| 1962 | |
| 1963 | !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic |
| 1964 | IF ( med_diag%O2SAT3%dgsave ) THEN |
| 1965 | call oxy_sato( ztmp, zsal, f_o2sat3 ) |
| 1966 | o2sat3(ji, jj, jk) = f_o2sat3 |
| 1967 | ENDIF |
| 1968 | |
| 1969 | # endif |
| 1970 | |
| 1971 | if ( jk .eq. 1 ) then |
| 1972 | !!---------------------------------------------------------------------- |
| 1973 | !! River inputs |
| 1974 | !!---------------------------------------------------------------------- |
| 1975 | !! |
| 1976 | !! runoff comes in as kg / m2 / s |
| 1977 | !! used and written out as m3 / m2 / d (= m / d) |
| 1978 | !! where 1000 kg / m2 / d = 1 m3 / m2 / d = 1 m / d |
| 1979 | !! |
| 1980 | !! AXY (17/07/14): the compiler doesn't like this line for some reason; |
| 1981 | !! as MEDUSA doesn't even use runoff for riverine inputs, |
| 1982 | !! a temporary solution is to switch off runoff entirely |
| 1983 | !! here; again, this change is one of several that will |
| 1984 | !! need revisiting once MEDUSA has bedded down in UKESM1; |
| 1985 | !! particularly so if the land scheme provides information |
| 1986 | !! concerning nutrient fluxes |
| 1987 | !! |
| 1988 | !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. * 60. * 24. |
| 1989 | f_runoff(ji,jj) = 0.0 |
| 1990 | !! |
| 1991 | !! nutrients are added via rivers to the model in one of two ways: |
| 1992 | !! 1. via river concentration; i.e. the average nutrient concentration |
| 1993 | !! of a river water is described by a spatial file, and this is |
| 1994 | !! multiplied by runoff to give a nutrient flux |
| 1995 | !! 2. via direct river flux; i.e. the average nutrient flux due to |
| 1996 | !! rivers is described by a spatial file, and this is simply applied |
| 1997 | !! as a direct nutrient flux (i.e. it does not relate or respond to |
| 1998 | !! model runoff) |
| 1999 | !! nutrient fields are derived from the GlobalNEWS 2 database; carbon and |
| 2000 | !! alkalinity are derived from continent-scale DIC estimates (Huang et al., |
| 2001 | !! 2012) and some Arctic river alkalinity estimates (Katya?) |
| 2002 | !! |
| 2003 | !! as of 19/07/12, riverine nutrients can now be spread vertically across |
| 2004 | !! several grid cells rather than just poured into the surface box; this |
| 2005 | !! block of code is still executed, however, to set up the total amounts |
| 2006 | !! of nutrient entering via rivers |
| 2007 | !! |
| 2008 | !! nitrogen |
| 2009 | if (jriver_n .eq. 1) then |
| 2010 | !! river concentration specified; use runoff to calculate input |
| 2011 | f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj) |
| 2012 | elseif (jriver_n .eq. 2) then |
| 2013 | !! river flux specified; independent of runoff |
| 2014 | f_riv_n(ji,jj) = riv_n(ji,jj) |
| 2015 | endif |
| 2016 | !! |
| 2017 | !! silicon |
| 2018 | if (jriver_si .eq. 1) then |
| 2019 | !! river concentration specified; use runoff to calculate input |
| 2020 | f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj) |
| 2021 | elseif (jriver_si .eq. 2) then |
| 2022 | !! river flux specified; independent of runoff |
| 2023 | f_riv_si(ji,jj) = riv_si(ji,jj) |
| 2024 | endif |
| 2025 | !! |
| 2026 | !! carbon |
| 2027 | if (jriver_c .eq. 1) then |
| 2028 | !! river concentration specified; use runoff to calculate input |
| 2029 | f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj) |
| 2030 | elseif (jriver_c .eq. 2) then |
| 2031 | !! river flux specified; independent of runoff |
| 2032 | f_riv_c(ji,jj) = riv_c(ji,jj) |
| 2033 | endif |
| 2034 | !! |
| 2035 | !! alkalinity |
| 2036 | if (jriver_alk .eq. 1) then |
| 2037 | !! river concentration specified; use runoff to calculate input |
| 2038 | f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj) |
| 2039 | elseif (jriver_alk .eq. 2) then |
| 2040 | !! river flux specified; independent of runoff |
| 2041 | f_riv_alk(ji,jj) = riv_alk(ji,jj) |
| 2042 | endif |
| 2043 | |
| 2044 | endif |
| 2045 | |
| 2046 | !!---------------------------------------------------------------------- |
| 2047 | !! Chlorophyll calculations |
| 2048 | !!---------------------------------------------------------------------- |
| 2049 | !! |
| 2050 | !! non-diatoms |
| 2051 | if (zphn.GT.rsmall) then |
| 2052 | fthetan = max(tiny(zchn), (zchn * xxi) / (zphn + tiny(zphn))) |
| 2053 | faln = xaln * fthetan |
| 2054 | else |
| 2055 | fthetan = 0. |
| 2056 | faln = 0. |
| 2057 | endif |
| 2058 | !! |
| 2059 | !! diatoms |
| 2060 | if (zphd.GT.rsmall) then |
| 2061 | fthetad = max(tiny(zchd), (zchd * xxi) / (zphd + tiny(zphd))) |
| 2062 | fald = xald * fthetad |
| 2063 | else |
| 2064 | fthetad = 0. |
| 2065 | fald = 0. |
| 2066 | endif |
| 2067 | |
| 2068 | # if defined key_debug_medusa |
| 2069 | !! report biological calculations |
| 2070 | if (idf.eq.1.AND.idfval.eq.1) then |
| 2071 | IF (lwp) write (numout,*) '------------------------------' |
| 2072 | IF (lwp) write (numout,*) 'faln(',jk,') = ', faln |
| 2073 | IF (lwp) write (numout,*) 'fald(',jk,') = ', fald |
| 2074 | endif |
| 2075 | # endif |
| 2076 | |
| 2077 | !!---------------------------------------------------------------------- |
| 2078 | !! Phytoplankton light limitation |
| 2079 | !!---------------------------------------------------------------------- |
| 2080 | !! |
| 2081 | !! It is assumed xpar is the depth-averaged (vertical layer) PAR |
| 2082 | !! Light limitation (check self-shading) in W/m2 |
| 2083 | !! |
| 2084 | !! Note that there is no temperature dependence in phytoplankton |
| 2085 | !! growth rate or any other function. |
| 2086 | !! In calculation of Chl/Phy ratio tiny(phyto) is introduced to avoid |
| 2087 | !! NaNs in case of Phy==0. |
| 2088 | !! |
| 2089 | !! fthetad and fthetan are Chl:C ratio (gChl/gC) in diat and non-diat: |
| 2090 | !! for 1:1 Chl:P ratio (mgChl/mmolN) theta=0.012 |
| 2091 | !! |
| 2092 | !! AXY (16/07/09) |
| 2093 | !! temperature for new Eppley style phytoplankton growth |
| 2094 | loc_T = tsn(ji,jj,jk,jp_tem) |
| 2095 | fun_T = 1.066**(1.0 * loc_T) |
| 2096 | !! AXY (16/05/11): add in new Q10 (1.5, not 2.0) for |
| 2097 | !phytoplankton |
| 2098 | !! growth; remin. unaffected |
| 2099 | fun_Q10 = jq10**((loc_T - 0.0) / 10.0) |
| 2100 | if (jphy.eq.1) then |
| 2101 | xvpnT = xvpn * fun_T |
| 2102 | xvpdT = xvpd * fun_T |
| 2103 | elseif (jphy.eq.2) then |
| 2104 | xvpnT = xvpn * fun_Q10 |
| 2105 | xvpdT = xvpd * fun_Q10 |
| 2106 | else |
| 2107 | xvpnT = xvpn |
| 2108 | xvpdT = xvpd |
| 2109 | endif |
| 2110 | !! |
| 2111 | !! non-diatoms |
| 2112 | fchn1 = (xvpnT * xvpnT) + (faln * faln * xpar(ji,jj,jk) * xpar(ji,jj,jk)) |
| 2113 | if (fchn1.GT.rsmall) then |
| 2114 | fchn = xvpnT / (sqrt(fchn1) + tiny(fchn1)) |
| 2115 | else |
| 2116 | fchn = 0. |
| 2117 | endif |
| 2118 | fjln = fchn * faln * xpar(ji,jj,jk) !! non-diatom J term |
| 2119 | fjlim_pn = fjln / xvpnT |
| 2120 | !! |
| 2121 | !! diatoms |
| 2122 | fchd1 = (xvpdT * xvpdT) + (fald * fald * xpar(ji,jj,jk) * xpar(ji,jj,jk)) |
| 2123 | if (fchd1.GT.rsmall) then |
| 2124 | fchd = xvpdT / (sqrt(fchd1) + tiny(fchd1)) |
| 2125 | else |
| 2126 | fchd = 0. |
| 2127 | endif |
| 2128 | fjld = fchd * fald * xpar(ji,jj,jk) !! diatom J term |
| 2129 | fjlim_pd = fjld / xvpdT |
| 2130 | |
| 2131 | # if defined key_debug_medusa |
| 2132 | !! report phytoplankton light limitation |
| 2133 | if (idf.eq.1.AND.idfval.eq.1) then |
| 2134 | IF (lwp) write (numout,*) '------------------------------' |
| 2135 | IF (lwp) write (numout,*) 'fchn(',jk,') = ', fchn |
| 2136 | IF (lwp) write (numout,*) 'fchd(',jk,') = ', fchd |
| 2137 | IF (lwp) write (numout,*) 'fjln(',jk,') = ', fjln |
| 2138 | IF (lwp) write (numout,*) 'fjld(',jk,') = ', fjld |
| 2139 | endif |
| 2140 | # endif |
| 2141 | |
| 2142 | !!---------------------------------------------------------------------- |
| 2143 | !! Phytoplankton nutrient limitation |
| 2144 | !!---------------------------------------------------------------------- |
| 2145 | !! |
| 2146 | !! non-diatoms (N, Fe) |
| 2147 | fnln = zdin / (zdin + xnln) !! non-diatom Qn term |
| 2148 | ffln = zfer / (zfer + xfln) !! non-diatom Qf term |
| 2149 | !! |
| 2150 | !! diatoms (N, Si, Fe) |
| 2151 | fnld = zdin / (zdin + xnld) !! diatom Qn term |
| 2152 | fsld = zsil / (zsil + xsld) !! diatom Qs term |
| 2153 | ffld = zfer / (zfer + xfld) !! diatom Qf term |
| 2154 | |
| 2155 | # if defined key_debug_medusa |
| 2156 | !! report phytoplankton nutrient limitation |
| 2157 | if (idf.eq.1.AND.idfval.eq.1) then |
| 2158 | IF (lwp) write (numout,*) '------------------------------' |
| 2159 | IF (lwp) write (numout,*) 'fnln(',jk,') = ', fnln |
| 2160 | IF (lwp) write (numout,*) 'fnld(',jk,') = ', fnld |
| 2161 | IF (lwp) write (numout,*) 'ffln(',jk,') = ', ffln |
| 2162 | IF (lwp) write (numout,*) 'ffld(',jk,') = ', ffld |
| 2163 | IF (lwp) write (numout,*) 'fsld(',jk,') = ', fsld |
| 2164 | endif |
| 2165 | # endif |
| 2166 | |
| 2167 | !!---------------------------------------------------------------------- |
| 2168 | !! Primary production (non-diatoms) |
| 2169 | !! (note: still needs multiplying by phytoplankton concentration) |
| 2170 | !!---------------------------------------------------------------------- |
| 2171 | !! |
| 2172 | if (jliebig .eq. 0) then |
| 2173 | !! multiplicative nutrient limitation |
| 2174 | fpnlim = fnln * ffln |
| 2175 | elseif (jliebig .eq. 1) then |
| 2176 | !! Liebig Law (= most limiting) nutrient limitation |
| 2177 | fpnlim = min(fnln, ffln) |
| 2178 | endif |
| 2179 | fprn = fjln * fpnlim |
| 2180 | |
| 2181 | !!---------------------------------------------------------------------- |
| 2182 | !! Primary production (diatoms) |
| 2183 | !! (note: still needs multiplying by phytoplankton concentration) |
| 2184 | !! |
| 2185 | !! production here is split between nitrogen production and that of |
| 2186 | !! silicon; depending upon the "intracellular" ratio of Si:N, model |
| 2187 | !! diatoms will uptake nitrogen/silicon differentially; this borrows |
| 2188 | !! from the diatom model of Mongin et al. (2006) |
| 2189 | !!---------------------------------------------------------------------- |
| 2190 | !! |
| 2191 | if (jliebig .eq. 0) then |
| 2192 | !! multiplicative nutrient limitation |
| 2193 | fpdlim = fnld * ffld |
| 2194 | elseif (jliebig .eq. 1) then |
| 2195 | !! Liebig Law (= most limiting) nutrient limitation |
| 2196 | fpdlim = min(fnld, ffld) |
| 2197 | endif |
| 2198 | !! |
| 2199 | if (zphd.GT.rsmall .AND. zpds.GT.rsmall) then |
| 2200 | !! "intracellular" elemental ratios |
| 2201 | ! fsin = zpds / (zphd + tiny(zphd)) |
| 2202 | ! fnsi = zphd / (zpds + tiny(zpds)) |
| 2203 | fsin = 0.0 |
| 2204 | IF( zphd .GT. rsmall) fsin = zpds / zphd |
| 2205 | fnsi = 0.0 |
| 2206 | IF( zpds .GT. rsmall) fnsi = zphd / zpds |
| 2207 | !! AXY (23/02/10): these next variables derive from Mongin et al. (2003) |
| 2208 | fsin1 = 3.0 * xsin0 !! = 0.6 |
| 2209 | fnsi1 = 1.0 / fsin1 !! = 1.667 |
| 2210 | fnsi2 = 1.0 / xsin0 !! = 5.0 |
| 2211 | !! |
| 2212 | !! conditionalities based on ratios |
| 2213 | !! nitrogen (and iron and carbon) |
| 2214 | if (fsin.le.xsin0) then |
| 2215 | fprd = 0.0 |
| 2216 | fsld2 = 0.0 |
| 2217 | elseif (fsin.lt.fsin1) then |
| 2218 | fprd = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) * (fjld * fpdlim) |
| 2219 | fsld2 = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) |
| 2220 | elseif (fsin.ge.fsin1) then |
| 2221 | fprd = (fjld * fpdlim) |
| 2222 | fsld2 = 1.0 |
| 2223 | endif |
| 2224 | !! |
| 2225 | !! silicon |
| 2226 | if (fsin.lt.fnsi1) then |
| 2227 | fprds = (fjld * fsld) |
| 2228 | elseif (fsin.lt.fnsi2) then |
| 2229 | fprds = xuif * ((fnsi - xnsi0) / (fnsi + tiny(fnsi))) * (fjld * fsld) |
| 2230 | else |
| 2231 | fprds = 0.0 |
| 2232 | endif |
| 2233 | else |
| 2234 | fsin = 0.0 |
| 2235 | fnsi = 0.0 |
| 2236 | fprd = 0.0 |
| 2237 | fsld2 = 0.0 |
| 2238 | fprds = 0.0 |
| 2239 | endif |
| 2240 | |
| 2241 | # if defined key_debug_medusa |
| 2242 | !! report phytoplankton growth (including diatom silicon submodel) |
| 2243 | if (idf.eq.1.AND.idfval.eq.1) then |
| 2244 | IF (lwp) write (numout,*) '------------------------------' |
| 2245 | IF (lwp) write (numout,*) 'fsin(',jk,') = ', fsin |
| 2246 | IF (lwp) write (numout,*) 'fnsi(',jk,') = ', fnsi |
| 2247 | IF (lwp) write (numout,*) 'fsld2(',jk,') = ', fsld2 |
| 2248 | IF (lwp) write (numout,*) 'fprn(',jk,') = ', fprn |
| 2249 | IF (lwp) write (numout,*) 'fprd(',jk,') = ', fprd |
| 2250 | IF (lwp) write (numout,*) 'fprds(',jk,') = ', fprds |
| 2251 | endif |
| 2252 | # endif |
| 2253 | |
| 2254 | !!---------------------------------------------------------------------- |
| 2255 | !! Mixed layer primary production |
| 2256 | !! this block calculates the amount of primary production that occurs |
| 2257 | !! within the upper mixed layer; this allows the separate diagnosis |
| 2258 | !! of "sub-surface" primary production; it does assume that short- |
| 2259 | !! term variability in mixed layer depth doesn't mess with things |
| 2260 | !! though |
| 2261 | !!---------------------------------------------------------------------- |
| 2262 | !! |
| 2263 | if (fdep1.le.hmld(ji,jj)) then |
| 2264 | !! this level is entirely in the mixed layer |
| 2265 | fq0 = 1.0 |
| 2266 | elseif (fdep.ge.hmld(ji,jj)) then |
| 2267 | !! this level is entirely below the mixed layer |
| 2268 | fq0 = 0.0 |
| 2269 | else |
| 2270 | !! this level straddles the mixed layer |
| 2271 | fq0 = (hmld(ji,jj) - fdep) / fthk |
| 2272 | endif |
| 2273 | !! |
| 2274 | fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn * zphn * fthk * fq0) |
| 2275 | fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd * zphd * fthk * fq0) |
| 2276 | |
| 2277 | !!---------------------------------------------------------------------- |
| 2278 | !! Vertical Integral -- |
| 2279 | !!---------------------------------------------------------------------- |
| 2280 | ftot_pn(ji,jj) = ftot_pn(ji,jj) + (zphn * fthk) !! vertical integral non-diatom phytoplankton |
| 2281 | ftot_pd(ji,jj) = ftot_pd(ji,jj) + (zphd * fthk) !! vertical integral diatom phytoplankton |
| 2282 | ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk) !! vertical integral microzooplankton |
| 2283 | ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk) !! vertical integral mesozooplankton |
| 2284 | ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk) !! vertical integral slow detritus, nitrogen |
| 2285 | ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk) !! vertical integral slow detritus, carbon |
| 2286 | |
| 2287 | !!---------------------------------------------------------------------- |
| 2288 | !! More chlorophyll calculations |
| 2289 | !!---------------------------------------------------------------------- |
| 2290 | !! |
| 2291 | !! frn = (xthetam / fthetan) * (fprn / (fthetan * xpar(ji,jj,jk))) |
| 2292 | !! frd = (xthetam / fthetad) * (fprd / (fthetad * xpar(ji,jj,jk))) |
| 2293 | frn = (xthetam * fchn * fnln * ffln ) / (fthetan + tiny(fthetan)) |
| 2294 | !! AXY (12/05/09): there's potentially a problem here; fsld, silicic acid |
| 2295 | !! limitation, is used in the following line to regulate chlorophyll |
| 2296 | !! growth in a manner that is inconsistent with its use in the regulation |
| 2297 | !! of biomass growth; the Mongin term term used in growth is more complex |
| 2298 | !! than the simple multiplicative function used below |
| 2299 | !! frd = (xthetam * fchd * fnld * ffld * fsld) / (fthetad + tiny(fthetad)) |
| 2300 | !! AXY (12/05/09): this replacement line uses the new variable, fsld2, to |
| 2301 | !! regulate chlorophyll growth |
| 2302 | frd = (xthetamd * fchd * fnld * ffld * fsld2) / (fthetad + tiny(fthetad)) |
| 2303 | |
| 2304 | # if defined key_debug_medusa |
| 2305 | !! report chlorophyll calculations |
| 2306 | if (idf.eq.1.AND.idfval.eq.1) then |
| 2307 | IF (lwp) write (numout,*) '------------------------------' |
| 2308 | IF (lwp) write (numout,*) 'fthetan(',jk,') = ', fthetan |
| 2309 | IF (lwp) write (numout,*) 'fthetad(',jk,') = ', fthetad |
| 2310 | IF (lwp) write (numout,*) 'frn(',jk,') = ', frn |
| 2311 | IF (lwp) write (numout,*) 'frd(',jk,') = ', frd |
| 2312 | endif |
| 2313 | # endif |
| 2314 | |
| 2315 | !!---------------------------------------------------------------------- |
| 2316 | !! Zooplankton Grazing |
| 2317 | !! this code supplements the base grazing model with one that |
| 2318 | !! considers the C:N ratio of grazed food and balances this against |
| 2319 | !! the requirements of zooplankton growth; this model is derived |
| 2320 | !! from that of Anderson & Pondaven (2003) |
| 2321 | !! |
| 2322 | !! the current version of the code assumes a fixed C:N ratio for |
| 2323 | !! detritus (in contrast to Anderson & Pondaven, 2003), though the |
| 2324 | !! full equations are retained for future extension |
| 2325 | !!---------------------------------------------------------------------- |
| 2326 | !! |
| 2327 | !!---------------------------------------------------------------------- |
| 2328 | !! Microzooplankton first |
| 2329 | !!---------------------------------------------------------------------- |
| 2330 | !! |
| 2331 | fmi1 = (xkmi * xkmi) + (xpmipn * zphn * zphn) + (xpmid * zdet * zdet) |
| 2332 | fmi = xgmi * zzmi / fmi1 |
| 2333 | fgmipn = fmi * xpmipn * zphn * zphn !! grazing on non-diatoms |
| 2334 | fgmid = fmi * xpmid * zdet * zdet !! grazing on detrital nitrogen |
2254 | | fmeresp = (xbetac * ficme) - (xthetazme * fmegrow) |
2255 | | # endif |
2256 | | |
2257 | | fzmi_i(ji,jj) = fzmi_i(ji,jj) + fthk * ( & |
2258 | | fgmipn + fgmid ) |
2259 | | fzmi_o(ji,jj) = fzmi_o(ji,jj) + fthk * ( & |
2260 | | fmigrow + (xphi * (fgmipn + fgmid)) + fmiexcr + ((1.0 - xbetan) * finmi) ) |
2261 | | fzme_i(ji,jj) = fzme_i(ji,jj) + fthk * ( & |
2262 | | fgmepn + fgmepd + fgmezmi + fgmed ) |
2263 | | fzme_o(ji,jj) = fzme_o(ji,jj) + fthk * ( & |
2264 | | fmegrow + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) + fmeexcr + ((1.0 - xbetan) * finme) ) |
2265 | | |
2266 | | !!====================================================================== |
2267 | | !! AXY (07/04/17): possible subroutine block; miscellaneous plankton losses |
2268 | | !!====================================================================== |
2269 | | |
2270 | | !!---------------------------------------------------------------------- |
2271 | | !! Plankton metabolic losses |
2272 | | !! Linear loss processes assumed to be metabolic in origin |
2273 | | !!---------------------------------------------------------------------- |
2274 | | !! |
2275 | | fdpn2 = xmetapn * zphn |
2276 | | fdpd2 = xmetapd * zphd |
2277 | | fdpds2 = xmetapd * zpds |
2278 | | fdzmi2 = xmetazmi * zzmi |
2279 | | fdzme2 = xmetazme * zzme |
2280 | | |
2281 | | !!---------------------------------------------------------------------- |
2282 | | !! Plankton mortality losses |
2283 | | !! EKP (26/02/09): phytoplankton hyperbolic mortality term introduced |
2284 | | !! to improve performance in gyres |
2285 | | !!---------------------------------------------------------------------- |
2286 | | !! |
2287 | | !! non-diatom phytoplankton |
2288 | | if (jmpn.eq.1) fdpn = xmpn * zphn !! linear |
2289 | | if (jmpn.eq.2) fdpn = xmpn * zphn * zphn !! quadratic |
2290 | | if (jmpn.eq.3) fdpn = xmpn * zphn * & !! hyperbolic |
2291 | | (zphn / (xkphn + zphn)) |
2292 | | if (jmpn.eq.4) fdpn = xmpn * zphn * & !! sigmoid |
2293 | | ((zphn * zphn) / (xkphn + (zphn * zphn))) |
2294 | | !! |
2295 | | !! diatom phytoplankton |
2296 | | if (jmpd.eq.1) fdpd = xmpd * zphd !! linear |
2297 | | if (jmpd.eq.2) fdpd = xmpd * zphd * zphd !! quadratic |
2298 | | if (jmpd.eq.3) fdpd = xmpd * zphd * & !! hyperbolic |
2299 | | (zphd / (xkphd + zphd)) |
2300 | | if (jmpd.eq.4) fdpd = xmpd * zphd * & !! sigmoid |
2301 | | ((zphd * zphd) / (xkphd + (zphd * zphd))) |
2302 | | fdpds = fdpd * fsin |
2303 | | !! |
2304 | | !! microzooplankton |
2305 | | if (jmzmi.eq.1) fdzmi = xmzmi * zzmi !! linear |
2306 | | if (jmzmi.eq.2) fdzmi = xmzmi * zzmi * zzmi !! quadratic |
2307 | | if (jmzmi.eq.3) fdzmi = xmzmi * zzmi * & !! hyperbolic |
2308 | | (zzmi / (xkzmi + zzmi)) |
2309 | | if (jmzmi.eq.4) fdzmi = xmzmi * zzmi * & !! sigmoid |
2310 | | ((zzmi * zzmi) / (xkzmi + (zzmi * zzmi))) |
2311 | | !! |
2312 | | !! mesozooplankton |
2313 | | if (jmzme.eq.1) fdzme = xmzme * zzme !! linear |
2314 | | if (jmzme.eq.2) fdzme = xmzme * zzme * zzme !! quadratic |
2315 | | if (jmzme.eq.3) fdzme = xmzme * zzme * & !! hyperbolic |
2316 | | (zzme / (xkzme + zzme)) |
2317 | | if (jmzme.eq.4) fdzme = xmzme * zzme * & !! sigmoid |
2318 | | ((zzme * zzme) / (xkzme + (zzme * zzme))) |
2319 | | |
2320 | | !!====================================================================== |
2321 | | !! AXY (07/04/17): possible subroutine block; detritus processes (fuse with later?) |
2322 | | !!====================================================================== |
2323 | | |
2324 | | !!---------------------------------------------------------------------- |
2325 | | !! Detritus remineralisation |
2326 | | !! Constant or temperature-dependent |
2327 | | !!---------------------------------------------------------------------- |
2328 | | !! |
2329 | | if (jmd.eq.1) then |
2330 | | !! temperature-dependent |
2331 | | fdd = xmd * fun_T * zdet |
| 2428 | fmeresp = (xbetac * ficme) - (xthetazme * fmegrow) |
| 2429 | # endif |
| 2430 | |
| 2431 | # if defined key_debug_medusa |
| 2432 | !! report mesozooplankton grazing |
| 2433 | if (idf.eq.1.AND.idfval.eq.1) then |
| 2434 | IF (lwp) write (numout,*) '------------------------------' |
| 2435 | IF (lwp) write (numout,*) 'fme1(',jk,') = ', fme1 |
| 2436 | IF (lwp) write (numout,*) 'fme(',jk,') = ', fme |
| 2437 | IF (lwp) write (numout,*) 'fgmepn(',jk,') = ', fgmepn |
| 2438 | IF (lwp) write (numout,*) 'fgmepd(',jk,') = ', fgmepd |
| 2439 | IF (lwp) write (numout,*) 'fgmepds(',jk,') = ', fgmepds |
| 2440 | IF (lwp) write (numout,*) 'fgmezmi(',jk,') = ', fgmezmi |
| 2441 | IF (lwp) write (numout,*) 'fgmed(',jk,') = ', fgmed |
| 2442 | IF (lwp) write (numout,*) 'fgmedc(',jk,') = ', fgmedc |
| 2443 | IF (lwp) write (numout,*) 'finme(',jk,') = ', finme |
| 2444 | IF (lwp) write (numout,*) 'ficme(',jk,') = ', ficme |
| 2445 | IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme |
| 2446 | IF (lwp) write (numout,*) 'fmeth(',jk,') = ', fmeth |
| 2447 | IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow |
| 2448 | IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr |
| 2449 | # if defined key_roam |
| 2450 | IF (lwp) write (numout,*) 'fmeresp(',jk,') = ', fmeresp |
| 2451 | # endif |
| 2452 | endif |
| 2453 | # endif |
| 2454 | |
| 2455 | fzmi_i(ji,jj) = fzmi_i(ji,jj) + fthk * ( & |
| 2456 | fgmipn + fgmid ) |
| 2457 | fzmi_o(ji,jj) = fzmi_o(ji,jj) + fthk * ( & |
| 2458 | fmigrow + (xphi * (fgmipn + fgmid)) + fmiexcr + ((1.0 - xbetan) * finmi) ) |
| 2459 | fzme_i(ji,jj) = fzme_i(ji,jj) + fthk * ( & |
| 2460 | fgmepn + fgmepd + fgmezmi + fgmed ) |
| 2461 | fzme_o(ji,jj) = fzme_o(ji,jj) + fthk * ( & |
| 2462 | fmegrow + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) + fmeexcr + ((1.0 - xbetan) * finme) ) |
| 2463 | |
| 2464 | !!---------------------------------------------------------------------- |
| 2465 | !! Plankton metabolic losses |
| 2466 | !! Linear loss processes assumed to be metabolic in origin |
| 2467 | !!---------------------------------------------------------------------- |
| 2468 | !! |
| 2469 | fdpn2 = xmetapn * zphn |
| 2470 | fdpd2 = xmetapd * zphd |
| 2471 | fdpds2 = xmetapd * zpds |
| 2472 | fdzmi2 = xmetazmi * zzmi |
| 2473 | fdzme2 = xmetazme * zzme |
| 2474 | |
| 2475 | !!---------------------------------------------------------------------- |
| 2476 | !! Plankton mortality losses |
| 2477 | !! EKP (26/02/09): phytoplankton hyperbolic mortality term introduced |
| 2478 | !! to improve performance in gyres |
| 2479 | !!---------------------------------------------------------------------- |
| 2480 | !! |
| 2481 | !! non-diatom phytoplankton |
| 2482 | if (jmpn.eq.1) fdpn = xmpn * zphn !! linear |
| 2483 | if (jmpn.eq.2) fdpn = xmpn * zphn * zphn !! quadratic |
| 2484 | if (jmpn.eq.3) fdpn = xmpn * zphn * & !! hyperbolic |
| 2485 | (zphn / (xkphn + zphn)) |
| 2486 | if (jmpn.eq.4) fdpn = xmpn * zphn * & !! sigmoid |
| 2487 | ((zphn * zphn) / (xkphn + (zphn * zphn))) |
| 2488 | !! |
| 2489 | !! diatom phytoplankton |
| 2490 | if (jmpd.eq.1) fdpd = xmpd * zphd !! linear |
| 2491 | if (jmpd.eq.2) fdpd = xmpd * zphd * zphd !! quadratic |
| 2492 | if (jmpd.eq.3) fdpd = xmpd * zphd * & !! hyperbolic |
| 2493 | (zphd / (xkphd + zphd)) |
| 2494 | if (jmpd.eq.4) fdpd = xmpd * zphd * & !! sigmoid |
| 2495 | ((zphd * zphd) / (xkphd + (zphd * zphd))) |
| 2496 | fdpds = fdpd * fsin |
| 2497 | !! |
| 2498 | !! microzooplankton |
| 2499 | if (jmzmi.eq.1) fdzmi = xmzmi * zzmi !! linear |
| 2500 | if (jmzmi.eq.2) fdzmi = xmzmi * zzmi * zzmi !! quadratic |
| 2501 | if (jmzmi.eq.3) fdzmi = xmzmi * zzmi * & !! hyperbolic |
| 2502 | (zzmi / (xkzmi + zzmi)) |
| 2503 | if (jmzmi.eq.4) fdzmi = xmzmi * zzmi * & !! sigmoid |
| 2504 | ((zzmi * zzmi) / (xkzmi + (zzmi * zzmi))) |
| 2505 | !! |
| 2506 | !! mesozooplankton |
| 2507 | if (jmzme.eq.1) fdzme = xmzme * zzme !! linear |
| 2508 | if (jmzme.eq.2) fdzme = xmzme * zzme * zzme !! quadratic |
| 2509 | if (jmzme.eq.3) fdzme = xmzme * zzme * & !! hyperbolic |
| 2510 | (zzme / (xkzme + zzme)) |
| 2511 | if (jmzme.eq.4) fdzme = xmzme * zzme * & !! sigmoid |
| 2512 | ((zzme * zzme) / (xkzme + (zzme * zzme))) |
| 2513 | |
| 2514 | !!---------------------------------------------------------------------- |
| 2515 | !! Detritus remineralisation |
| 2516 | !! Constant or temperature-dependent |
| 2517 | !!---------------------------------------------------------------------- |
| 2518 | !! |
| 2519 | if (jmd.eq.1) then |
| 2520 | !! temperature-dependent |
| 2521 | fdd = xmd * fun_T * zdet |