- Timestamp:
- 2017-05-18T11:14:31+02:00 (7 years ago)
- Location:
- branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90
r8023 r8039 39 39 dms_aran2d, dms_hall, dms_hall2d, & 40 40 dms_simo, dms_simo2d, dms_surf, & 41 dms_surf2d, f_BetaD,&42 f_co2flux, f_co2flux2d, f_co2starair,&41 dms_surf2d, & 42 f_co2flux, f_co2flux2d, & 43 43 f_co2starair_2d, f_co3, & 44 f_dcf, f_dpco2, f_fco2a_2d, f_fco2atm, & 45 f_fco2w, f_fco2w_2d, f_h2co3, & 46 f_hco3, f_henry, f_insitut, f_K0, & 47 f_kw660, f_kw6602d, f_kwco2, f_kwo2, & 48 f_o2flux, f_o2flux2d, & 49 f_o2sat, f_o2sat2d, f_ocndpco2_2d, & 44 f_dcf, f_fco2a_2d, f_fco2w_2d, & 45 f_h2co3, f_hco3, f_henry, & 46 f_kw660, f_kw6602d, & 47 f_o2flux, f_o2flux2d, f_o2sat, & 48 f_o2sat2d, f_ocndpco2_2d, & 50 49 f_ocnk0_2d, f_ocnkwco2_2d, & 51 50 f_ocnrhosw_2d, f_ocnschco2_2d, & 52 f_omarg, f_omcal, f_opres, & 53 f_pco2a2d, f_pco2atm, & 54 f_pco2w, f_pco2w2d, f_ph, f_pp0, & 55 f_pp02d, f_rhosw, & 56 f_schmidtco2, f_TALK, f_TALK2d, & 57 f_TDIC, f_TDIC2d, f_xco2a, f_xco2a_2d, & 58 iters, & 51 f_omarg, f_omcal, & 52 f_pco2a2d, f_pco2atm, f_pco2w, & 53 f_pco2w2d, f_ph, f_pp0, f_pp02d, & 54 f_TALK, f_TALK2d, f_TDIC, f_TDIC2d, & 55 f_xco2a, f_xco2a_2d, & 59 56 zalk, zdic, zoxy, zsal, ztmp, & 60 57 # endif … … 69 66 USE in_out_manager, ONLY: lwp, numout 70 67 USE oce, ONLY: PCO2a_in_cpl 71 USE par_oce, ONLY: jpim1, jpjm1 68 USE par_kind, ONLY: wp 69 USE par_oce, ONLY: jpi, jpim1, jpj, jpjm1 72 70 USE sbc_oce, ONLY: fr_i, lk_oasis, qsr, wndm 73 71 USE sms_medusa, ONLY: jdms, jdms_input, jdms_model, & … … 97 95 INTEGER, INTENT( in ) :: kt 98 96 97 !! Loop variables 98 INTEGER :: ji, jj 99 99 100 # if defined key_roam 100 101 !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s … … 102 103 REAL, PARAMETER :: secs_in_day = 86400.0 !! s / d 103 104 REAL, PARAMETER :: CO2flux_conv = (1.e-6 * weight_CO2_mol) / secs_in_day 105 106 INTEGER :: iters 107 108 !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 109 REAL(wp), DIMENSION(jpi,jpj) :: f_fco2w, f_rhosw 110 REAL(wp), DIMENSION(jpi,jpj) :: f_fco2atm 111 REAL(wp), DIMENSION(jpi,jpj) :: f_schmidtco2, f_kwco2, f_K0 112 REAL(wp), DIMENSION(jpi,jpj) :: f_co2starair, f_dpco2 113 !! Output arguments from mocsy_interface, which aren't used 114 REAL(wp) :: f_BetaD_dum, f_opres_dum 115 REAL(wp) :: f_insitut_dum 116 REAL(wp) :: f_kwo2_dum 104 117 # endif 105 118 106 INTEGER :: ji, jj107 119 108 120 # if defined key_roam … … 171 183 f_h2co3(ji,jj),f_hco3(ji,jj), & 172 184 f_co3(ji,jj),f_omarg(ji,jj), & 173 f_omcal(ji,jj),f_BetaD (ji,jj),&174 f_rhosw(ji,jj),f_opres (ji,jj),&175 f_insitut (ji,jj),f_pco2atm(ji,jj),&185 f_omcal(ji,jj),f_BetaD_dum, & 186 f_rhosw(ji,jj),f_opres_dum, & 187 f_insitut_dum,f_pco2atm(ji,jj), & 176 188 f_fco2atm(ji,jj),f_schmidtco2(ji,jj), & 177 189 f_kwco2(ji,jj),f_K0(ji,jj), & … … 192 204 DO ji = 2,jpim1 193 205 if (tmask(ji,jj,1) == 1) then 194 iters (ji,jj)= 0206 iters = 0 195 207 !! 196 208 !! carbon dioxide (CO2); Jerry Blackford code (ostensibly … … 205 217 f_co2flux(ji,jj),f_TDIC(ji,jj), & 206 218 f_TALK(ji,jj),f_dcf(ji,jj), & 207 f_henry(ji,jj),iters (ji,jj))219 f_henry(ji,jj),iters) 208 220 !! 209 221 !! AXY (09/01/14): removed iteration and NaN checks; these have … … 213 225 !! output warnings are retained here so that 214 226 !! failure position can be determined 215 if (iters (ji,jj).eq. 25) then227 if (iters .eq. 25) then 216 228 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: ITERS WARNING, ', & 217 iters (ji,jj), ' AT (', ji, ', ', jj, ', 1) AT ', kt229 iters, ' AT (', ji, ', ', jj, ', 1) AT ', kt 218 230 endif 219 231 ENDIF … … 244 256 !! AXY (23/06/15): add in some extra MOCSY diagnostics 245 257 f_fco2w(ji,jj) = f_xco2a(ji,jj) 246 f_BetaD(ji,jj) = 1. 258 ! This doesn't seem to be used - marc 16/5/17 259 ! f_BetaD(ji,jj) = 1. 247 260 f_rhosw(ji,jj) = 1.026 248 f_opres(ji,jj) = 0. 249 f_insitut(ji,jj) = ztmp(ji,jj) 261 ! This doesn't seem to be used - marc 16/5/17 262 ! f_opres(ji,jj) = 0. 263 ! f_insitut(ji,jj) = ztmp(ji,jj) 250 264 f_pco2atm(ji,jj) = f_xco2a(ji,jj) 251 265 f_fco2atm(ji,jj) = f_xco2a(ji,jj) … … 271 285 !! AXY (23/06/15): amend input list for oxygen to account 272 286 !! for common gas transfer velocity 273 !! Note that f_kwo2 is an about from the subroutine below,274 !! which doesn't seem to be used - marc 10/4/17275 287 CALL trc_oxy_medusa(ztmp(ji,jj),zsal(ji,jj),f_kw660(ji,jj), & 276 288 f_pp0(ji,jj),zoxy(ji,jj), & 277 f_kwo2 (ji,jj),f_o2flux(ji,jj),&289 f_kwo2_dum,f_o2flux(ji,jj), & 278 290 f_o2sat(ji,jj)) 279 291 !! -
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_mod.F90
r8023 r8039 41 41 REAL(wp) :: b0 42 42 43 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetan,faln,fchn1,fchn 44 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjln,fprn,frn 45 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetad,fald,fchd1,fchd 46 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjld,fprd,frd 47 48 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjlim_pn, fjlim_pd 49 !! AXY (03/02/11): add in Liebig terms 50 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fpnlim, fpdlim 43 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetan,fprn,frn 44 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fthetad,fprd,frd 45 46 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fjlim_pn,fjlim_pd 51 47 !! AXY (16/07/09): add in Eppley curve functionality 52 48 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fun_T,xvpnT,xvpdT … … 67 63 !! 68 64 !! silicon cycle 69 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsin,f nsi,fprds,fsdiss65 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsin,fprds,fsdiss 70 66 71 67 !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme … … 75 71 76 72 !! Microzooplankton grazing 77 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f mi1,fmi,fgmipn,fgmid,fgmidc78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finmi,ficmi ,fstarmi,fmith73 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmipn,fgmid,fgmidc 74 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finmi,ficmi 79 75 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmigrow,fmiexcr,fmiresp 80 76 !! 81 77 !! Mesozooplankton grazing 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f me1,fme,fgmepn,fgmepd78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepn,fgmepd 83 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fgmepds,fgmezmi,fgmed,fgmedc 84 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finme,ficme ,fstarme,fmeth80 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: finme,ficme 85 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fmegrow,fmeexcr,fmeresp 86 82 !! … … 100 96 101 97 !! Particle flux 102 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdep1 ,fcaco398 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdep1 103 99 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempn,ftempsi,ftempfe 104 100 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ftempc,ftempca … … 107 103 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastn,ffastsi,ffastfe 108 104 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ffastc,ffastca 109 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprotf110 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fsedn,fsedsi,fsedfe,fsedc,fsedca 111 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fccd 112 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fccd_dep113 107 114 108 !! AXY (08/07/11): fate of fast detritus reaching the seafloor … … 157 151 158 152 !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 159 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_fco2w,f_BetaD,f_rhosw,f_opres 160 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_insitut,f_pco2atm,f_fco2atm 161 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_schmidtco2,f_kwco2,f_K0 162 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_co2starair,f_dpco2,f_kwo2 163 164 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iters 153 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: f_pco2atm 165 154 166 155 !! Carbon, alkalinity production and consumption … … 292 281 zpho(jpi,jpj), & 293 282 # endif 294 fthetan(jpi,jpj),faln(jpi,jpj),fchn1(jpi,jpj), & 295 fchn(jpi,jpj),fjln(jpi,jpj),fprn(jpi,jpj), & 296 frn(jpi,jpj), & 297 fthetad(jpi,jpj),fald(jpi,jpj),fchd1(jpi,jpj), & 298 fchd(jpi,jpj),fjld(jpi,jpj),fprd(jpi,jpj), & 299 frd(jpi,jpj), & 300 fjlim_pn(jpi,jpj), fjlim_pd(jpi,jpj), & 301 fpnlim(jpi,jpj), fpdlim(jpi,jpj), & 302 fun_T(jpi,jpj),xvpnT(jpi,jpj),xvpdT(jpi,jpj), & 303 fun_Q10(jpi,jpj), & 283 fthetan(jpi,jpj),fprn(jpi,jpj),frn(jpi,jpj), & 284 fthetad(jpi,jpj),fprd(jpi,jpj),frd(jpi,jpj), & 285 fjlim_pn(jpi,jpj),fjlim_pd(jpi,jpj), & 286 fun_T(jpi,jpj),fun_Q10(jpi,jpj), & 304 287 fprn_ml(jpi,jpj),fprd_ml(jpi,jpj), & 305 288 fnln(jpi,jpj),ffln2(jpi,jpj), & 306 289 fnld(jpi,jpj),ffld(jpi,jpj),fsld(jpi,jpj), & 307 290 fsld2(jpi,jpj), & 308 fsin(jpi,jpj),fnsi(jpi,jpj),fprds(jpi,jpj), & 309 fsdiss(jpi,jpj), & 291 fsin(jpi,jpj),fprds(jpi,jpj),fsdiss(jpi,jpj), & 310 292 ffetop(jpi,jpj),ffebot(jpi,jpj),ffescav(jpi,jpj), & 311 293 xFree(jpi,jpj), & 312 fmi1(jpi,jpj),fmi(jpi,jpj),fgmipn(jpi,jpj), & 313 fgmid(jpi,jpj),fgmidc(jpi,jpj), & 314 finmi(jpi,jpj),ficmi(jpi,jpj),fstarmi(jpi,jpj), & 315 fmith(jpi,jpj),fmigrow(jpi,jpj),fmiexcr(jpi,jpj), & 316 fmiresp(jpi,jpj), & 317 fme1(jpi,jpj),fme(jpi,jpj),fgmepn(jpi,jpj), & 318 fgmepd(jpi,jpj),fgmepds(jpi,jpj),fgmezmi(jpi,jpj), & 319 fgmed(jpi,jpj),fgmedc(jpi,jpj), & 320 finme(jpi,jpj),ficme(jpi,jpj),fstarme(jpi,jpj), & 321 fmeth(jpi,jpj),fmegrow(jpi,jpj),fmeexcr(jpi,jpj), & 322 fmeresp(jpi,jpj), & 294 fgmipn(jpi,jpj),fgmid(jpi,jpj),fgmidc(jpi,jpj), & 295 finmi(jpi,jpj),ficmi(jpi,jpj), & 296 fmigrow(jpi,jpj),fmiexcr(jpi,jpj),fmiresp(jpi,jpj), & 297 fgmepn(jpi,jpj),fgmepd(jpi,jpj), & 298 fgmepds(jpi,jpj),fgmezmi(jpi,jpj),fgmed(jpi,jpj), & 299 fgmedc(jpi,jpj), & 300 finme(jpi,jpj),ficme(jpi,jpj), & 301 fmegrow(jpi,jpj),fmeexcr(jpi,jpj),fmeresp(jpi,jpj), & 323 302 fdpn(jpi,jpj),fdpd(jpi,jpj),fdpds(jpi,jpj), & 324 303 fdzmi(jpi,jpj),fdzme(jpi,jpj),fdd(jpi,jpj), & … … 335 314 fregenfastc(jpi,jpj), & 336 315 # endif 337 fdep1(jpi,jpj), fcaco3(jpi,jpj),&316 fdep1(jpi,jpj), & 338 317 ftempn(jpi,jpj),ftempsi(jpi,jpj),ftempfe(jpi,jpj), & 339 318 ftempc(jpi,jpj),ftempca(jpi,jpj), & … … 342 321 ffastn(jpi,jpj),ffastsi(jpi,jpj),ffastfe(jpi,jpj), & 343 322 ffastc(jpi,jpj),ffastca(jpi,jpj), & 344 fprotf(jpi,jpj), &345 323 fsedn(jpi,jpj),fsedsi(jpi,jpj),fsedfe(jpi,jpj), & 346 324 fsedc(jpi,jpj),fsedca(jpi,jpj), & 347 325 fccd(jpi,jpj), & 348 fccd_dep(jpi,jpj), &349 326 ffast2slown(jpi,jpj),ffast2slowc(jpi,jpj), & 350 327 ftot_n(jpi,jpj),ftot_si(jpi,jpj),ftot_fe(jpi,jpj), & … … 377 354 f_kw660(jpi,jpj),f_o2flux(jpi,jpj),f_o2sat(jpi,jpj), & 378 355 f_omcal(jpi,jpj),f_omarg(jpi,jpj), & 379 f_fco2w(jpi,jpj),f_BetaD(jpi,jpj),f_rhosw(jpi,jpj), & 380 f_opres(jpi,jpj),f_insitut(jpi,jpj), & 381 f_pco2atm(jpi,jpj),f_fco2atm(jpi,jpj), & 382 f_schmidtco2(jpi,jpj),f_kwco2(jpi,jpj),f_K0(jpi,jpj), & 383 f_co2starair(jpi,jpj),f_dpco2(jpi,jpj), & 384 f_kwo2(jpi,jpj), & 385 iters(jpi,jpj), & 356 f_pco2atm(jpi,jpj), & 386 357 fcomm_resp(jpi,jpj), & 387 358 fcar_prod(jpi,jpj),fcar_cons(jpi,jpj), & -
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/carb_chem.F90
r8023 r8039 31 31 !! - ... 32 32 !!---------------------------------------------------------------------- 33 USE bio_medusa_mod, ONLY: iters, f_BetaD, f_co2flux, & 34 f_co2starair, f_co3, f_dcf, f_dpco2, & 35 f_fco2atm, f_fco2w, f_h2co3, f_hco3, & 36 f_henry, & 37 f_insitut, f_K0, f_kw660, f_kwco2, & 38 f_omarg, f_omcal, f_opres, f_pco2atm, & 39 f_pco2w, f_ph, f_pp0, f_rhosw, & 40 f_schmidtco2, f_TALK, f_TDIC, f_xco2a, & 33 USE bio_medusa_mod, ONLY: f_co2flux, f_co3, f_dcf, & 34 f_h2co3, f_hco3, f_henry, & 35 f_kw660, f_omarg, f_omcal, & 36 f_pco2atm, f_pco2w, f_ph, f_pp0, & 37 f_TALK, f_TDIC, f_xco2a, & 41 38 # if defined key_mocsy 42 39 zpho, & … … 72 69 INTEGER, DIMENSION(jpi,jpj) :: i2_omcal,i2_omarg 73 70 71 !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 72 REAL(wp) :: f_rhosw 73 !! Output arguments from mocsy_interface, which aren't used 74 REAL(wp) :: f_fco2w_dum, f_BetaD_dum, f_opres_dum 75 REAL(wp) :: f_insitut_dum, f_fco2atm_dum 76 REAL(wp) :: f_schmidtco2_dum, f_kwco2_dum, f_K0_dum 77 REAL(wp) :: f_co2starair_dum, f_dpco2_dum 74 78 !! temporary variables 75 79 REAL(wp) :: fq0,fq1,fq2,fq3,fq4 76 80 81 INTEGER :: iters 82 !! Loop variables 77 83 INTEGER :: ji, jj, jk 78 84 … … 155 161 gphit(ji,jj),f_kw660(ji,jj), & 156 162 f_xco2a(ji,jj),1,f_ph(ji,jj), & 157 f_pco2w(ji,jj),f_fco2w (ji,jj),&163 f_pco2w(ji,jj),f_fco2w_dum, & 158 164 f_h2co3(ji,jj),f_hco3(ji,jj), & 159 165 f_co3(ji,jj),f_omarg(ji,jj), & 160 f_omcal(ji,jj),f_BetaD (ji,jj),&161 f_rhosw (ji,jj),f_opres(ji,jj),&162 f_insitut (ji,jj),f_pco2atm(ji,jj),&163 f_fco2atm (ji,jj),f_schmidtco2(ji,jj),&164 f_kwco2 (ji,jj),f_K0(ji,jj),&165 f_co2starair (ji,jj),f_co2flux(ji,jj),&166 f_dpco2 (ji,jj))166 f_omcal(ji,jj),f_BetaD_dum, & 167 f_rhosw,f_opres_dum, & 168 f_insitut_dum,f_pco2atm(ji,jj), & 169 f_fco2atm_dum,f_schmidtco2_dum, & 170 f_kwco2_dum,f_K0_dum, & 171 f_co2starair_dum,f_co2flux(ji,jj), & 172 f_dpco2_dum) 167 173 !! 168 174 !! mmol / m3 -> umol / kg 169 f_TDIC(ji,jj) = (zdic(ji,jj) / f_rhosw (ji,jj)) * 1000.175 f_TDIC(ji,jj) = (zdic(ji,jj) / f_rhosw) * 1000. 170 176 !! meq / m3 -> ueq / kg 171 f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw (ji,jj)) * 1000.172 f_dcf(ji,jj) = f_rhosw (ji,jj)177 f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw) * 1000. 178 f_dcf(ji,jj) = f_rhosw 173 179 # else 174 180 !! AXY (22/06/15): use old PML carbonate chemistry … … 183 189 f_co2flux(ji,jj),f_TDIC(ji,jj), & 184 190 f_TALK(ji,jj),f_dcf(ji,jj), & 185 f_henry(ji,jj),iters (ji,jj))191 f_henry(ji,jj),iters) 186 192 !! 187 193 !! AXY (28/02/14): check output fields 188 IF (iters (ji,jj).eq. 25) THEN194 IF (iters .eq. 25) THEN 189 195 IF(lwp) WRITE(numout,*) & 190 ' carb_chem: 3D ITERS WARNING, ', & 191 iters(ji,jj), ' AT (', ji, ', ', jj, ', ', & 192 jk, ') AT ', kt 196 ' carb_chem: 3D ITERS WARNING, ', iters, ' AT (', & 197 ji, ', ', jj, ', ', jk, ') AT ', kt 193 198 ENDIF 194 199 # endif -
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus_fast_sink.F90
r8023 r8039 35 35 f_benout_si, & 36 36 f_fbenin_c, f_fbenin_ca, f_fbenin_fe, & 37 f_fbenin_n, f_fbenin_si, & 38 f_omcal, fcaco3, & 39 fccd, fccd_dep, fdep1, fdd, & 37 f_fbenin_n, f_fbenin_si, f_omcal, & 38 fccd, fdep1, fdd, & 40 39 fdpd, fdpd2, fdpds, fdpds2, & 41 40 fdpn, fdpn2, & … … 52 51 fmeexcr, fmiexcr, & 53 52 fofd_fe, fofd_n, fofd_si, & 54 fprotf, &55 53 fregen, fregenfast, fregenfastsi, & 56 54 fregensi, & … … 73 71 USE oce, ONLY: tsn 74 72 USE par_kind, ONLY: wp 75 USE par_oce, ONLY: jpi m1, jpjm173 USE par_oce, ONLY: jpi, jpim1, jpj, jpjm1 76 74 USE sms_medusa, ONLY: f2_ccd_cal, f3_omcal, & 77 75 jexport, jfdfate, jinorgben, jocalccd, & … … 102 100 INTEGER :: ji, jj 103 101 104 REAL(wp) :: fb_val, fl_sst 102 REAL(wp) :: fb_val, fl_sst 103 !! Particle flux 104 REAL(wp) :: fcaco3 105 REAL(wp) :: fprotf 106 REAL(wp), DIMENSION(jpi,jpj) :: fccd_dep 105 107 !! temporary variables 106 108 REAL(wp) :: fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8 … … 236 238 !! primary production 237 239 !! 0.10 at equator; 0.02 at pole 238 fcaco3(ji,jj) = xcaco3a + ((xcaco3b - xcaco3a) * & 239 ((90.0 - abs(gphit(ji,jj))) / & 240 90.0)) 240 fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) * & 241 ((90.0 - abs(gphit(ji,jj))) / 90.0)) 241 242 elseif (jrratio.eq.1) then 242 243 !! CaCO3: Ridgwell et al. (2007) submodel, version 1 … … 248 249 fq1 = 0. 249 250 endif 250 fcaco3 (ji,jj)= xridg_r0 * fq1251 fcaco3 = xridg_r0 * fq1 251 252 elseif (jrratio.eq.2) then 252 253 !! CaCO3: Ridgwell et al. (2007) submodel, version 2 … … 258 259 fq1 = 0. 259 260 endif 260 fcaco3 (ji,jj)= xridg_r0 * fq1261 fcaco3 = xridg_r0 * fq1 261 262 endif 262 ENDIF263 ENDDO264 ENDDO265 263 # else 266 DO jj = 2,jpjm1267 DO ji = 2,jpim1268 if (tmask(ji,jj,jk) == 1) then269 264 !! CaCO3: latitudinally-based fraction of total primary 270 265 !! production 271 266 !! 0.10 at equator; 0.02 at pole 272 fcaco3(ji,jj) = xcaco3a + ((xcaco3b - xcaco3a) * & 273 ((90.0 - abs(gphit(ji,jj))) / 90.0)) 274 ENDIF 275 ENDDO 276 ENDDO 267 fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) * & 268 ((90.0 - abs(gphit(ji,jj))) / 90.0)) 277 269 # endif 278 279 DO jj = 2,jpjm1280 DO ji = 2,jpim1281 if (tmask(ji,jj,jk) == 1) then282 270 !! AXY (09/03/09): convert CaCO3 production from function of 283 271 !! primary production into a function of fast-sinking material; … … 286 274 !! chlorophyll to an export flux for which they apply conversion 287 275 !! factors to estimate the various elemental fractions (Si, Ca) 288 ftempca(ji,jj) = ftempc(ji,jj) * fcaco3 (ji,jj)276 ftempca(ji,jj) = ftempc(ji,jj) * fcaco3 289 277 290 278 # if defined key_debug_medusa … … 316 304 IF (lwp) write (numout,*) 'flat(',jk,') = ', & 317 305 abs(gphit(ji,jj)) 318 IF (lwp) write (numout,*) 'fcaco3(',jk,') = ', fcaco3 (ji,jj)306 IF (lwp) write (numout,*) 'fcaco3(',jk,') = ', fcaco3 319 307 endif 320 308 # endif … … 428 416 if (fq4.lt.fq1) then 429 417 !! protected fraction of total organic C (non-dim) 430 fprotf (ji,jj)= (fq4 / (fq1 + tiny(fq1)))418 fprotf = (fq4 / (fq1 + tiny(fq1))) 431 419 else 432 420 !! all organic C is protected (non-dim) 433 fprotf (ji,jj)= 1.0421 fprotf = 1.0 434 422 endif 435 423 !! unprotected fraction of total organic C (non-dim) 436 fq5 = (1.0 - fprotf (ji,jj))424 fq5 = (1.0 - fprotf) 437 425 !! how much organic C is unprotected (mol) 438 426 fq6 = (fq0 * fq5) … … 440 428 fq7 = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc))) 441 429 !! how much total C leaves this box (mol) 442 fq8 = (fq7 + (fq0 * fprotf (ji,jj)))430 fq8 = (fq7 + (fq0 * fprotf)) 443 431 !! C remineralisation in this box (mol) 444 432 freminc(ji,jj) = (fq0 - fq8) / fse3t(ji,jj,jk) … … 454 442 fq4 455 443 IF (lwp) write (numout,*) 'fprotf(',jk,') = ', & 456 fprotf (ji,jj)444 fprotf 457 445 IF (lwp) write (numout,*) & 458 446 '------------------------------' … … 480 468 if (iball.eq.1) then 481 469 !! unprotected fraction of total organic N (non-dim) 482 fq5 = (1.0 - fprotf (ji,jj))470 fq5 = (1.0 - fprotf) 483 471 !! how much organic N is unprotected (mol) 484 472 fq6 = (fq0 * fq5) … … 486 474 fq7 = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc))) 487 475 !! how much total N leaves this box (mol) 488 fq8 = (fq7 + (fq0 * fprotf (ji,jj)))476 fq8 = (fq7 + (fq0 * fprotf)) 489 477 !! N remineralisation in this box (mol) 490 478 freminn(ji,jj) = (fq0 - fq8) / fse3t(ji,jj,jk) … … 498 486 IF (lwp) write (numout,*) 'prtctN(',jk,') = ', fq4 499 487 IF (lwp) write (numout,*) 'fprotf(',jk,') = ', & 500 fprotf (ji,jj)488 fprotf 501 489 IF (lwp) write (numout,*) & 502 490 '------------------------------' … … 525 513 if (iball.eq.1) then 526 514 !! unprotected fraction of total organic Fe (non-dim) 527 fq5 = (1.0 - fprotf (ji,jj))515 fq5 = (1.0 - fprotf) 528 516 !! how much organic Fe is unprotected (mol) 529 517 fq6 = (fq0 * fq5) … … 531 519 fq7 = (fq6 * exp(-(fse3t(ji,jj,jk) / xfastc))) 532 520 !! how much total Fe leaves this box (mol) 533 fq8 = (fq7 + (fq0 * fprotf (ji,jj)))521 fq8 = (fq7 + (fq0 * fprotf)) 534 522 !! Fe remineralisation in this box (mol) 535 523 freminfe(ji,jj) = (fq0 - fq8) / fse3t(ji,jj,jk) -
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/phytoplankton.F90
r7975 r8039 31 31 !! growth. 32 32 !!---------------------------------------------------------------------- 33 USE bio_medusa_mod, ONLY: fald, faln, fchd, fchd1, fchn, fchn1, & 34 fdep1, ffld, ffln2, fjld, fjln, & 35 fjlim_pd, fjlim_pn, fjln, & 36 fnld, fnln, fnsi, & 37 fpdlim, fpnlim, fprd, fprd_ml, fprds, & 33 USE bio_medusa_mod, ONLY: fdep1, ffld, ffln2, & 34 fjlim_pd, fjlim_pn, & 35 fnld, fnln, & 36 fprd, fprd_ml, fprds, & 38 37 fprn, fprn_ml, frd, frn, & 39 38 fsin, fsld, fsld2, fthetad, fthetan, & … … 41 40 ftot_pn, ftot_zme, ftot_zmi, & 42 41 fun_Q10, fun_T, idf, idfval, & 43 xvpdT, xvpnT, &44 42 zchd, zchn, zdet, zdin, zdtc, & 45 43 zfer, zpds, zphd, zphn, zsil, & … … 49 47 USE oce, ONLY: tsn 50 48 USE par_kind, ONLY: wp 51 USE par_oce, ONLY: jp_tem, jpi m1, jpjm149 USE par_oce, ONLY: jp_tem, jpi, jpim1, jpj, jpjm1 52 50 USE phycst, ONLY: rsmall 53 51 USE sms_medusa, ONLY: jliebig, jphy, jq10, & … … 66 64 INTEGER :: ji, jj 67 65 68 REAL(wp) :: fsin1,fnsi1,fnsi2 69 REAL(wp) :: fq0 66 REAL(wp), DIMENSION(jpi,jpj) :: faln, fchn, fjln 67 REAL(wp), DIMENSION(jpi,jpj) :: fald, fchd, fjld 68 REAL(wp) :: fchn1, fchd1 69 !! AXY (03/02/11): add in Liebig terms 70 REAL(wp) :: fpnlim, fpdlim 71 !! AXY (16/07/09): add in Eppley curve functionality 72 REAL(wp) :: xvpnT,xvpdT 73 !! silicon cycle 74 REAL(wp) :: fnsi 75 76 REAL(wp) :: fsin1, fnsi1, fnsi2 77 REAL(wp) :: fq0 70 78 71 79 DO jj = 2,jpjm1 … … 137 145 fun_Q10(ji,jj) = jq10**((tsn(ji,jj,jk,jp_tem) - 0.0) / 10.0) 138 146 if (jphy.eq.1) then 139 xvpnT (ji,jj)= xvpn * fun_T(ji,jj)140 xvpdT (ji,jj)= xvpd * fun_T(ji,jj)147 xvpnT = xvpn * fun_T(ji,jj) 148 xvpdT = xvpd * fun_T(ji,jj) 141 149 elseif (jphy.eq.2) then 142 xvpnT(ji,jj) = xvpn * fun_Q10(ji,jj) 143 xvpdT(ji,jj) = xvpd * fun_Q10(ji,jj) 144 else 145 xvpnT(ji,jj) = xvpn 146 xvpdT(ji,jj) = xvpd 147 endif 148 ENDIF 149 ENDDO 150 ENDDO 151 152 DO jj = 2,jpjm1 153 DO ji = 2,jpim1 154 if (tmask(ji,jj,1) == 1) then 150 xvpnT = xvpn * fun_Q10(ji,jj) 151 xvpdT = xvpd * fun_Q10(ji,jj) 152 else 153 xvpnT = xvpn 154 xvpdT = xvpd 155 endif 155 156 !! 156 157 !! non-diatoms 157 fchn1(ji,jj) = (xvpnT(ji,jj) * xvpnT(ji,jj)) + & 158 (faln(ji,jj) * faln(ji,jj) * & 159 xpar(ji,jj,jk) * xpar(ji,jj,jk)) 160 if (fchn1(ji,jj).GT.rsmall) then 161 fchn(ji,jj) = xvpnT(ji,jj) / (sqrt(fchn1(ji,jj)) + & 162 tiny(fchn1(ji,jj))) 163 else 164 fchn(ji,jj) = 0. 158 fchn1 = (xvpnT * xvpnT) + & 159 (faln(ji,jj) * faln(ji,jj) * xpar(ji,jj,jk) * & 160 xpar(ji,jj,jk)) 161 if (fchn1.GT.rsmall) then 162 fchn(ji,jj) = xvpnT / (sqrt(fchn1) + tiny(fchn1)) 163 else 164 fchn(ji,jj) = 0. 165 165 endif 166 166 !! non-diatom J term 167 167 fjln(ji,jj) = fchn(ji,jj) * faln(ji,jj) * xpar(ji,jj,jk) 168 fjlim_pn(ji,jj) = fjln(ji,jj) / xvpnT(ji,jj) 169 ENDIF 170 ENDDO 171 ENDDO 172 173 DO jj = 2,jpjm1 174 DO ji = 2,jpim1 175 if (tmask(ji,jj,1) == 1) then 168 fjlim_pn(ji,jj) = fjln(ji,jj) / xvpnT 176 169 !! 177 170 !! diatoms 178 fchd1(ji,jj) = (xvpdT(ji,jj) * xvpdT(ji,jj)) + & 179 (fald(ji,jj) * fald(ji,jj) * & 180 xpar(ji,jj,jk) * xpar(ji,jj,jk)) 181 if (fchd1(ji,jj).GT.rsmall) then 182 fchd(ji,jj) = xvpdT(ji,jj) / (sqrt(fchd1(ji,jj)) + & 183 tiny(fchd1(ji,jj))) 184 else 185 fchd(ji,jj) = 0. 171 fchd1 = (xvpdT * xvpdT) + & 172 (fald(ji,jj) * fald(ji,jj) * xpar(ji,jj,jk) * & 173 xpar(ji,jj,jk)) 174 if (fchd1.GT.rsmall) then 175 fchd(ji,jj) = xvpdT / (sqrt(fchd1) + tiny(fchd1)) 176 else 177 fchd(ji,jj) = 0. 186 178 endif 187 179 !! diatom J term 188 180 fjld(ji,jj) = fchd(ji,jj) * fald(ji,jj) * xpar(ji,jj,jk) 189 fjlim_pd(ji,jj) = fjld(ji,jj) / xvpdT (ji,jj)181 fjlim_pd(ji,jj) = fjld(ji,jj) / xvpdT 190 182 191 183 # if defined key_debug_medusa … … 250 242 if (jliebig .eq. 0) then 251 243 !! multiplicative nutrient limitation 252 fpnlim (ji,jj)= fnln(ji,jj) * ffln2(ji,jj)244 fpnlim = fnln(ji,jj) * ffln2(ji,jj) 253 245 elseif (jliebig .eq. 1) then 254 246 !! Liebig Law (= most limiting) nutrient limitation 255 fpnlim (ji,jj)= min(fnln(ji,jj), ffln2(ji,jj))256 endif 257 fprn(ji,jj) = fjln(ji,jj) * fpnlim (ji,jj)247 fpnlim = min(fnln(ji,jj), ffln2(ji,jj)) 248 endif 249 fprn(ji,jj) = fjln(ji,jj) * fpnlim 258 250 ENDIF 259 251 ENDDO … … 277 269 if (jliebig .eq. 0) then 278 270 !! multiplicative nutrient limitation 279 fpdlim (ji,jj)= fnld(ji,jj) * ffld(ji,jj)271 fpdlim = fnld(ji,jj) * ffld(ji,jj) 280 272 elseif (jliebig .eq. 1) then 281 273 !! Liebig Law (= most limiting) nutrient limitation 282 fpdlim (ji,jj)= min(fnld(ji,jj), ffld(ji,jj))274 fpdlim = min(fnld(ji,jj), ffld(ji,jj)) 283 275 endif 284 276 !! … … 287 279 ! fsin(ji,jj) = zpds(ji,jj) / (zphd(ji,jj) + & 288 280 ! tiny(zphd(ji,jj))) 289 ! fnsi (ji,jj)= zphd(ji,jj) / (zpds(ji,jj) + &281 ! fnsi = zphd(ji,jj) / (zpds(ji,jj) + & 290 282 ! tiny(zpds(ji,jj))) 291 283 fsin(ji,jj) = 0.0 292 284 IF( zphd(ji,jj) .GT. rsmall) fsin(ji,jj) = zpds(ji,jj) / & 293 285 zphd(ji,jj) 294 fnsi (ji,jj)= 0.0295 IF( zpds(ji,jj) .GT. rsmall) fnsi (ji,jj) = zphd(ji,jj) /&296 286 fnsi = 0.0 287 IF( zpds(ji,jj) .GT. rsmall) fnsi = zphd(ji,jj) / & 288 zpds(ji,jj) 297 289 !! AXY (23/02/10): these next variables derive from 298 290 !! Mongin et al. (2003) … … 310 302 (fsin(ji,jj) + & 311 303 tiny(fsin(ji,jj)))) * & 312 (fjld(ji,jj) * fpdlim (ji,jj))304 (fjld(ji,jj) * fpdlim) 313 305 fsld2(ji,jj) = xuif * ((fsin(ji,jj) - xsin0) / & 314 306 (fsin(ji,jj) + & 315 307 tiny(fsin(ji,jj)))) 316 308 elseif (fsin(ji,jj).ge.fsin1) then 317 fprd(ji,jj) = (fjld(ji,jj) * fpdlim (ji,jj))309 fprd(ji,jj) = (fjld(ji,jj) * fpdlim) 318 310 fsld2(ji,jj) = 1.0 319 311 endif … … 323 315 fprds(ji,jj) = (fjld(ji,jj) * fsld(ji,jj)) 324 316 elseif (fsin(ji,jj).lt.fnsi2) then 325 fprds(ji,jj) = xuif * ((fnsi(ji,jj) - xnsi0) / & 326 (fnsi(ji,jj) + & 327 tiny(fnsi(ji,jj)))) * & 317 fprds(ji,jj) = xuif * ((fnsi - xnsi0) / & 318 (fnsi + tiny(fnsi))) * & 328 319 (fjld(ji,jj) * fsld(ji,jj)) 329 320 else … … 332 323 else 333 324 fsin(ji,jj) = 0.0 334 fnsi (ji,jj)= 0.0325 fnsi = 0.0 335 326 fprd(ji,jj) = 0.0 336 327 fsld2(ji,jj) = 0.0 … … 344 335 IF (lwp) write (numout,*) '------------------------------' 345 336 IF (lwp) write (numout,*) 'fsin(',jk,') = ', fsin(ji,jj) 346 IF (lwp) write (numout,*) 'fnsi(',jk,') = ', fnsi (ji,jj)337 IF (lwp) write (numout,*) 'fnsi(',jk,') = ', fnsi 347 338 IF (lwp) write (numout,*) 'fsld2(',jk,') = ', fsld2(ji,jj) 348 339 IF (lwp) write (numout,*) 'fprn(',jk,') = ', fprn(ji,jj) -
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/zooplankton.F90
r7975 r8039 35 35 fgmid, fgmidc, fgmipn, & 36 36 ficme, ficmi, finme, finmi, & 37 fme, fme1, fmeexcr, fmegrow, & 38 fmeresp, fmeth, & 39 fmi, fmi1, fmiexcr, fmigrow, & 40 fmiresp, fmith, & 41 fsin, fstarme, fstarmi, & 37 fmeexcr, fmegrow, fmeresp, & 38 fmiexcr, fmigrow, fmiresp, & 39 fsin, & 42 40 fzme_i, fzme_o, fzmi_i, fzmi_o, & 43 41 idf, idfval, & 44 42 zdet, zdtc, zphd, zphn, zzme, zzmi 45 43 USE dom_oce, ONLY: e3t_0, e3t_n, tmask 44 USE par_kind, ONLY: wp 46 45 USE par_oce, ONLY: jpim1, jpjm1 47 46 USE phycst, ONLY: rsmall … … 61 60 INTEGER :: ji, jj 62 61 62 !! Microzooplankton grazing 63 REAL(wp) :: fmi1, fmi 64 REAL(wp) :: fstarmi, fmith 65 !! 66 !! Mesozooplankton grazing 67 REAL(wp) :: fme1, fme 68 REAL(wp) :: fstarme, fmeth 69 63 70 DO jj = 2,jpjm1 64 71 DO ji = 2,jpim1 … … 82 89 !!---------------------------------------------------------- 83 90 !! 84 fmi1 (ji,jj)= (xkmi * xkmi) + (xpmipn * zphn(ji,jj) * &91 fmi1 = (xkmi * xkmi) + (xpmipn * zphn(ji,jj) * & 85 92 zphn(ji,jj)) + & 86 93 (xpmid * zdet(ji,jj) * zdet(ji,jj)) 87 fmi (ji,jj) = xgmi * zzmi(ji,jj) / fmi1(ji,jj)94 fmi = xgmi * zzmi(ji,jj) / fmi1 88 95 !! grazing on non-diatoms 89 fgmipn(ji,jj) = fmi(ji,jj) * xpmipn * zphn(ji,jj) * & 90 zphn(ji,jj) 96 fgmipn(ji,jj) = fmi * xpmipn * zphn(ji,jj) * zphn(ji,jj) 91 97 !! grazing on detrital nitrogen 92 fgmid(ji,jj) = fmi(ji,jj) * xpmid * zdet(ji,jj) * & 93 zdet(ji,jj) 98 fgmid(ji,jj) = fmi * xpmid * zdet(ji,jj) * zdet(ji,jj) 94 99 # if defined key_roam 95 100 ! acc … … 104 109 fgmidc(ji,jj) = xthetad * fgmid(ji,jj) 105 110 # endif 111 # if defined key_debug_medusa 112 !! report microzooplankton grazing 113 if (idf.eq.1.AND.idfval.eq.1) then 114 IF (lwp) write (numout,*) '------------------------------' 115 IF (lwp) write (numout,*) 'fmi1(',jk,') = ', fmi1 116 endif 117 # endif 106 118 ENDIF 107 119 ENDDO … … 119 131 !! the ideal food C:N ratio for microzooplankton 120 132 !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 121 fstarmi (ji,jj)= (xbetan * xthetazmi) / (xbetac * xkc)133 fstarmi = (xbetan * xthetazmi) / (xbetac * xkc) 122 134 !! 123 135 !! process these to determine proportioning of grazed N and C 124 136 !! (since there is no explicit consideration of respiration, 125 137 !! only growth and excretion are calculated here) 126 fmith(ji,jj) = (ficmi(ji,jj) / (finmi(ji,jj) + & 127 tiny(finmi(ji,jj)))) 128 if (fmith(ji,jj).ge.fstarmi(ji,jj)) then 138 fmith = (ficmi(ji,jj) / (finmi(ji,jj) + tiny(finmi(ji,jj)))) 139 if (fmith.ge.fstarmi) then 129 140 fmigrow(ji,jj) = xbetan * finmi(ji,jj) 130 141 fmiexcr(ji,jj) = 0.0 … … 132 143 fmigrow(ji,jj) = (xbetac * xkc * ficmi(ji,jj)) / xthetazmi 133 144 fmiexcr(ji,jj) = ficmi(ji,jj) * & 134 ((xbetan / (fmith(ji,jj) + & 135 tiny(fmith(ji,jj)))) - & 145 ((xbetan / (fmith + tiny(fmith))) - & 136 146 ((xbetac * xkc) / xthetazmi)) 137 147 endif … … 145 155 if (idf.eq.1.AND.idfval.eq.1) then 146 156 IF (lwp) write (numout,*) '------------------------------' 147 IF (lwp) write (numout,*) 'fmi1(',jk,') = ', fmi1(ji,jj)148 IF (lwp) write (numout,*) 'fmi(',jk,') = ', fmi(ji,jj)149 157 IF (lwp) write (numout,*) 'fgmipn(',jk,') = ', fgmipn(ji,jj) 150 158 IF (lwp) write (numout,*) 'fgmid(',jk,') = ', fgmid(ji,jj) … … 152 160 IF (lwp) write (numout,*) 'finmi(',jk,') = ', finmi(ji,jj) 153 161 IF (lwp) write (numout,*) 'ficmi(',jk,') = ', ficmi(ji,jj) 154 IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi (ji,jj)155 IF (lwp) write (numout,*) 'fmith(',jk,') = ', fmith (ji,jj)162 IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi 163 IF (lwp) write (numout,*) 'fmith(',jk,') = ', fmith 156 164 IF (lwp) write (numout,*) 'fmigrow(',jk,') = ', fmigrow(ji,jj) 157 165 IF (lwp) write (numout,*) 'fmiexcr(',jk,') = ', fmiexcr(ji,jj) … … 172 180 !!---------------------------------------------------------- 173 181 !! 174 fme1 (ji,jj)= (xkme * xkme) + (xpmepn * zphn(ji,jj) * &182 fme1 = (xkme * xkme) + (xpmepn * zphn(ji,jj) * & 175 183 zphn(ji,jj)) + & 176 184 (xpmepd * zphd(ji,jj) * zphd(ji,jj)) + & 177 185 (xpmezmi * zzmi(ji,jj) * zzmi(ji,jj)) + & 178 186 (xpmed * zdet(ji,jj) * zdet(ji,jj)) 179 fme (ji,jj) = xgme * zzme(ji,jj) / fme1(ji,jj)187 fme = xgme * zzme(ji,jj) / fme1 180 188 !! grazing on non-diatoms 181 fgmepn(ji,jj) = fme(ji,jj) * xpmepn * zphn(ji,jj) * & 182 zphn(ji,jj) 189 fgmepn(ji,jj) = fme * xpmepn * zphn(ji,jj) * zphn(ji,jj) 183 190 !! grazing on diatoms 184 fgmepd(ji,jj) = fme(ji,jj) * xpmepd * zphd(ji,jj) * & 185 zphd(ji,jj) 191 fgmepd(ji,jj) = fme * xpmepd * zphd(ji,jj) * zphd(ji,jj) 186 192 !! grazing on diatom silicon 187 193 fgmepds(ji,jj) = fsin(ji,jj) * fgmepd(ji,jj) 188 194 !! grazing on microzooplankton 189 fgmezmi(ji,jj) = fme(ji,jj) * xpmezmi * zzmi(ji,jj) * & 190 zzmi(ji,jj) 195 fgmezmi(ji,jj) = fme * xpmezmi * zzmi(ji,jj) * zzmi(ji,jj) 191 196 !! grazing on detrital nitrogen 192 fgmed(ji,jj) = fme(ji,jj) * xpmed * zdet(ji,jj) * & 193 zdet(ji,jj) 197 fgmed(ji,jj) = fme * xpmed * zdet(ji,jj) * zdet(ji,jj) 194 198 # if defined key_roam 195 199 !! acc … … 212 216 (xthetapd * fgmepd(ji,jj)) + & 213 217 (xthetazmi * fgmezmi(ji,jj)) + fgmedc(ji,jj)) 218 # if defined key_debug_medusa 219 !! report mesozooplankton grazing 220 if (idf.eq.1.AND.idfval.eq.1) then 221 IF (lwp) write (numout,*) '------------------------------' 222 IF (lwp) write (numout,*) 'fme1(',jk,') = ', fme1 223 IF (lwp) write (numout,*) 'fme(',jk,') = ', fme 224 endif 225 # endif 214 226 ENDIF 215 227 ENDDO … … 222 234 !! the ideal food C:N ratio for mesozooplankton 223 235 !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 224 fstarme (ji,jj)= (xbetan * xthetazme) / (xbetac * xkc)236 fstarme = (xbetan * xthetazme) / (xbetac * xkc) 225 237 !! 226 238 !! process these to determine proportioning of grazed N and C 227 239 !! (since there is no explicit consideration of respiration, 228 240 !! only growth and excretion are calculated here) 229 fmeth(ji,jj) = (ficme(ji,jj) / (finme(ji,jj) + & 230 tiny(finme(ji,jj)))) 231 if (fmeth(ji,jj).ge.fstarme(ji,jj)) then 241 fmeth = (ficme(ji,jj) / (finme(ji,jj) + tiny(finme(ji,jj)))) 242 if (fmeth.ge.fstarme) then 232 243 fmegrow(ji,jj) = xbetan * finme(ji,jj) 233 244 fmeexcr(ji,jj) = 0.0 … … 235 246 fmegrow(ji,jj) = (xbetac * xkc * ficme(ji,jj)) / xthetazme 236 247 fmeexcr(ji,jj) = ficme(ji,jj) * & 237 ((xbetan / (fmeth(ji,jj) + & 238 tiny(fmeth(ji,jj)))) - & 248 ((xbetan / (fmeth + tiny(fmeth))) - & 239 249 ((xbetac * xkc) / xthetazme)) 240 250 endif … … 248 258 if (idf.eq.1.AND.idfval.eq.1) then 249 259 IF (lwp) write (numout,*) '------------------------------' 250 IF (lwp) write (numout,*) 'fme1(',jk,') = ', fme1(ji,jj)251 IF (lwp) write (numout,*) 'fme(',jk,') = ', fme(ji,jj)252 260 IF (lwp) write (numout,*) 'fgmepn(',jk,') = ', fgmepn(ji,jj) 253 261 IF (lwp) write (numout,*) 'fgmepd(',jk,') = ', fgmepd(ji,jj) … … 258 266 IF (lwp) write (numout,*) 'finme(',jk,') = ', finme(ji,jj) 259 267 IF (lwp) write (numout,*) 'ficme(',jk,') = ', ficme(ji,jj) 260 IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme (ji,jj)261 IF (lwp) write (numout,*) 'fmeth(',jk,') = ', fmeth (ji,jj)268 IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme 269 IF (lwp) write (numout,*) 'fmeth(',jk,') = ', fmeth 262 270 IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow(ji,jj) 263 271 IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr(ji,jj)
Note: See TracChangeset
for help on using the changeset viewer.