- Timestamp:
- 2008-03-13T15:17:04+01:00 (16 years ago)
- Location:
- branches/dev_001_GM/NEMO/TOP_SRC/PISCES
- Files:
-
- 20 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zbio.F90
r775 r858 27 27 USE p4zmeso ! 28 28 USE p4zrem ! 29 USE prtctl_trc 29 30 30 31 IMPLICIT NONE … … 43 44 CONTAINS 44 45 45 SUBROUTINE p4z_bio 46 SUBROUTINE p4z_bio ( kt ) 46 47 !!--------------------------------------------------------------------- 47 48 !! *** ROUTINE p4z_bio *** … … 53 54 !! ** Method : - ??? 54 55 !!--------------------------------------------------------------------- 56 INTEGER, INTENT(in) :: kt 55 57 INTEGER :: ji, jj, jk, jn 56 REAL(wp) :: zdenom, ztemp 57 REAL(wp) :: zprodt, zprodca 58 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdenom1 59 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfracal 60 #if defined key_kriest 61 REAL(wp) :: znumpoc, znumdoc 62 #else 63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdenom2 64 #endif 58 CHARACTER (len=25) :: charout 59 65 60 !!--------------------------------------------------------------------- 66 61 … … 68 63 ! OF PHYTOPLANKTON AND DETRITUS 69 64 70 zdiss(:,:,:) = 0.0165 xdiss(:,:,:) = 0.01 71 66 72 67 !!gm the use of nmld should be better here? … … 74 69 DO jj = 1, jpj 75 70 DO ji = 1, jpi 76 IF( fsdepw(ji,jj,jk+1) .le. hmld(ji,jj) ) zdiss(ji,jj,jk) = 1.e071 IF( fsdepw(ji,jj,jk+1) .le. hmld(ji,jj) ) xdiss(ji,jj,jk) = 1.e0 77 72 END DO 78 73 END DO 79 74 END DO 80 75 81 ! Compute de different ratios for scavenging of iron82 ! --------------------------------------------------83 84 DO jk = 1, jpk85 DO jj = 1, jpj86 DO ji = 1, jpi87 #if ! defined key_kriest88 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) &89 & + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn )90 zdenom1(ji,jj,jk) = trn(ji,jj,jk,jppoc) * zdenom91 zdenom2(ji,jj,jk) = trn(ji,jj,jk,jpgoc) * zdenom92 #else93 zdenom = 1. / ( trn(ji,jj,jk,jppoc) &94 & + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn )95 zdenom1(ji,jj,jk) = trn(ji,jj,jk,jppoc) * zdenom96 #endif97 END DO98 END DO99 END DO100 101 ! Compute the fraction of nanophytoplankton that is made of calcifiers102 ! --------------------------------------------------------------------103 104 DO jk = 1, jpkm1105 DO jj = 1, jpj106 DO ji = 1, jpi107 ztemp = MAX( 0., tn(ji,jj,jk) )108 zfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk) &109 & * MAX( 0.0001, ztemp / ( 2.+ ztemp ) ) &110 & * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. )111 zfracal(ji,jj,jk) = MIN( 0.8 , zfracal(ji,jj,jk) )112 zfracal(ji,jj,jk) = MAX( 0.01, zfracal(ji,jj,jk) )113 END DO114 END DO115 END DO116 76 117 77 ! computation of the vertical flux of particulate organic matter … … 122 82 ENDIF 123 83 84 124 85 ! compute the PAR in the water column 125 86 ! ----------------------------------- 126 87 127 88 CALL p4z_opt ! Optical 89 90 128 91 129 92 ! compute the co-limitations by the various nutrients … … 132 95 CALL p4z_lim 133 96 97 134 98 ! compute phytoplankton growth rate over the global ocean. 135 99 ! ------------------------------------------------------- 136 100 ! (Growth rates for each element is computed (C, Si, Fe, Chl)) 137 101 138 CALL p4z_prod 102 CALL p4z_prod ( kt ) 103 104 139 105 140 106 ! phytoplankton mortality (Mortality losses for each elements are computed (C, Fe, Si, Chl) ) … … 143 109 CALL p4z_nano ! nanophytoplankton 144 110 111 145 112 CALL p4z_diat ! diatoms 113 146 114 147 115 ! zooplankton sources/sinks routines (each elements are computed (C, Fe, Si, Chl) ) … … 149 117 150 118 CALL p4z_micro ! microzooplankton 119 151 120 152 121 CALL p4z_meso ! mesozooplankton 122 153 123 154 124 ! computation of remineralization terms of organic matter + scavenging of Fe … … 158 128 159 129 160 ! Determination of tracers concentration as a function of biological sources and sinks161 ! ------------------------------------------------------------------------------------162 163 DO jk = 1, jpkm1164 165 ! Evolution of PO4166 ! ----------------167 trn(:,:,jk,jppo4) = trn(:,:,jk,jppo4) - prorca(:,:,jk) - prorca2(:,:,jk) &168 & + olimi (:,:,jk) + grarem (:,:,jk) * sigma1 &169 & + denitr(:,:,jk) + grarem2(:,:,jk) * sigma2170 171 ! Evolution of NO3 and NH4172 ! ------------------------173 trn(:,:,jk,jpno3) = trn(:,:,jk,jpno3) - pronew(:,:,jk) - pronew2(:,:,jk) &174 & + onitr (:,:,jk) - denitr (:,:,jk) * rdenit175 176 trn(:,:,jk,jpnh4) = trn(:,:,jk,jpnh4) - proreg(:,:,jk) - proreg2(:,:,jk) &177 & + olimi (:,:,jk) + grarem (:,:,jk) * sigma1 &178 & + grarem2(:,:,jk) * sigma2 &179 & - onitr (:,:,jk) + denitr (:,:,jk)180 181 ! Evolution of Phytoplankton182 ! --------------------------183 trn(:,:,jk,jpphy) = trn(:,:,jk,jpphy) + prorca (:,:,jk) * ( 1.- excret ) - tortp(:,:,jk) &184 & - grazp (:,:,jk) - grazn(:,:,jk) - respp(:,:,jk)185 186 trn(:,:,jk,jpnch) = trn(:,:,jk,jpnch) + prorca6(:,:,jk) * ( 1.- excret ) - tortnch(:,:,jk) &187 & - grazpch(:,:,jk) - graznch(:,:,jk)- respnch(:,:,jk)188 189 ! Evolution of Diatoms190 ! --------------------191 trn(:,:,jk,jpdia) = trn(:,:,jk,jpdia) + prorca2(:,:,jk) * ( 1.- excret2 ) - tortp2(:,:,jk) &192 & - respp2 (:,:,jk) - grazd(:,:,jk) - grazsd(:,:,jk)193 194 trn(:,:,jk,jpdch) = trn(:,:,jk,jpdch) + prorca7(:,:,jk) * ( 1.- excret2 ) - tortdch(:,:,jk) &195 & - respdch(:,:,jk) - grazdch(:,:,jk) - grazsch(:,:,jk)196 197 ! Evolution of Zooplankton198 ! ------------------------199 trn(:,:,jk,jpzoo) = trn(:,:,jk,jpzoo) + epsher * ( grazp(:,:,jk) + grazm(:,:,jk) + grazsd(:,:,jk) ) &200 & - grazz(:,:,jk) - tortz(:,:,jk) - respz(:,:,jk)201 202 ! Evolution of Mesozooplankton203 ! ------------------------204 trn(:,:,jk,jpmes) = trn(:,:,jk,jpmes) + epsher2 * ( grazd (:,:,jk) + grazz (:,:,jk) + grazn(:,:,jk) &205 & + grazpoc(:,:,jk) + grazffe(:,:,jk) ) &206 & - tortz2(:,:,jk) - respz2(:,:,jk)207 208 ! Evolution of O2209 ! ---------------210 trn(:,:,jk,jpoxy) = trn(:,:,jk,jpoxy) + o2ut * ( proreg(:,:,jk) + proreg2(:,:,jk) - olimi(:,:,jk) &211 & -grarem(:,:,jk) * sigma1 - grarem2(:,:,jk) * sigma2 ) &212 & + ( o2ut + o2nit ) * ( pronew(:,:,jk) + pronew2(:,:,jk) ) &213 & - o2nit * onitr(:,:,jk)214 215 ! Evolution of IRON216 ! -----------------217 trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + ( excret - 1.) * prorca5(:,:,jk) - xaggdfe (:,:,jk) &218 & + ( excret2 - 1.) * prorca4(:,:,jk) - xbactfer(:,:,jk) &219 & + grafer(:,:,jk) + grafer2(:,:,jk) &220 & + ofer (:,:,jk) - xscave (:,:,jk)221 !222 END DO223 224 225 #if defined key_kriest226 227 #include "p4zbio_kriest.h90"228 229 #else230 231 #include "p4zbio_std.h90"232 233 #endif234 235 236 DO jk = 1, jpkm1237 238 ! Evolution of biogenic Silica239 ! ----------------------------240 trn(:,:,jk,jpbsi) = trn(:,:,jk,jpbsi) + prorca3(:,:,jk) * ( 1.- excret2 ) - grazss(:,:,jk) &241 & - tortds (:,:,jk) - respds(:,:,jk) - grazs (:,:,jk)242 243 ! Evolution of sinking biogenic silica244 ! ------------------------------------245 trn(:,:,jk,jpdsi) = trn(:,:,jk,jpdsi) + tortds (:,:,jk) + respds(:,:,jk) + grazs(:,:,jk) &246 & - osil (:,:,jk) + grazss(:,:,jk)247 248 ! Evolution of biogenic diatom Iron249 ! ---------------------------------250 trn(:,:,jk,jpdfe) = trn(:,:,jk,jpdfe) + prorca4(:,:,jk) * ( 1.- excret2 ) - grazsf(:,:,jk) &251 & - tortdf (:,:,jk) - respdf(:,:,jk) - grazf (:,:,jk)252 253 ! Evolution of biogenic nanophytoplankton Iron254 ! --------------------------------------------255 trn(:,:,jk,jpnfe) = trn(:,:,jk,jpnfe) + prorca5(:,:,jk) * ( 1.- excret ) - graznf(:,:,jk) &256 & - tortnf (:,:,jk) - respnf(:,:,jk) - grazpf(:,:,jk)257 258 ! Evolution of dissolved Silica259 ! -----------------------------260 trn(:,:,jk,jpsil) = trn(:,:,jk,jpsil) - ( 1.- excret2 ) * prorca3(:,:,jk) + osil(:,:,jk)261 262 END DO263 264 ! Evolution of calcite and silicates as a function of the two tracers265 ! -------------------------------------------------------------------266 DO jk = 1, jpkm1267 DO jj = 1, jpj268 DO ji = 1, jpi269 270 zprodt = prorca(ji,jj,jk) + prorca2(ji,jj,jk) - olimi(ji,jj,jk) - grarem(ji,jj,jk) * sigma1 &271 & - grarem2(ji,jj,jk) * sigma2 - denitr(ji,jj,jk)272 zprodca = pronew(ji,jj,jk) + pronew2(ji,jj,jk) - onitr(ji,jj,jk) + rdenit * denitr(ji,jj,jk)273 274 ! potential production of calcite and biogenic silicate275 ! ------------------------------------------------------276 prcaca(ji,jj,jk) = zfracal(ji,jj,jk) &277 & * ( part * ( unass*grazp(ji,jj,jk) + unass2*grazn(ji,jj,jk) ) &278 & + tortp(ji,jj,jk) + respp(ji,jj,jk) )279 280 ! Consumption of Total (12C)O2281 ! ----------------------------282 trn(ji,jj,jk,jpdic) = trn(ji,jj,jk,jpdic) - zprodt - prcaca(ji,jj,jk)283 284 ! Consumption of alkalinity due to ca++ uptake and increase of285 ! alkalinity due to nitrate consumption during organic soft tissue production286 ! ---------------------------------------------------------287 trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zprodca - 2.* prcaca(ji,jj,jk)288 !289 END DO290 END DO291 END DO292 293 294 ! Production of calcite due to biological production295 ! --------------------------------------------------296 DO jk = 1, jpkm1297 trn(:,:,jk,jpcal) = trn(:,:,jk,jpcal) + prcaca(:,:,jk)298 END DO299 300 301 130 ! Loop to test if tracers concentrations fall below 0. 302 131 ! ---------------------------------------------------- 303 132 304 znegtr(:,:,:) = 1.e0305 DO jn = 1, jptra133 xnegtr(:,:,:) = 1.e0 134 DO jn = jp_pcs0, jp_pcs1 306 135 DO jk = 1, jpk 307 136 DO jj = 1, jpj 308 137 DO ji = 1, jpi 309 IF( trn(ji,jj,jk,jn) < 0.e0 ) znegtr(ji,jj,jk) = 0.e0 138 IF( ( trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) & 139 & xnegtr(ji,jj,jk) = 0.e0 310 140 END DO 311 141 END DO … … 314 144 ! ! where at least 1 tracer concentration becomes negative 315 145 ! ! all tracer tendancy are set to zero (i.e. trn = trb) 316 DO jn = 1, jptra317 trn(:,:,:,jn) = tr b(:,:,:,jn) + znegtr(:,:,:) * ( trn(:,:,:,jn) - trb(:,:,:,jn))146 DO jn = jp_pcs0, jp_pcs1 147 trn(:,:,:,jn) = trn(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 318 148 END DO 319 149 320 # if defined key_trc_dia3d 150 151 tra(:,:,:,:) = 0.0 152 153 #if defined key_kriest 154 DO jk = 1,jpkm1 155 DO jj = 1,jpj 156 DO ji = 1,jpi 157 trn(ji,jj,jk,jpnum) = MAX( trn(ji,jj,jk,jpnum), & 158 & trn(ji,jj,jk,jppoc) / xkr_massp / xnumm(jk) ) 159 160 trn(ji,jj,jk,jpnum) = MIN( trn(ji,jj,jk,jpnum), & 161 & trn(ji,jj,jk,jppoc) / xkr_massp / 1.1 ) 162 163 END DO 164 END DO 165 END DO 166 #endif 167 168 169 # if defined key_trc_dia3d && defined key_kriest 321 170 !!gm potential bug hard coded index on trc3d 322 trc3d(:,:,:, 4) = etot(:,:,:) 323 trc3d(:,:,:, 5) = prorca (:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 324 trc3d(:,:,:, 6) = prorca2(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 325 trc3d(:,:,:, 7) = pronew (:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 326 trc3d(:,:,:, 8) = pronew2(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 327 trc3d(:,:,:, 9) = prorca3(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 328 trc3d(:,:,:,10) = prorca4(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 329 # if ! defined key_kriest 330 trc3d(:,:,:,11) = prorca5(:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 331 # else 332 trc3d(:,:,:,11) = prcaca (:,:,:) * znegtr(:,:,:) * 1.e3 * rfact2r 333 # endif 171 trc3d(:,:,:,11) = tra(:,:,:,jpcal) * xnegtr(:,:,:) * 1.e3 * rfact2r 334 172 # endif 335 173 ! 174 IF(ln_ctl) THEN ! print mean trends (used for debugging) 175 WRITE(charout, FMT="('bio ')") 176 CALL prt_ctl_trc_info(charout) 177 CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 178 ENDIF 179 336 180 END SUBROUTINE p4z_bio 337 181 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zche.F90
r775 r858 25 25 26 26 PUBLIC p4z_che ! called in p4zprg.F90 27 28 !! * Module variables 29 30 REAL(wp) :: & 31 salchl = 1./1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 32 33 REAL(wp) :: & ! coeff. for apparent solubility equilibrium 34 akcc1 = -171.9065 , & ! Millero et al. 1995 from Mucci 1983 35 akcc2 = -0.077993 , & 36 akcc3 = 2839.319 , & 37 akcc4 = 71.595 , & 38 akcc5 = -0.77712 , & 39 akcc6 = 0.0028426 , & 40 akcc7 = 178.34 , & 41 akcc8 = -0.07711 , & 42 akcc9 = 0.0041249 43 44 45 REAL(wp) :: & ! universal gas constants 46 rgas = 83.143, & 47 oxyco = 1./22.4144 48 49 REAL(wp) :: & ! borat constants 50 bor1 = 0.00023, & 51 bor2 = 1./10.82 52 53 REAL(wp) :: & ! 54 ca0 = -162.8301 , & 55 ca1 = 218.2968 , & 56 ca2 = 90.9241 , & 57 ca3 = -1.47696 , & 58 ca4 = 0.025695 , & 59 ca5 = -0.025225 , & 60 ca6 = 0.0049867 61 62 REAL(wp) :: & ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 63 c10 = -3670.7 , & 64 c11 = 62.008 , & 65 c12 = -9.7944 , & 66 c13 = 0.0118 , & 67 c14 = -0.000116 68 69 REAL(wp) :: & ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995) 70 c20 = -1394.7 , & 71 c21 = -4.777 , & 72 c22 = 0.0184 , & 73 c23 = -0.000118 74 75 REAL(wp) :: & ! constants for calculate concentrations 76 st1 = 0.14 , & ! for sulfate (Morris & Riley 1966) 77 st2 = 1./96.062, & 78 ks0 = 141.328 , & 79 ks1 = -4276.1 , & 80 ks2 = -23.093 , & 81 ks3 = -13856. , & 82 ks4 = 324.57 , & 83 ks5 = -47.986 , & 84 ks6 = 35474. , & 85 ks7 = -771.54 , & 86 ks8 = 114.723 , & 87 ks9 = -2698. , & 88 ks10 = 1776. , & 89 ks11 = 1. , & 90 ks12 = -0.001005 91 92 REAL(wp) :: & ! constants for calculate concentrations 93 ft1 = 0.000067 , & ! fluorides (Dickson & Riley 1979 ) 94 ft2 = 1./18.9984 , & 95 kf0 = -12.641 , & 96 kf1 = 1590.2 , & 97 kf2 = 1.525 , & 98 kf3 = 1.0 , & 99 kf4 =-0.001005 100 101 102 REAL(wp) :: & ! coeff. for 1. dissoc. of boric acid (Dickson and Goyet, 1994) 103 cb0 = -8966.90, & 104 cb1 = -2890.53, & 105 cb2 = -77.942 , & 106 cb3 = 1.728 , & 107 cb4 = -0.0996 , & 108 cb5 = 148.0248, & 109 cb6 = 137.1942, & 110 cb7 = 1.62142 , & 111 cb8 = -24.4344, & 112 cb9 = -25.085 , & 113 cb10 = -0.2474 , & 114 cb11 = 0.053105 115 116 REAL(wp) :: & ! coeff. for dissoc. of water (Dickson and Riley, 1979 ) 117 cw0 = -13847.26 , & 118 cw1 = 148.9652 , & 119 cw2 = -23.6521 , & 120 cw3 = 118.67 , & 121 cw4 = -5.977 , & 122 cw5 = 1.0495 , & 123 cw6 = -0.01615 124 125 REAL(wp) :: & ! coeff. for dissoc. of phosphate (Millero (1974) 126 cp10 = 115.54 , & 127 cp11 = -4576.752 , & 128 cp12 = -18.453 , & 129 cp13 = -106.736 , & 130 cp14 = 0.69171 , & 131 cp15 = -0.65643 , & 132 cp16 = -0.01844 , & 133 cp20 = 172.1033 , & 134 cp21 = -8814.715 , & 135 cp22 = -27.927 , & 136 cp23 = -160.340 , & 137 cp24 = 1.3566 , & 138 cp25 = 0.37335 , & 139 cp26 = -0.05778 , & 140 cp30 = -18.126 , & 141 cp31 = -3070.75 , & 142 cp32 = 17.27039 , & 143 cp33 = 2.81197 , & 144 cp34 = -44.99486 , & 145 cp35 = -0.09984 146 147 REAL(wp) :: & ! coeff. for dissoc. of silicates (Millero (1974) 148 cs10 = 117.385 , & 149 cs11 = -8904.2 , & 150 cs12 = -19.334 , & 151 cs13 = -458.79 , & 152 cs14 = 3.5913 , & 153 cs15 = 188.74 , & 154 cs16 = -1.5998 , & 155 cs17 = -12.1652 , & 156 cs18 = 0.07871 , & 157 cs19 = 0. , & 158 cs20 = 1. , & 159 cs21 = -0.001005 160 161 REAL(wp) :: & ! volumetric solubility constants for o2 in ml/l (Weiss, 1974) 162 ox0 = -58.3877 , & 163 ox1 = 85.8079 , & 164 ox2 = 23.8439 , & 165 ox3 = -0.034892 , & 166 ox4 = 0.015568 , & 167 ox5 = -0.0019387 168 169 REAL(wp), DIMENSION(5) :: & ! coeff. for seawater pressure correction 170 devk1, devk2, devk3, & ! (millero 95) 171 devk4, devk5 172 173 DATA devk1 / -25.5 , -15.82 , -29.48 , -25.60 , -48.76 / 174 DATA devk2 / 0.1271 , -0.0219 , 0.1622 , 0.2324 , 0.5304 / 175 DATA devk3 / 0. , 0. , 2.608E-3, -3.6246E-3, 0. / 176 DATA devk4 / -3.08E-3 , 1.13E-3 , -2.84E-3, -5.13E-3 , -11.76E-3 / 177 DATA devk5 / 0.0877E-3, -0.1475E-3, 0. , 0.0794E-3 , 0.3692E-3 / 27 178 28 179 !!* Substitution … … 46 197 INTEGER :: ji, jj, jk 47 198 REAL(wp) :: ztkel, zsal , zqtt , zbuf1 , zbuf2 48 REAL(wp) :: zpres, ztc , zcl , zcpexp, z cek0, zoxy , zcpexp2199 REAL(wp) :: zpres, ztc , zcl , zcpexp, zoxy , zcpexp2 49 200 REAL(wp) :: zsqrt, ztr , zlogt , zcek1 50 201 REAL(wp) :: zlqtt, zqtt2, zsal15, zis , zis2 , zisqrt 51 202 REAL(wp) :: zckb , zck1 , zck2 , zckw , zak1 , zak2 , zakb , zaksp0, zakw 52 REAL(wp) :: zckp1, zckp2, zckp3 , zcksi , zakp1, zakp2 , zakp3, zaksi 53 REAL(wp) :: zst , zft , zcks , zckf , zaks , zakf , zaksp1 203 REAL(wp) :: zst , zft , zcks , zckf , zaksp1 54 204 !!--------------------------------------------------------------------- 55 205 56 206 ! CHEMICAL CONSTANTS - SURFACE LAYER 57 207 ! ---------------------------------- 58 208 !CDIR NOVERRCHK 59 209 DO jj = 1, jpj 210 !CDIR NOVERRCHK 60 211 DO ji = 1, jpi 61 212 … … 69 220 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 70 221 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 71 zcek0 = c00 + c01 / zqtt + c02 * zlqtt + zsal * ( c03 + c04 * zqtt + c05 * zqtt2 )72 222 zcek1 = ca0 + ca1 / zqtt + ca2 * zlqtt + ca3 * zqtt2 + zsal*( ca4 + ca5 * zqtt + ca6 * zqtt2 ) 73 223 … … 76 226 77 227 ! ! SET SOLUBILITIES OF O2 AND CO2 78 chemc(ji,jj,1) = EXP( zcek 0) * 1.e-6 * rhop(ji,jj,1) / 1000.228 chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. 79 229 chemc(ji,jj,2) = EXP( zoxy ) * oxyco 80 chemc(ji,jj,3) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000.81 230 82 231 END DO … … 85 234 ! CHEMICAL CONSTANTS - DEEP OCEAN 86 235 ! ------------------------------- 87 236 !CDIR NOVERRCHK 88 237 DO jk = 1, jpk 238 !CDIR NOVERRCHK 89 239 DO jj = 1, jpj 240 !CDIR NOVERRCHK 90 241 DO ji = 1, jpi 91 242 … … 136 287 zckw = cw0 * ztr + cw1 + cw2 * zlogt + ( cw3 * ztr + cw4 + cw5 * zlogt ) * zsqrt + cw6 * zsal 137 288 138 ! DISSOCIATION CONSTANT FOR PHOSPHATE AND SILICATE (seawater scale)139 zckp1 = cp10 + cp11 * ztr + cp12 * zlogt + zsqrt * ( cp13 * ztr + cp14 ) + zsal * ( cp15 * ztr + cp16 )140 zckp2 = cp20 + cp21 * ztr + cp22 * zlogt + zsqrt * ( cp23 * ztr + cp24 ) + zsal * ( cp25 * ztr + cp26 )141 zckp3 = cp30 + cp31 * ztr + zsqrt * ( cp32 * ztr + cp33 ) + zsal * ( cp34 * ztr + cp35 )142 zcksi = cs10 + cs11 * ztr + cs12 * zlogt + zisqrt* ( cs13 * ztr + cs14 ) + zis * ( cs15 * ztr + cs16 ) &143 & + zis2 * ( cs17 * ztr + cs18 ) + LOG( 1. + cs19 * zsal ) &144 & + LOG( cs20 + cs21 * zsal )145 289 146 290 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER … … 153 297 zak2 = 10**(zck2) 154 298 zakb = EXP( zckb ) 155 zakp1 = EXP( zckp1 )156 zakp2 = EXP( zckp2 )157 zakp3 = EXP( zckp3 )158 zaksi = EXP( zcksi )159 299 zakw = EXP( zckw ) 160 300 zaksp1 = 10**(zaksp0) 161 zaks = exp( zcks )162 zakf = exp( zckf )163 301 164 302 ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) … … 178 316 ! CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 179 317 ! (CF. BROECKER ET AL., 1982) 318 319 zbuf1 = -(devk1(1)+devk2(1)*ztc+devk3(1)*ztc*ztc) 320 zbuf2 = 0.5*(devk4(1)+devk5(1)*ztc) 321 ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 322 323 zbuf1 = - ( devk1(2) + devk2(2) * ztc + devk3(2) * ztc * ztc ) 324 zbuf2 = 0.5 * ( devk4(2) + devk5(2) * ztc ) 325 ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 326 180 327 zbuf1 = - ( devk1(3) + devk2(3) * ztc + devk3(3) * ztc * ztc ) 181 328 zbuf2 = 0.5 * ( devk4(3) + devk5(3) * ztc ) 182 329 akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 183 330 184 zbuf1 = -(devk1(1)+devk2(1)*ztc+devk3(1)*ztc*ztc)185 zbuf2 = 0.5*(devk4(1)+devk5(1)*ztc)186 ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )187 188 zbuf1 = - ( devk1(2) + devk2(2) * ztc + devk3(2) * ztc * ztc )189 zbuf2 = 0.5 * ( devk4(2) + devk5(2) * ztc )190 ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )191 192 331 zbuf1 = - ( devk1(4) + devk2(4) * ztc + devk3(4) * ztc * ztc ) 193 332 zbuf2 = 0.5 * ( devk4(4) + devk5(4) * ztc ) 194 akp13(ji,jj,jk) = zakp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )195 196 zbuf1 = - ( devk1(5) + devk2(5) * ztc + devk3(5) * ztc * ztc )197 zbuf2 = 0.5 * ( devk4(5) + devk5(5) * ztc )198 akp23(ji,jj,jk) = zakp2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )199 200 zbuf1 = - ( devk1(6) + devk2(6) * ztc + devk3(6) * ztc * ztc )201 zbuf2 = 0.5 * ( devk4(6) + devk5(6) * ztc )202 akp33(ji,jj,jk) = zakp3 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )203 204 zbuf1 = - ( devk1(7) + devk2(7) * ztc + devk3(7) * ztc * ztc )205 zbuf2 = 0.5 * ( devk4(7) + devk5(7) * ztc )206 333 akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 207 334 208 ! Ksi209 ! aksi3(ji,jj,jk) = zaksi210 !211 ! Or using coefficient of borates (cf millero 95+ corrected version html doc co2sys)212 ! "deltaVsi and deltaKsi have been estimated from the value of boric acid"213 zbuf1 = - ( devk1(3) + devk2(3) * ztc + devk3(3) * ztc * ztc )214 zbuf2 = 0.5 * ( devk4(3) + devk5(3) * ztc )215 aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )216 335 217 336 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 218 337 ! AS FUNCTION OF PRESSURE FOLLOWING MILLERO 219 338 ! (P. 1285) AND BERNER (1976) 220 zbuf1 = - ( devk1( 8) + devk2(8) * ztc + devk3(8) * ztc * ztc )221 zbuf2 = 0.5 * ( devk4( 8) + devk5(8) * ztc )339 zbuf1 = - ( devk1(5) + devk2(5) * ztc + devk3(5) * ztc * ztc ) 340 zbuf2 = 0.5 * ( devk4(5) + devk5(5) * ztc ) 222 341 aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 223 342 224 ! Pressure correction for sulfate and fluoride225 zbuf1 = - ( devk1(9) + devk2(9) * ztc + devk3(9) * ztc * ztc )226 zbuf2 = 0.5 * ( devk4(9) + devk5(9) * ztc )227 aks3(ji,jj,jk) = zaks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )228 229 zbuf1 = - ( devk1(10) + devk2(10) * ztc + devk3(10) * ztc * ztc )230 zbuf2 = 0.5 * ( devk4(10) + devk5(10) * ztc )231 akf3(ji,jj,jk) = zakf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )232 343 233 344 ! TOTAL BORATE CONCENTR. [MOLES/L] -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zdiat.F90
r775 r858 16 16 USE trp_trc ! 17 17 USE sms ! 18 USE prtctl_trc 18 19 19 20 IMPLICIT NONE … … 40 41 !! ** Method : - ??? 41 42 !!--------------------------------------------------------------------- 42 INTEGER :: ji, jj, jk 43 REAL(wp) :: zfact, zstep, zcompadi 43 INTEGER :: ji, jj, jk 44 REAL(wp) :: zfactfe,zfactsi,zfactch, zstep, zcompadi 45 REAL(wp) :: zrespp2, ztortp2, zmortp2 46 CHARACTER (len=25) :: charout 47 44 48 !!--------------------------------------------------------------------- 45 49 … … 57 61 58 62 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. ) 59 zfact = 1. / ( trn(ji,jj,jk,jpdia) + rtrn )60 63 61 64 ! Aggregation term for diatoms is increased in case of nutrient … … 64 67 ! ------------------------------------------------------------ 65 68 66 respp2 (ji,jj,jk)= 1.e6 * zstep * ( wchl + wchld * ( 1.- xlimdia(ji,jj,jk) ) ) &69 zrespp2 = 1.e6 * zstep * ( wchl + wchld * ( 1.- xlimdia(ji,jj,jk) ) ) & 67 70 # if defined key_off_degrad 68 & 71 & * facvol(ji,jj,jk) & 69 72 # endif 70 & * zdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)73 & * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 71 74 72 respds (ji,jj,jk) = respp2(ji,jj,jk) * trn(ji,jj,jk,jpbsi) * zfact73 74 respdf (ji,jj,jk) = respp2(ji,jj,jk) * trn(ji,jj,jk,jpdfe) * zfact75 76 respdch(ji,jj,jk) = respp2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zfact77 75 78 76 ! Phytoplankton mortality. 79 77 ! ------------------------ 80 tortp2 (ji,jj,jk)= mprat2 * zstep * trn(ji,jj,jk,jpdia) &78 ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia) & 81 79 # if defined key_off_degrad 82 & 80 & * facvol(ji,jj,jk) & 83 81 # endif 84 & 82 & / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 85 83 86 tortds (ji,jj,jk) = tortp2(ji,jj,jk) * trn(ji,jj,jk,jpbsi) * zfact84 zmortp2 = zrespp2 + ztortp2 87 85 88 tortdf (ji,jj,jk) = tortp2(ji,jj,jk) * trn(ji,jj,jk,jpdfe) * zfact 86 ! Update the arrays tra which contains the biological sources and sinks 87 ! --------------------------------------------------------------------- 88 zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 89 zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 90 zfactsi = trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 89 91 90 tortdch(ji,jj,jk) = tortp2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zfact 91 92 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2 93 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 94 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zmortp2 * zfactfe 95 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zmortp2 * zfactsi 96 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zmortp2 * zfactsi 97 #if defined key_kriest 98 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2 99 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ndiat + zrespp2 * xkr_naggr 100 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe 101 #else 102 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2 103 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2 104 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe 105 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 106 #endif 92 107 END DO 93 108 END DO 94 109 END DO 95 110 ! 111 IF(ln_ctl) THEN ! print mean trends (used for debugging) 112 WRITE(charout, FMT="('diat')") 113 CALL prt_ctl_trc_info(charout) 114 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 115 ENDIF 116 96 117 END SUBROUTINE p4z_diat 97 118 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zflx.F90
r775 r858 19 19 USE trp_trc 20 20 USE sms 21 USE prtctl_trc 21 22 22 23 IMPLICIT NONE … … 24 25 25 26 PUBLIC p4z_flx ! called in p4zprg.F90 27 28 REAL(wp) :: & ! pre-industrial atmospheric [co2] (ppm) 29 atcox = 0.20946 30 26 31 27 32 !!* Substitution … … 35 40 CONTAINS 36 41 37 SUBROUTINE p4z_flx 42 SUBROUTINE p4z_flx ( kt ) 38 43 !!--------------------------------------------------------------------- 39 44 !! *** ROUTINE p4z_flx *** … … 43 48 !! ** Method : - ??? 44 49 !!--------------------------------------------------------------------- 45 INTEGER :: ji, jj, jrorr 46 REAL(wp) :: zpdtan, zttc, zws 50 INTEGER, INTENT(in) :: kt 51 INTEGER :: ji, jj, jrorr, nspyr 52 REAL(wp) :: zttc, zws 47 53 REAL(wp) :: zfld, zflu, zoxy16, zflu16, zfact 48 54 REAL(wp) :: zph, zah2, zbot, zdic, zalk, zschmitto2, zalka, zschmittco2 49 REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3 55 REAL(wp), DIMENSION(jpi,jpj) :: zkgco2, zkgo2, zh2co3, zqcumtemp 56 CHARACTER (len=25) :: charout 57 50 58 !!--------------------------------------------------------------------- 51 59 … … 55 63 ! ----------------------------------------------------- 56 64 57 zpdtan = raass / rdt65 nspyr = INT( raass / rdt ) 58 66 59 67 ! SURFACE CHEMISTRY (PCO2 AND [H+] IN … … 63 71 DO jrorr = 1, 10 64 72 73 !CDIR NOVERRCHK 65 74 DO jj = 1, jpj 75 !CDIR NOVERRCHK 66 76 DO ji = 1, jpi 67 77 … … 94 104 ! ------------------------------------------- 95 105 96 DO jj = 1, jpj 106 !CDIR NOVERRCHK 107 DO jj = 1, jpj 108 !CDIR NOVERRCHK 97 109 DO ji = 1, jpi 98 110 … … 140 152 END DO 141 153 154 zqcumtemp(:,:) = 0. 142 155 DO jj = 1, jpj 143 156 DO ji = 1, jpi 144 157 145 158 ! Compute CO2 flux for the sea and air 146 zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj, 3) * zkgco2(ji,jj)159 zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 147 160 zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 148 161 tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 149 162 163 zqcumtemp(ji,jj) = ( zfld - zflu ) * rfact & 164 & * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * 1000. 150 165 ! Compute O2 flux 151 166 zoxy16 = trn(ji,jj,1,jpoxy) … … 158 173 trc2d(ji,jj,2) = zflu16 * 1000. 159 174 trc2d(ji,jj,3) = zkgco2(ji,jj) 160 trc2d(ji,jj,4) = atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj, 3) + rtrn )175 trc2d(ji,jj,4) = atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) 161 176 # endif 162 177 END DO 163 178 END DO 164 179 ! 180 181 DO jj = 1, jpj 182 DO ji = 1, jpi 183 qcumul(1) = qcumul(1) + zqcumtemp(ji,jj) * tmask_i(ji,jj) 184 END DO 185 END DO 186 187 IF( MOD( kt, nspyr ) == 0 ) THEN 188 WRITE(numout,*) ' Atmospheric pCO2 :' 189 WRITE(numout,*) '-------------------- : ',kt,' ',atcco2 190 WRITE(numout,*) '(ppm)' 191 WRITE(numout,*) 'Total Flux of Carbon :' 192 WRITE(numout,*) '-------------------- : ',qcumul(1)*12./1E15 193 WRITE(numout,*) '(GtC/an)' 194 qcumul(1) = 0. 195 ENDIF 196 197 IF(ln_ctl) THEN ! print mean trends (used for debugging) 198 WRITE(charout, FMT="('flx ')") 199 CALL prt_ctl_trc_info(charout) 200 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 201 ENDIF 202 203 165 204 END SUBROUTINE p4z_flx 166 205 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zlim.F90
r775 r858 44 44 REAL(wp) :: zlim1, zlim2, zlim3, zlim4, zno3, zferlim 45 45 REAL(wp) :: zconctemp, zconctemp2, zconctempn, zconctempn2 46 REAL(wp) :: ztemp, zdenom 46 47 !!--------------------------------------------------------------------- 47 48 … … 70 71 DO ji = 1, jpi 71 72 zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia)-5e-7 ) 72 zconctemp2 = MIN( 5.e-7, trn(ji,jj,jk,jpdia) )73 zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp 73 74 zconctempn = MAX( 0.e0 , trn(ji,jj,jk,jpphy)-1e-6 ) 74 zconctempn2 = MIN( 1.e-6, trn(ji,jj,jk,jpphy) )75 zconctempn2 = trn(ji,jj,jk,jpphy) - zconctempn 75 76 concdfe(ji,jj,jk) = ( zconctemp2 * conc3 + 0.4e-9 * zconctemp) & 76 & / ( zconctemp2 + zconctemp+ rtrn )77 & / ( trn(ji,jj,jk,jpdia) + rtrn ) 77 78 concdfe(ji,jj,jk) = MAX( conc3, concdfe(ji,jj,jk) ) 78 79 concnfe(ji,jj,jk) = ( zconctempn2 * conc2 + 0.08e-9 * zconctempn) & 79 & / ( zconctempn2 + zconctempn+ rtrn )80 & / ( trn(ji,jj,jk,jpphy) + rtrn ) 80 81 concnfe(ji,jj,jk) = MAX( conc2, concnfe(ji,jj,jk) ) 81 82 END DO … … 90 91 ! Small flagellates 91 92 ! ----------------------------------------------- 93 zdenom = 1. / & 94 & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 95 xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concnnh4 * zdenom 96 xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc0 * zdenom 92 97 93 xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concnnh4 &94 & / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) &95 & + conc0 * trn(ji,jj,jk,jpnh4) )96 xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc0 &97 & / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) &98 & + conc0 * trn(ji,jj,jk,jpnh4) )99 98 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 100 99 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 ) … … 116 115 ! Michaelis-Menten Limitation term for nutrients Diatoms 117 116 ! ---------------------------------------------- 117 zdenom = 1. / & 118 & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) 118 119 119 xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concdnh4 & 120 & / ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) & 121 & + conc1 * trn(ji,jj,jk,jpnh4) ) 122 xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc1 & 123 & / ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) & 124 & + conc1 * trn(ji,jj,jk,jpnh4) ) 120 xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concdnh4 * zdenom 121 xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc1 * zdenom 125 122 126 123 zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) … … 130 127 xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 131 128 129 END DO 130 END DO 131 END DO 132 133 134 ! Compute the fraction of nanophytoplankton that is made of calcifiers 135 ! -------------------------------------------------------------------- 136 137 DO jk = 1, jpkm1 138 DO jj = 1, jpj 139 DO ji = 1, jpi 140 ztemp = MAX( 0., tn(ji,jj,jk) ) 141 xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk) & 142 & * MAX( 0.0001, ztemp / ( 2.+ ztemp ) ) & 143 & * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) 144 xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 145 xfracal(ji,jj,jk) = MAX( 0.01, xfracal(ji,jj,jk) ) 132 146 END DO 133 147 END DO -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zlys.F90
r775 r858 19 19 USE trp_trc 20 20 USE sms 21 USE prtctl_trc 21 22 22 23 IMPLICIT NONE … … 24 25 25 26 PUBLIC p4z_lys ! called in p4zprg.F90 27 28 !! * Module variables 29 30 REAL(wp) :: & 31 calcon = 1.03E-2 ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 26 32 27 33 !!---------------------------------------------------------------------- … … 48 54 REAL(wp) :: zomegaca, zexcess, zexcess0 49 55 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zco3 56 CHARACTER (len=25) :: charout 50 57 !!--------------------------------------------------------------------- 51 58 … … 57 64 DO jn = 1, 5 ! BEGIN OF ITERATION 58 65 ! 66 !CDIR NOVERRCHK 59 67 DO jk = 1, jpkm1 68 !CDIR NOVERRCHK 60 69 DO jj = 1, jpj 70 !CDIR NOVERRCHK 61 71 DO ji = 1, jpi 62 72 … … 131 141 132 142 # if defined key_trc_dia3d 133 trc3d(:,:,:,1) = rhop(:,:,:)143 trc3d(:,:,:,1) = hi(:,:,:) 134 144 trc3d(:,:,:,2) = zco3(:,:,:) 135 145 trc3d(:,:,:,3) = aksp(:,:,:) / calcon 136 146 # endif 137 147 ! 148 IF(ln_ctl) THEN ! print mean trends (used for debugging) 149 WRITE(charout, FMT="('lys ')") 150 CALL prt_ctl_trc_info(charout) 151 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 152 ENDIF 153 138 154 END SUBROUTINE p4z_lys 139 155 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zmeso.F90
r775 r858 16 16 USE trp_trc ! 17 17 USE sms ! 18 USE prtctl_trc 18 19 19 20 IMPLICIT NONE … … 40 41 !! ** Method : - ??? 41 42 !!--------------------------------------------------------------------- 42 INTEGER :: ji, jj, jk 43 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 44 REAL(wp) :: zfact, zstep, zcompam, zdenom, zgraze2 43 INTEGER :: ji, jj, jk 44 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 45 REAL(wp) :: zfact, zstep, zcompam, zdenom, zgraze2 46 REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 47 #if defined key_kriest 48 REAL znumpoc 49 #endif 50 REAL(wp),DIMENSION(jpi,jpj,jpk) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 51 REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazn,zgrazpoc,zgraznf,zgrazf 52 REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazfff,zgrazffe 53 CHARACTER (len=25) :: charout 45 54 !!--------------------------------------------------------------------- 46 55 … … 60 69 ! Respiration rates of both zooplankton 61 70 ! ------------------------------------- 62 respz2(ji,jj,jk)= resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) ) &63 & 71 zrespz2(ji,jj,jk) = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) ) & 72 & * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 64 73 65 74 ! Zooplankton mortality. A square function has been selected with … … 67 76 ! mimic predation. 68 77 ! --------------------------------------------------------------- 69 tortz2(ji,jj,jk) = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes)78 ztortz2(ji,jj,jk) = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 70 79 ! 71 80 END DO … … 73 82 END DO 74 83 75 DO jk = 1, jpkm1 76 DO jj = 1, jpj77 DO ji = 1, jpi78 84 85 DO jk = 1,jpkm1 86 DO jj = 1,jpj 87 DO ji = 1,jpi 79 88 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 80 89 zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) … … 95 104 & * trn(ji,jj,jk,jpmes) 96 105 97 grazd (ji,jj,jk) = zgraze2 * xprefc * zcompadi 98 grazz (ji,jj,jk) = zgraze2 * xprefz * zcompaz 99 grazn (ji,jj,jk) = zgraze2 * xprefp * zcompaph 100 grazpoc(ji,jj,jk) = zgraze2 * xprefpoc * zcompapoc 101 102 graznf (ji,jj,jk) = grazn (ji,jj,jk) * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 103 104 graznch(ji,jj,jk) = grazn (ji,jj,jk) * trn(ji,jj,jk,jpnch) / (trn(ji,jj,jk,jpphy) + rtrn) 105 106 grazs (ji,jj,jk) = grazd (ji,jj,jk) * trn(ji,jj,jk,jpbsi) / (trn(ji,jj,jk,jpdia) + rtrn) 107 108 grazf (ji,jj,jk) = grazd (ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 109 110 grazdch(ji,jj,jk) = grazd (ji,jj,jk) * trn(ji,jj,jk,jpdch) / (trn(ji,jj,jk,jpdia) + rtrn) 111 112 grazpof(ji,jj,jk) = grazpoc(ji,jj,jk) * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 113 END DO 114 END DO 115 END DO 116 117 DO jk = 1, jpkm1 118 DO jj = 1, jpj 119 DO ji = 1, jpi 120 106 zgrazd(ji,jj,jk) = zgraze2 * xprefc * zcompadi 107 zgrazz(ji,jj,jk) = zgraze2 * xprefz * zcompaz 108 zgrazn(ji,jj,jk) = zgraze2 * xprefp * zcompaph 109 zgrazpoc(ji,jj,jk) = zgraze2 * xprefpoc * zcompapoc 110 111 zgraznf(ji,jj,jk) = zgrazn(ji,jj,jk) * trn(ji,jj,jk,jpnfe) & 112 & / (trn(ji,jj,jk,jpphy) + rtrn) 113 zgrazf(ji,jj,jk) = zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) & 114 & / (trn(ji,jj,jk,jpdia) + rtrn) 115 zgrazpof(ji,jj,jk) = zgrazpoc(ji,jj,jk) * trn(ji,jj,jk,jpsfe) & 116 & / (trn(ji,jj,jk,jppoc) + rtrn) 117 END DO 118 END DO 119 END DO 120 121 122 DO jk = 1,jpkm1 123 DO jj = 1,jpj 124 DO ji = 1,jpi 125 121 126 ! Mesozooplankton flux feeding on GOC 122 127 ! ---------------------------------- 123 128 # if ! defined key_kriest 124 grazffe(ji,jj,jk) = 5.e3 * zstep * wsbio4(ji,jj,jk) &129 zgrazffe(ji,jj,jk) = 5.e3 * zstep * wsbio4(ji,jj,jk) & 125 130 # if defined key_off_degrad 126 131 & * facvol(ji,jj,jk) & … … 128 133 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 129 134 130 grazfff(ji,jj,jk) = grazffe(ji,jj,jk)&135 zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk) & 131 136 & * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 132 137 # else 133 138 ! KRIEST3 134 grazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk) &139 zgrazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk) & 135 140 & * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) & 136 141 # if defined key_off_degrad … … 139 144 & / (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 140 145 141 !!C grazffe(ji,jj,jk) = 5.e3 * zstep * wsbio3(ji,jj,jk)146 !!C zgrazffe(ji,jj,jk) = 5.e3 * zstep * wsbio3(ji,jj,jk) 142 147 !!C & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 143 148 !!C# if defined key_off_degrad … … 145 150 !!C# endif 146 151 147 grazfff(ji,jj,jk) = grazffe(ji,jj,jk)&152 zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk) & 148 153 & * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 149 154 # endif 155 END DO 156 END DO 157 END DO 158 159 160 DO jk = 1,jpkm1 161 DO jj = 1,jpj 162 DO ji = 1,jpi 163 164 ! Mesozooplankton efficiency 165 ! -------------------------- 166 zgrarem2 = ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 167 & + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) ) & 168 & * ( 1. - epsher2 - unass2 ) 169 #if ! defined key_kriest 170 zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 171 & * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff (ji,jj,jk))*(1.-epsher2-unass2) & 172 & + epsher2 * ( & 173 & zgrazd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 174 & + zgrazn(ji,jj,jk) * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 175 & + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 176 & + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.) ) 177 #else 178 zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 179 & * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) )*(1.-epsher2-unass2) & 180 & + epsher2 * ( & 181 & zgrazd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 182 & + zgrazn(ji,jj,jk) * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 183 & + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 184 & + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) ) 185 186 #endif 187 zgrapoc2 = (zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 188 & + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk)) * unass2 189 190 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 191 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 192 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * (1.-sigma2) 193 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 194 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 195 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem2 * sigma2 196 197 #if defined key_kriest 198 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 199 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_nmeso 200 #else 201 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 202 #endif 150 203 END DO 151 204 END DO … … 155 208 DO jj = 1, jpj 156 209 DO ji = 1, jpi 157 158 ! Mesozooplankton efficiency159 ! --------------------------160 grarem2(ji,jj,jk) = (grazd(ji,jj,jk) + grazz(ji,jj,jk) &161 & + grazn(ji,jj,jk) + grazpoc(ji,jj,jk) + grazffe(ji,jj,jk)) &162 & * (1.-epsher2-unass2)163 #if ! defined key_kriest164 grafer2(ji,jj,jk) = (grazf(ji,jj,jk) + graznf(ji,jj,jk) &165 & + grazz(ji,jj,jk) * ferat3 + grazpof(ji,jj,jk) &166 & + grazfff(ji,jj,jk)) * (1.-epsher2-unass2) &167 & + epsher2 * (grazd(ji,jj,jk) * MAX( &168 & (trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) &169 & -ferat3),0.) + grazn(ji,jj,jk) * MAX( &170 & (trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) &171 & -ferat3),0.) + grazpoc(ji,jj,jk) * MAX( &172 & (trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) &173 & -ferat3),0.) + grazffe(ji,jj,jk) * MAX( &174 & (trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) &175 & -ferat3),0.) )176 #else177 grafer2(ji,jj,jk) = (grazf(ji,jj,jk) + graznf(ji,jj,jk) &178 & + grazz(ji,jj,jk) * ferat3 + grazpof(ji,jj,jk) &179 & + grazfff(ji,jj,jk)) * (1.-epsher2-unass2) &180 & + epsher2 * (grazd(ji,jj,jk) * MAX( &181 & (trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) &182 & -ferat3),0.) + grazn(ji,jj,jk) * MAX( &183 & (trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) &184 & -ferat3),0.) + grazpoc(ji,jj,jk) * MAX( &185 & (trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) &186 & -ferat3),0.) + grazffe(ji,jj,jk) * MAX( &187 & (trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) &188 & -ferat3),0.) )189 #endif190 grapoc2(ji,jj,jk) = (grazd(ji,jj,jk) + grazz(ji,jj,jk) &191 & + grazn(ji,jj,jk) + grazpoc(ji,jj,jk) + grazffe(ji,jj,jk)) * unass2192 210 ! 211 ! Update the arrays TRA which contain the biological sources and sinks 212 ! -------------------------------------------------------------------- 213 zmortz2 = ztortz2(ji,jj,jk) + zrespz2(ji,jj,jk) 214 tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 & 215 & + epsher2 * ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 216 & + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) ) 217 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd(ji,jj,jk) 218 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz(ji,jj,jk) 219 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn(ji,jj,jk) 220 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn(ji,jj,jk) * trn(ji,jj,jk,jpnch) & 221 & / ( trn(ji,jj,jk,jpphy) + rtrn ) 222 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 223 & / ( trn(ji,jj,jk,jpdia) + rtrn ) 224 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 225 & / ( trn(ji,jj,jk,jpdia) + rtrn ) 226 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 227 & / ( trn(ji,jj,jk,jpdia) + rtrn ) 228 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf(ji,jj,jk) 229 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf(ji,jj,jk) 230 231 zprcaca = xfracal(ji,jj,jk) * part * unass2 * zgrazn(ji,jj,jk) 232 233 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 234 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 235 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 236 #if defined key_kriest 237 znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 238 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2 & 239 & - zgrazpoc(ji,jj,jk) - zgrazffe(ji,jj,jk) 240 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc(ji,jj,jk) * znumpoc & 241 & + zmortz2 * xkr_nmeso & 242 & - zgrazffe(ji,jj,jk) * znumpoc * wsbio4(ji,jj,jk) & 243 & / ( wsbio3(ji,jj,jk) + rtrn ) 244 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 245 & + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 246 & + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 247 & - zgrazfff(ji,jj,jk) - zgrazpof(ji,jj,jk) 248 #else 249 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc(ji,jj,jk) 250 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe(ji,jj,jk) 251 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof(ji,jj,jk) 252 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 253 & + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 254 & + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 255 & - zgrazfff(ji,jj,jk) 256 #endif 257 193 258 END DO 194 259 END DO 195 260 END DO 196 261 ! 262 IF(ln_ctl) THEN ! print mean trends (used for debugging) 263 WRITE(charout, FMT="('meso')") 264 CALL prt_ctl_trc_info(charout) 265 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 266 ENDIF 267 197 268 END SUBROUTINE p4z_meso 198 269 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zmicro.F90
r775 r858 16 16 USE trp_trc ! 17 17 USE sms ! 18 USE prtctl_trc 18 19 19 20 IMPLICIT NONE … … 40 41 !! ** Method : - ??? 41 42 !!--------------------------------------------------------------------- 42 INTEGER :: ji, jj, jk 43 REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 44 REAL(wp) :: zgraze , zdenom , zdenom2 45 REAL(wp) :: zfact , zstep , zinano , zidiat, zipoc 43 INTEGER :: ji, jj, jk 44 REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 45 REAL(wp) :: zgraze , zdenom , zdenom2 46 REAL(wp) :: zfact , zstep , zinano , zidiat, zipoc 47 REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 48 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespz,ztortz 49 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazp, zgrazm, zgrazsd 50 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf 51 CHARACTER (len=25) :: charout 52 46 53 !!--------------------------------------------------------------------- 47 54 … … 62 69 ! ------------------------------------- 63 70 64 respz(ji,jj,jk) = resrat * zfact * ( 1.+ 3.* nitrfac(ji,jj,jk) ) &71 zrespz(ji,jj,jk) = resrat * zfact * ( 1.+ 3.* nitrfac(ji,jj,jk) ) & 65 72 & * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 66 73 … … 69 76 ! mimic predation. 70 77 ! --------------------------------------------------------------- 71 72 tortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 73 74 75 76 END DO 77 78 DO jk = 1, jpkm179 DO jj = 1, jpj80 DO ji = 1, jpi81 78 ztortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 79 80 END DO 81 END DO 82 END DO 83 84 85 86 DO jk = 1,jpkm1 87 DO jj = 1,jpj 88 DO ji = 1,jpi 82 89 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 83 90 zcompadi2 = MIN( zcompadi, 5.e-7 ) 84 91 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 85 92 zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 86 87 ! Microzooplankton grazing88 ! ------------------------93 94 ! Microzooplankton grazing 95 ! ------------------------ 89 96 zdenom2 = 1./ ( zprefp * zcompaph + zprefc * zcompapoc + zprefd * zcompadi2 + rtrn ) 90 97 … … 101 108 zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 102 109 103 grazp (ji,jj,jk) = zgraze * zinano * zcompaph * zdenom 104 grazm (ji,jj,jk) = zgraze * zipoc * zcompapoc * zdenom 105 grazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 106 107 grazpf (ji,jj,jk) = grazp (ji,jj,jk) * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 108 109 grazpch(ji,jj,jk) = grazp (ji,jj,jk) * trn(ji,jj,jk,jpnch) / (trn(ji,jj,jk,jpphy) + rtrn) 110 111 grazmf (ji,jj,jk) = grazm (ji,jj,jk) * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 112 113 grazsf (ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 114 115 grazss (ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) / (trn(ji,jj,jk,jpdia) + rtrn) 116 117 grazsch(ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpdch) / (trn(ji,jj,jk,jpdia) + rtrn) 118 119 END DO 120 END DO 121 END DO 110 zgrazp(ji,jj,jk) = zgraze * zinano * zcompaph * zdenom 111 zgrazm(ji,jj,jk) = zgraze * zipoc * zcompapoc * zdenom 112 zgrazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 113 114 zgrazpf (ji,jj,jk) = zgrazp(ji,jj,jk) * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 115 zgrazmf(ji,jj,jk) = zgrazm(ji,jj,jk) * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 116 zgrazsf(ji,jj,jk) = zgrazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 117 118 END DO 119 END DO 120 END DO 121 122 123 DO jk = 1,jpkm1 124 DO jj = 1,jpj 125 DO ji = 1,jpi 126 ! Various remineralization and excretion terms 127 ! -------------------------------------------- 128 129 zgrarem = ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk) ) & 130 & * ( 1.- epsher - unass ) 131 zgrafer = ( zgrazpf(ji,jj,jk) + zgrazsf(ji,jj,jk) + zgrazmf(ji,jj,jk) ) & 132 & * ( 1.- epsher - unass ) + epsher * & 133 & ( zgrazm(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) /(trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 134 & + zgrazp(ji,jj,jk) * MAX((trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 135 & + zgrazsd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 ) ) 136 zgrapoc = ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk) ) * unass 137 138 ! Update of the TRA arrays 139 ! ------------------------ 140 141 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem * sigma1 142 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem * sigma1 143 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem * (1.-sigma1) 144 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 145 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 146 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 147 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 148 #if defined key_kriest 149 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ndiat 150 #endif 151 END DO 152 END DO 153 END DO 154 155 ! 156 ! Update the arrays TRA which contain the biological sources and sinks 157 ! -------------------------------------------------------------------- 122 158 123 159 DO jk = 1, jpkm1 … … 125 161 DO ji = 1, jpi 126 162 127 ! Various remineralization and excretion terms 128 ! -------------------------------------------- 129 130 grarem(ji,jj,jk) = ( grazp(ji,jj,jk) + grazm (ji,jj,jk) & 131 & + grazsd(ji,jj,jk) ) * ( 1.- epsher - unass ) 132 133 grafer(ji,jj,jk) = ( grazpf(ji,jj,jk) + grazsf(ji,jj,jk) & 134 & + grazmf(ji,jj,jk) ) * ( 1.- epsher - unass ) & 135 & + ( grazm (ji,jj,jk) * MAX( (trn(ji,jj,jk,jpsfe) / & 136 & (trn(ji,jj,jk,jppoc) + rtrn) - ferat3), 0.e0 ) & 137 & + grazp (ji,jj,jk) * MAX( (trn(ji,jj,jk,jpnfe) / & 138 & (trn(ji,jj,jk,jpphy) + rtrn) - ferat3), 0.e0 ) & 139 & + grazsd(ji,jj,jk) * MAX( (trn(ji,jj,jk,jpdfe) / & 140 & (trn(ji,jj,jk,jpdia) + rtrn) - ferat3), 0.e0 ) ) * epsher 141 142 grapoc(ji,jj,jk) = ( grazp(ji,jj,jk) + grazm(ji,jj,jk) + grazsd(ji,jj,jk) ) * unass 143 163 zmortz = ztortz(ji,jj,jk) + zrespz(ji,jj,jk) 164 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz & 165 & + epsher * ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)) 166 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp(ji,jj,jk) 167 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd(ji,jj,jk) 168 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp(ji,jj,jk) & 169 & * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 170 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd(ji,jj,jk) & 171 & * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 172 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd(ji,jj,jk) & 173 & * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 174 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd(ji,jj,jk) & 175 & * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 176 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf(ji,jj,jk) 177 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf(ji,jj,jk) 178 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm(ji,jj,jk) 179 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz & 180 & + unass * ( zgrazpf(ji,jj,jk) + zgrazsf (ji,jj,jk)) & 181 & - (1.-unass) * zgrazmf(ji,jj,jk) 182 zprcaca = xfracal(ji,jj,jk) * part * unass * zgrazp(ji,jj,jk) 183 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 184 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal)- 2. * zprcaca 185 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 186 #if defined key_kriest 187 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm(ji,jj,jk) ) * xkr_ndiat 188 #endif 144 189 END DO 145 190 END DO 146 191 END DO 147 192 ! 193 IF(ln_ctl) THEN ! print mean trends (used for debugging) 194 WRITE(charout, FMT="('micro')") 195 CALL prt_ctl_trc_info(charout) 196 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 197 ENDIF 198 148 199 END SUBROUTINE p4z_micro 149 200 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4znano.F90
r775 r858 16 16 USE trp_trc ! 17 17 USE sms ! 18 USE prtctl_trc 18 19 19 20 IMPLICIT NONE … … 40 41 !! ** Method : - ??? 41 42 !!--------------------------------------------------------------------- 42 INTEGER :: ji, jj, jk 43 REAL(wp) :: zfact, zstep, zcompaph 43 INTEGER :: ji, jj, jk 44 REAL(wp) :: zstep, zcompaph 45 REAL(wp) :: zfactfe,zfactch,zprcaca,zfracal 46 REAL(wp) :: ztortp,zrespp,zmortp 47 CHARACTER (len=25) :: charout 44 48 !!--------------------------------------------------------------------- 45 49 … … 53 57 54 58 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 55 zfact = 1./ ( trn(ji,jj,jk,jpphy) + rtrn )56 59 57 60 ! Squared mortality of Phyto similar to a sedimentation term during 58 61 ! blooms (Doney et al. 1996) 59 62 ! ----------------------------------------------------------------- 60 respp(ji,jj,jk) = wchl * 1.e6 * zstep * zdiss(ji,jj,jk) &63 zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) & 61 64 # if defined key_off_degrad 62 & 65 & * facvol(ji,jj,jk) & 63 66 # endif 64 & * zcompaph * trn(ji,jj,jk,jpphy) 65 66 respnf (ji,jj,jk) = respp(ji,jj,jk) * trn(ji,jj,jk,jpnfe) * zfact 67 68 respnch(ji,jj,jk) = respp(ji,jj,jk) * trn(ji,jj,jk,jpnch) * zfact 67 & * zcompaph * trn(ji,jj,jk,jpphy) 69 68 70 69 ! Phytoplankton mortality. This mortality loss is slightly … … 72 71 ! as observed for instance in case of iron limitation. 73 72 ! ---------------------------------------------------------- 74 tortp (ji,jj,jk)= mprat * zstep * trn(ji,jj,jk,jpphy) &73 ztortp = mprat * zstep * trn(ji,jj,jk,jpphy) & 75 74 # if defined key_off_degrad 76 & 75 & * facvol(ji,jj,jk) & 77 76 # endif 78 & / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 77 & / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 78 79 79 80 tortnf (ji,jj,jk) = tortp(ji,jj,jk) * trn(ji,jj,jk,jpnfe) * zfact 81 82 tortnch(ji,jj,jk) = tortp(ji,jj,jk) * trn(ji,jj,jk,jpnch) * zfact 80 zmortp = zrespp + ztortp 83 81 82 ! Update the arrays TRA which contains the biological sources and sinks 83 84 zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn) 85 zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 86 87 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 88 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 89 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 90 zprcaca = xfracal(ji,jj,jk) * zmortp 91 zfracal = 0.5 * xfracal(ji,jj,jk) 92 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 93 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 94 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 95 #if defined key_kriest 96 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 97 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_nnano + zrespp * xkr_ndiat 98 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 99 #else 100 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp 101 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp 102 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe 103 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe 104 #endif 84 105 END DO 85 106 END DO 86 107 END DO 87 108 ! 109 IF(ln_ctl) THEN ! print mean trends (used for debugging) 110 WRITE(charout, FMT="('nano')") 111 CALL prt_ctl_trc_info(charout) 112 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 113 ENDIF 114 88 115 END SUBROUTINE p4z_nano 89 116 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zopt.F90
r775 r858 91 91 END DO 92 92 93 !CDIR NOVERRCHK 93 94 DO jj = 1,jpj 95 !CDIR NOVERRCHK 94 96 DO ji = 1,jpi 95 97 … … 108 110 END DO 109 111 112 !CDIR NOVERRCHK 110 113 DO jk = 2, jpkm1 114 !CDIR NOVERRCHK 111 115 DO jj = 1, jpj 116 !CDIR NOVERRCHK 112 117 DO ji = 1, jpi 113 118 … … 131 136 132 137 etot(:,:,:) = ze1(:,:,:) + ze2(:,:,:) + ze3(:,:,:) 138 enano(:,:,:) = 2.1 * ze1(:,:,:) + 0.42 * ze2(:,:,:) + 0.4 * ze3(:,:,:) 139 ediat(:,:,:) = 1.6 * ze1(:,:,:) + 0.69 * ze2(:,:,:) + 0.7 * ze3(:,:,:) 140 133 141 134 142 IF( ln_qsr_sms ) THEN … … 137 145 ! ------------------------------------------------------------------------------ 138 146 139 DO jj = 1, jpj 147 !CDIR NOVERRCHK 148 DO jj = 1, jpj 149 !CDIR NOVERRCHK 140 150 DO ji = 1, jpi 141 151 … … 155 165 END DO 156 166 167 !CDIR NOVERRCHK 157 168 DO jk = 2, jpkm1 169 !CDIR NOVERRCHK 158 170 DO jj = 1, jpj 171 !CDIR NOVERRCHK 159 172 DO ji = 1, jpi 160 173 … … 162 175 ! ------------------------------------------------- 163 176 164 zblight 1= zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1)165 zglight 1= zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1)166 zrlight 1= zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1)177 zblight = zekb(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 178 zglight = zekg(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 179 zrlight = zekr(ji,jj,jk-1) * fse3t(ji,jj,jk-1) 167 180 168 181 ze3lum(ji,jj,jk) = ze3lum(ji,jj,jk-1) * EXP( -zblight ) … … 182 195 ! --------------------------------- 183 196 184 zmeu(:,:) = 300.e0197 heup(:,:) = 300.e0 185 198 186 199 DO jk = 2, jpkm1 187 200 DO jj = 1, jpj 188 201 DO ji = 1, jpi 189 IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) zmeu(ji,jj) = fsdepw(ji,jj,jk+1)190 END DO 191 END DO 192 END DO 193 194 zmeu(:,:) = MIN( 300., zmeu(:,:) )202 IF( etot(ji,jj,jk) >= 0.0043 * qsr(ji,jj) ) heup(ji,jj) = fsdepw(ji,jj,jk+1) 203 END DO 204 END DO 205 END DO 206 207 heup(:,:) = MIN( 300., heup(:,:) ) 195 208 196 209 ! Computation of the mean light over the mixed layer depth … … 224 237 END DO 225 238 239 226 240 # if defined key_trc_diaadd 227 trc2d(:,:,11) = zmeu(:,:)241 trc2d(:,:,11) = heup(:,:) 228 242 # endif 229 243 ! -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zprg.F90
r775 r858 25 25 USE p4zlys ! 26 26 USE p4zflx ! 27 27 28 28 IMPLICIT NONE 29 29 PRIVATE … … 54 54 INTEGER :: jnt, jn 55 55 INTEGER :: iyy, imm, idd 56 57 56 58 !!--------------------------------------------------------------------- 57 59 … … 74 76 DO jnt = 1, nrdttrc ! ??? 75 77 ! 76 CALL p4z_bio ! Compute soft tissue production (POC) 78 CALL p4z_bio ( kt ) ! Compute soft tissue production (POC) 79 77 80 78 81 CALL p4z_sed ! compute soft tissue remineralisation 82 79 83 ! 80 84 trb(:,:,:,:) = trn(:,:,:,:) … … 84 88 CALL p4z_lys ! Compute CaCO3 saturation 85 89 86 CALL p4z_flx ! Compute surface fluxes90 CALL p4z_flx( kt ) ! Compute surface fluxes 87 91 88 DO jn = 1, jptra 92 93 DO jn = jp_pcs0, jp_pcs1 89 94 CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 90 95 CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zprod.F90
r775 r858 17 17 USE sms ! 18 18 USE p4zday ! 19 19 USE prtctl_trc 20 20 21 IMPLICIT NONE 21 22 PRIVATE … … 23 24 PUBLIC p4z_prod ! called in p4zbio.F90 24 25 26 25 27 !!* Substitution 26 28 # include "domzgr_substitute.h90" … … 33 35 CONTAINS 34 36 35 SUBROUTINE p4z_prod 37 SUBROUTINE p4z_prod( kt ) 36 38 !!--------------------------------------------------------------------- 37 39 !! *** ROUTINE p4z_prod *** … … 42 44 !! ** Method : - ??? 43 45 !!--------------------------------------------------------------------- 44 INTEGER :: ji, jj, jk 45 REAL(wp) :: zsilfac, zfact 46 INTEGER, INTENT(in) :: kt 47 INTEGER :: ji, jj, jk, nspyr 48 REAL(wp) :: zsilfac, zfact, zrfact2 46 49 REAL(wp) :: zprdiachl, zprbiochl, zsilim, ztn, zadap, zadap2 47 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod 48 REAL(wp) :: zmxltst, zmxlday, zlim1 49 REAL(wp), DIMENSION(jpi,jpj) :: zmixnano , zmixdiat 50 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopen, zpislope2n 51 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsopt , zpislopead 52 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprdia , zprbio 53 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zetot2 , zpislopead2 50 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zetot2, zmax, zproreg, zproreg2 51 REAL(wp) :: zmxltst, zmxlday, zlim1, zexcret, zexcret2 52 REAL(wp) :: zpislopen , zpislope2n 53 REAL(wp), DIMENSION(jpi,jpj) :: zmixnano , zmixdiat 54 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopead , zpislopead2 55 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprdia , zprbio, zysopt 56 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorca , zprorca2, zprorca4 57 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprorca5 , zprorca6, zprorca7 58 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpronew , zpronew2 59 CHARACTER (len=25) :: charout 54 60 !!--------------------------------------------------------------------- 61 62 zprorca (:,:,:) = 0.0 63 zprorca2(:,:,:) = 0.0 64 zprorca4(:,:,:) = 0.0 65 zprorca5(:,:,:) = 0.0 66 zprorca6(:,:,:) = 0.0 67 zprorca7(:,:,:) = 0.0 68 zpronew (:,:,:) = 0.0 69 zpronew2(:,:,:) = 0.0 70 zprdia (:,:,:) = 0.0 71 zprbio (:,:,:) = 0.0 72 zysopt (:,:,:) = 0.0 73 74 nspyr = INT( raass / rdt ) 75 76 zexcret = 1. - excret 77 zexcret2 = 1. - excret2 55 78 56 79 ! Computation of the optimal production … … 65 88 CALL p4z_day ! Computation of the day length 66 89 67 68 DO jk = 1, jpkm1 69 DO jj = 1, jpj 90 !CDIR NOVERRCHK 91 DO jk = 1, jpkm1 92 !CDIR NOVERRCHK 93 DO jj = 1, jpj 94 !CDIR NOVERRCHK 70 95 DO ji = 1, jpi 71 96 72 97 ! Computation of the P-I slope for nanos and diatoms 73 98 ! -------------------------------------------------- 74 75 ztn = MAX( 0., tn(ji,jj,jk) - 15. ) 76 zadap = 1.+ 2.* ztn / ( 2.+ ztn ) 77 zadap2 = 1.e0 78 79 zfact = EXP( -0.21 * emoy(ji,jj,jk) ) 80 81 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) 82 zpislopead2(ji,jj,jk) = pislope2 * ( 1.+ zadap2 * zfact ) 83 84 zpislopen(ji,jj,jk) = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) & 85 & / ( trn(ji,jj,jk,jpphy) * 12. + rtrn ) & 86 & / ( prmax(ji,jj,jk) * rjjss * xlimphy(ji,jj,jk) + rtrn ) 87 88 zpislope2n(ji,jj,jk) = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 89 & / ( trn(ji,jj,jk,jpdia) * 12. + rtrn ) & 90 & / ( prmax(ji,jj,jk) * rjjss * xlimdia(ji,jj,jk) + rtrn ) 91 92 END DO 93 END DO 94 END DO 95 96 DO jk = 1, jpkm1 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 100 ztn = MAX( 0., tn(ji,jj,jk) - 15. ) 101 zadap = 0.+ 1.* ztn / ( 2.+ ztn ) 102 zadap2 = 0.e0 103 104 zfact = EXP( -0.21 * emoy(ji,jj,jk) ) 105 106 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) 107 zpislopead2(ji,jj,jk) = pislope2 * ( 1.+ zadap2 * zfact ) 108 109 zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) & 110 & / ( trn(ji,jj,jk,jpphy) * 12. + rtrn ) & 111 & / ( prmax(ji,jj,jk) * rjjss * xlimphy(ji,jj,jk) + rtrn ) 112 113 zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 114 & / ( trn(ji,jj,jk,jpdia) * 12. + rtrn ) & 115 & / ( prmax(ji,jj,jk) * rjjss * xlimdia(ji,jj,jk) + rtrn ) 99 116 100 117 ! Computation of production function 101 118 ! ---------------------------------- 102 119 103 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen (ji,jj,jk) * etot(ji,jj,jk) ) ) 104 zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n(ji,jj,jk) * etot(ji,jj,jk) ) ) 105 106 END DO 107 END DO 108 END DO 109 110 DO jk = 1, jpkm1 111 DO jj = 1, jpj 112 DO ji = 1, jpi 113 120 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * & 121 & ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 122 zprdia(ji,jj,jk) = prmax(ji,jj,jk) * & 123 & ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 124 ENDIF 125 END DO 126 END DO 127 END DO 128 129 130 DO jk = 1, jpkm1 131 DO jj = 1, jpj 132 DO ji = 1, jpi 133 134 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 114 135 ! Si/C of diatoms 115 136 ! ------------------------ … … 118 139 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 119 140 120 zlim1 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 )121 zlim = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk)122 123 zsilim = MIN( zprdia(ji,jj,jk) / ( rtrn + prmax(ji,jj,jk) ), &141 zlim1 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 142 zlim = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 143 144 zsilim = MIN( zprdia(ji,jj,jk) / ( rtrn + prmax(ji,jj,jk) ), & 124 145 & trn(ji,jj,jk,jpfer) / ( concdfe(ji,jj,jk) + trn(ji,jj,jk,jpfer) ), & 125 146 & trn(ji,jj,jk,jppo4) / ( concdnh4 + trn(ji,jj,jk,jppo4) ), & 126 147 & zlim ) 127 zsilfac = 5.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim1 - 0.5 ) ) ) + 1.e0128 zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) )129 zsilfac2 = 1.+ 3.* zsiborn / ( zsiborn + xksi2 )130 zsilfac = MIN( 6.4,zsilfac * zsilfac2)131 132 zsopt(ji,jj,jk) = grosip * trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) * zsilfac 133 148 zsilfac = 5.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim1 - 0.5 ) ) ) + 1.e0 149 zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) ) 150 zsilfac2 = 1.+ 3.* zsiborn / ( zsiborn + xksi2 ) 151 zsilfac = MIN( 6.4,zsilfac * zsilfac2) 152 zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac 153 154 ENDIF 134 155 END DO 135 156 END DO … … 142 163 DO jj = 1, jpj 143 164 DO ji = 1, jpi 144 zmxltst = MAX( 0.e0, hmld(ji,jj) - zmeu(ji,jj) )165 zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 145 166 zmxlday = zmxltst**2 / rjjss 146 167 zmixnano(ji,jj) = 1.- zmxlday / ( 1.+ zmxlday ) … … 163 184 END DO 164 185 165 DO jk = 1, jpkm1 166 167 186 187 DO jj = 1, jpj 188 DO ji = 1, jpi 168 189 169 190 ! Computation of the maximum light intensity 170 191 ! ------------------------------------------ 171 zetot2(ji,jj,jk) = etot(ji,jj,jk) * 24. / ( strn(ji,jj) + rtrn ) 172 IF( strn(ji,jj) < 1.e0 ) zetot2(ji,jj,jk) = etot(ji,jj,jk) 173 174 END DO 175 END DO 176 END DO 177 178 DO jk = 1, jpkm1 179 DO jj = 1, jpj 180 DO ji = 1, jpi 181 192 IF( strn(ji,jj) < 1.e0 ) strn(ji,jj) = 24. 193 END DO 194 END DO 195 196 !CDIR NOVERRCHK 197 DO jk = 1, jpkm1 198 !CDIR NOVERRCHK 199 DO jj = 1, jpj 200 !CDIR NOVERRCHK 201 DO ji = 1, jpi 202 203 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 182 204 ! Computation of the various production terms for nanophyto. 183 205 ! ---------------------------------------------------------- 184 zpislopen(ji,jj,jk) = zpislopead(ji,jj,jk) & 185 & * trn(ji,jj,jk,jpnch) / ( rtrn + trn(ji,jj,jk,jpphy) * 12.) & 186 & / ( prmax(ji,jj,jk) * rjjss * MAX( 0.1, xlimphy(ji,jj,jk) ) + rtrn ) 187 188 zprbiochl = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen(ji,jj,jk) * zetot2(ji,jj,jk) ) ) 189 190 prorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 191 192 pronew(ji,jj,jk) = prorca(ji,jj,jk) * xnanono3(ji,jj,jk) & 206 zetot2 = enano(ji,jj,jk) * 24. / ( strn(ji,jj) + rtrn ) 207 zmax = MAX( 0.1, xlimphy(ji,jj,jk) ) 208 zpislopen = zpislopead(ji,jj,jk) & 209 & * trn(ji,jj,jk,jpnch) / ( rtrn + trn(ji,jj,jk,jpphy) * 12.) & 210 & / ( prmax(ji,jj,jk) * rjjss * zmax + rtrn ) 211 212 zprbiochl = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * zetot2 ) ) 213 214 zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 215 216 zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) & 193 217 & / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 194 proreg(ji,jj,jk) = prorca(ji,jj,jk) - pronew(ji,jj,jk)195 196 zprod = rjjss * prorca(ji,jj,jk) * zprbiochl * trn(ji,jj,jk,jpphy)&197 & * MAX( 0.1, xlimphy(ji,jj,jk))198 199 prorca5(ji,jj,jk) = (fecnm)**2 * zprod / chlcnm&200 & / ( zpislopead(ji,jj,jk) * zetot2 (ji,jj,jk) * trn(ji,jj,jk,jpnfe) + rtrn )201 202 prorca6(ji,jj,jk) = chlcnm * 144. * zprod &203 & / ( zpislopead(ji,jj,jk) * zetot2(ji,jj,jk) * trn(ji,jj,jk,jpnch) + rtrn )204 205 END DO 206 END DO 207 END DO208 209 DO jk = 1, jpkm1210 DO jj = 1, jpj 211 DO ji = 1, jpi 212 218 zprod = rjjss * zprorca(ji,jj,jk) * zprbiochl * trn(ji,jj,jk,jpphy) *zmax 219 220 zprorca5(ji,jj,jk) = (fecnm)**2 * zprod / chlcnm & 221 & / ( zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnfe) + rtrn ) 222 223 zprorca6(ji,jj,jk) = chlcnm * 144. * zprod & 224 & / ( zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnch) + rtrn ) 225 ENDIF 226 END DO 227 END DO 228 END DO 229 230 !CDIR NOVERRCHK 231 DO jk = 1, jpkm1 232 !CDIR NOVERRCHK 233 DO jj = 1, jpj 234 !CDIR NOVERRCHK 235 DO ji = 1, jpi 236 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 213 237 ! Computation of the various production terms for diatoms 214 238 ! ------------------------------------------------------- 215 zpislope2n(ji,jj,jk) = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 216 & / ( rtrn + trn(ji,jj,jk,jpdia) * 12.) & 217 & / ( prmax(ji,jj,jk) * rjjss * MAX( 0.1, xlimdia(ji,jj,jk) ) + rtrn ) 218 219 zprdiachl = prmax(ji,jj,jk) * ( 1.- EXP( -zetot2(ji,jj,jk) * zpislope2n(ji,jj,jk) ) ) 220 221 prorca2(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 222 223 pronew2(ji,jj,jk) = prorca2(ji,jj,jk) * xdiatno3(ji,jj,jk) & 239 zetot2 = ediat(ji,jj,jk) * 24. / ( strn(ji,jj) + rtrn ) 240 zmax = MAX( 0.1, xlimdia(ji,jj,jk) ) 241 zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 242 & / ( rtrn + trn(ji,jj,jk,jpdia) * 12.) & 243 & / ( prmax(ji,jj,jk) * rjjss * zmax + rtrn ) 244 245 zprdiachl = prmax(ji,jj,jk) * ( 1.- EXP( -zetot2 * zpislope2n ) ) 246 247 zprorca2(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 248 249 zpronew2(ji,jj,jk) = zprorca2(ji,jj,jk) * xdiatno3(ji,jj,jk) & 224 250 & / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 225 proreg2(ji,jj,jk) = prorca2(ji,jj,jk) - pronew2(ji,jj,jk) 226 prorca3(ji,jj,jk) = prorca2(ji,jj,jk) * zsopt(ji,jj,jk) 227 228 zprod=rjjss * prorca2(ji,jj,jk) * zprdiachl * trn(ji,jj,jk,jpdia) * MAX( 0.1, xlimdia(ji,jj,jk) ) 229 230 prorca4(ji,jj,jk) = (fecdm)**2 * zprod / chlcdm & 231 & / ( zpislopead2(ji,jj,jk) * zetot2(ji,jj,jk) * trn(ji,jj,jk,jpdfe) + rtrn ) 232 233 prorca7(ji,jj,jk) = chlcdm * 144. * zprod & 234 & / ( zpislopead2(ji,jj,jk) * zetot2(ji,jj,jk) * trn(ji,jj,jk,jpdch) + rtrn ) 235 251 252 zprod = rjjss * zprorca2(ji,jj,jk) * zprdiachl * trn(ji,jj,jk,jpdia) * zmax 253 254 zprorca4(ji,jj,jk) = (fecdm)**2 * zprod / chlcdm & 255 & / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdfe) + rtrn ) 256 257 zprorca7(ji,jj,jk) = chlcdm * 144. * zprod & 258 & / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdch) + rtrn ) 259 260 ENDIF 236 261 END DO 237 262 END DO 238 263 END DO 239 264 ! 265 266 ! 267 ! Update the arrays TRA which contain the biological sources and sinks 268 ! -------------------------------------------------------------------- 269 270 DO jk = 1, jpkm1 271 DO jj = 1, jpj 272 DO ji =1 ,jpi 273 zproreg = zprorca(ji,jj,jk) - zpronew(ji,jj,jk) 274 zproreg2 = zprorca2(ji,jj,jk) - zpronew2(ji,jj,jk) 275 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorca2(ji,jj,jk) 276 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronew2(ji,jj,jk) 277 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 278 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * zexcret 279 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprorca6(ji,jj,jk) * zexcret 280 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprorca5(ji,jj,jk) * zexcret 281 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorca2(ji,jj,jk) * zexcret2 282 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprorca7(ji,jj,jk) * zexcret2 283 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprorca4(ji,jj,jk) * zexcret2 284 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) + zprorca2(ji,jj,jk) * zysopt(ji,jj,jk) * zexcret2 285 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + & 286 & excret2 * zprorca2(ji,jj,jk) + excret * zprorca(ji,jj,jk) 287 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 288 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronew2(ji,jj,jk) ) 289 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) & 290 & - zexcret * zprorca5(ji,jj,jk) - zexcret2 * zprorca4(ji,jj,jk) 291 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) & 292 & - zexcret2 * zprorca2(ji,jj,jk) * zysopt(ji,jj,jk) 293 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorca2(ji,jj,jk) 294 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) & 295 & + rno3 * ( zpronew(ji,jj,jk) + zpronew2(ji,jj,jk) ) 296 END DO 297 END DO 298 END DO 299 300 301 DO jk = 1, jpkm1 302 DO jj = 1, jpj 303 DO ji = 1, jpi 304 qcumul(2) = qcumul(2) + ( zprorca(ji,jj,jk) + zprorca2(ji,jj,jk) ) & 305 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask_i(ji,jj) 306 END DO 307 END DO 308 END DO 309 310 IF( MOD( kt, nspyr ) == 0 ) THEN 311 WRITE(numout,*) 'Total PP :' 312 WRITE(numout,*) '-------------------- : ',qcumul(2)*12./1E12 313 WRITE(numout,*) '(GtC/an)' 314 qcumul(2) = 0. 315 ENDIF 316 317 #if defined key_trc_dia3d 318 zrfact2 = 1.e3 * rfact2r 319 ! Supplementary diagnostics 320 ! ------------------------- 321 trc3d(:,:,:,4) = etot(:,:,:) 322 trc3d(:,:,:,5) = zprorca(:,:,:) * zrfact2 323 trc3d(:,:,:,6) = zprorca2(:,:,:) * zrfact2 324 trc3d(:,:,:,7) = zpronew(:,:,:) * zrfact2 325 trc3d(:,:,:,8) = zpronew2(:,:,:) * zrfact2 326 trc3d(:,:,:,9) = zprorca2(:,:,:) * zysopt(:,:,:) * zrfact2 327 trc3d(:,:,:,10) = zprorca4(:,:,:) * zrfact2 328 #if ! defined key_kriest 329 trc3d(:,:,:,11) = zprorca5(:,:,:) * zrfact2 330 #endif 331 #endif 332 333 IF(ln_ctl) THEN ! print mean trends (used for debugging) 334 WRITE(charout, FMT="('prod')") 335 CALL prt_ctl_trc_info(charout) 336 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 337 ENDIF 338 240 339 END SUBROUTINE p4z_prod 241 340 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zrem.F90
r775 r858 17 17 USE trp_trc ! 18 18 USE sms ! 19 USE prtctl_trc 19 20 20 21 IMPLICIT NONE … … 45 46 REAL(wp) :: zkeq , zfeequi, zsiremin 46 47 REAL(wp) :: zsatur, zsatur2, znusil 47 REAL(wp) :: zlamfac, zstep 48 REAL(wp) :: zbactfer, zorem, zorem2, zofer, zofer2 49 REAL(wp) :: zosil, zdenom, zdenom1, zdenom2, zscave, zaggdfe 50 REAL(wp) :: zlamfac, zstep, zonitr 48 51 REAL(wp), DIMENSION(jpi,jpj) :: ztempbac 49 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zfesatur 52 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zfesatur, zolimi 53 CHARACTER (len=25) :: charout 54 50 55 !!--------------------------------------------------------------------- 51 56 … … 85 90 nitrfac(:,:,:) = MIN( 1., nitrfac(:,:,:) ) 86 91 92 87 93 DO jk = 1, jpkm1 88 94 DO jj = 1, jpj … … 102 108 ! Ammonification in oxic waters with oxygen consumption 103 109 ! ----------------------------------------------------- 104 olimi(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,&110 zolimi(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, & 105 111 & zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc) ) 106 112 107 113 ! Ammonification in suboxic waters with denitrification 108 114 ! ------------------------------------------------------- 109 denitr(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit, 115 denitr(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit, & 110 116 & zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc) ) 111 117 END DO … … 113 119 END DO 114 120 115 olimi (:,:,:) = MAX( 0.e0,olimi (:,:,:) )116 denitr (:,:,:) = MAX( 0.e0, denitr(:,:,:) )121 zolimi (:,:,:) = MAX( 0.e0, zolimi (:,:,:) ) 122 denitr (:,:,:) = MAX( 0.e0, denitr (:,:,:) ) 117 123 118 124 DO jk = 1, jpkm1 … … 123 129 ! below 2 umol/L. Inhibited at strong light 124 130 ! ---------------------------------------------------------- 125 onitr(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) & 126 # if defined key_off_degrad 127 & * facvol(ji,jj,jk) & 128 # endif 129 & * ( 1.- nitrfac(ji,jj,jk) ) 130 END DO 131 END DO 132 END DO 131 zonitr = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) & 132 # if defined key_off_degrad 133 & * facvol(ji,jj,jk) & 134 # endif 135 & * ( 1.- nitrfac(ji,jj,jk) ) 136 137 ! 138 ! Update of the tracers trends 139 ! ---------------------------- 140 141 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 142 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 143 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 144 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3 * zonitr 145 146 END DO 147 END DO 148 END DO 149 150 IF(ln_ctl) THEN ! print mean trends (used for debugging) 151 WRITE(charout, FMT="('rem1')") 152 CALL prt_ctl_trc_info(charout) 153 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 154 ENDIF 133 155 134 156 DO jk = 1, jpkm1 … … 141 163 ! significant 142 164 ! ---------------------------------------------------------- 143 xbactfer(ji,jj,jk)= 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk) &165 zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk) & 144 166 & * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))**2 & 145 167 & / ( xkgraz2 + zdepbac(ji,jj,jk) ) & 146 168 & * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 ) ) 147 169 148 END DO 149 END DO 150 END DO 170 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer 171 #if defined key_kriest 172 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer 173 #else 174 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer 175 #endif 176 177 END DO 178 END DO 179 END DO 180 181 IF(ln_ctl) THEN ! print mean trends (used for debugging) 182 WRITE(charout, FMT="('rem2')") 183 CALL prt_ctl_trc_info(charout) 184 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 185 ENDIF 151 186 152 187 DO jk = 1, jpkm1 … … 167 202 ! means a disaggregation constant about 0.5 the value in oxic zones 168 203 ! ----------------------------------------------------------------- 169 orem (ji,jj,jk)= zremip * trn(ji,jj,jk,jppoc)170 ofer (ji,jj,jk)= zremip * trn(ji,jj,jk,jpsfe)204 zorem = zremip * trn(ji,jj,jk,jppoc) 205 zofer = zremip * trn(ji,jj,jk,jpsfe) 171 206 #if ! defined key_kriest 172 orem2(ji,jj,jk) = zremip * trn(ji,jj,jk,jpgoc) 173 ofer2(ji,jj,jk) = zremip * trn(ji,jj,jk,jpbfe) 174 #else 175 orem2(ji,jj,jk) = zremip * trn(ji,jj,jk,jpnum) 176 #endif 177 END DO 178 END DO 179 END DO 207 zorem2 = zremip * trn(ji,jj,jk,jpgoc) 208 zofer2 = zremip * trn(ji,jj,jk,jpbfe) 209 #else 210 zorem2 = zremip * trn(ji,jj,jk,jpnum) 211 #endif 212 213 ! Update the appropriate tracers trends 214 ! ------------------------------------- 215 216 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 217 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 218 #if defined key_kriest 219 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 220 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zorem2 221 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 222 #else 223 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem2 - zorem 224 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 225 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer2 - zofer 226 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 227 #endif 228 229 END DO 230 END DO 231 END DO 232 233 IF(ln_ctl) THEN ! print mean trends (used for debugging) 234 WRITE(charout, FMT="('rem3')") 235 CALL prt_ctl_trc_info(charout) 236 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 237 ENDIF 180 238 181 239 DO jk = 1, jpkm1 … … 194 252 zsiremin = xsirem * zstep * znusil 195 253 # endif 196 osil(ji,jj,jk) = zsiremin * trn(ji,jj,jk,jpdsi) 254 zosil = zsiremin * trn(ji,jj,jk,jpdsi) 255 256 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 257 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 258 197 259 ! 198 260 END DO … … 200 262 END DO 201 263 264 IF(ln_ctl) THEN ! print mean trends (used for debugging) 265 WRITE(charout, FMT="('rem4')") 266 CALL prt_ctl_trc_info(charout) 267 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 268 ENDIF 269 202 270 zfesatur(:,:,:) = 0.6e-9 203 204 DO jk = 1, jpkm1 205 DO jj = 1, jpj 206 DO ji = 1, jpi 271 !CDIR NOVERRCHK 272 DO jk = 1, jpkm1 273 !CDIR NOVERRCHK 274 DO jj = 1, jpj 275 !CDIR NOVERRCHK 276 DO ji = 1, jpi 277 ! 278 ! Compute de different ratios for scavenging of iron 279 ! -------------------------------------------------- 280 281 #if defined key_kriest 282 zdenom1 = trn(ji,jj,jk,jppoc) / & 283 & ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 284 #else 285 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) & 286 & + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 287 288 zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 289 zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 290 #endif 291 207 292 208 293 ! scavenging rate of iron. this scavenging rate depends on the … … 222 307 #endif 223 308 # if defined key_off_degrad 224 xscave(ji,jj,jk)= zfeequi * zlam1b * zstep * facvol(ji,jj,jk)309 zscave = zfeequi * zlam1b * zstep * facvol(ji,jj,jk) 225 310 # else 226 xscave(ji,jj,jk)= zfeequi * zlam1b * zstep311 zscave = zfeequi * zlam1b * zstep 227 312 # endif 228 313 … … 236 321 zlam1b = ( 80.* ( trn(ji,jj,jk,jpdoc) + 35.e-6 ) & 237 322 & + 698.* trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc) ) & 238 & * zdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac) &323 & * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac) & 239 324 & + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.) ) 240 325 #else 241 326 zlam1b = ( 80.* (trn(ji,jj,jk,jpdoc) + 35E-6) & 242 327 & + 698.* trn(ji,jj,jk,jppoc) ) & 243 & * zdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac) &328 & * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac) & 244 329 & + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.) ) 245 330 #endif 246 331 247 332 # if defined key_off_degrad 248 xaggdfe(ji,jj,jk)= zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk)333 zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk) 249 334 # else 250 xaggdfe(ji,jj,jk) = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 251 # endif 335 zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 336 # endif 337 338 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 339 340 #if defined key_kriest 341 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 342 #else 343 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 344 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 345 #endif 346 252 347 END DO 253 348 END DO 254 349 END DO 255 350 ! 351 352 IF(ln_ctl) THEN ! print mean trends (used for debugging) 353 WRITE(charout, FMT="('rem5')") 354 CALL prt_ctl_trc_info(charout) 355 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 356 ENDIF 357 358 ! Update the arrays TRA which contain the biological sources and sinks 359 ! -------------------------------------------------------------------- 360 361 DO jk = 1, jpkm1 362 tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi(:,:,jk) + denitr(:,:,jk) 363 tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi(:,:,jk) + denitr(:,:,jk) 364 tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr(:,:,jk) * rdenit 365 tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi(:,:,jk) - denitr(:,:,jk) 366 tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi(:,:,jk) * o2ut 367 tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi(:,:,jk) + denitr(:,:,jk) 368 tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit 369 END DO 370 371 IF(ln_ctl) THEN ! print mean trends (used for debugging) 372 WRITE(charout, FMT="('rem6')") 373 CALL prt_ctl_trc_info(charout) 374 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 375 ENDIF 376 256 377 END SUBROUTINE p4z_rem 257 378 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsed.F90
r775 r858 17 17 USE sms 18 18 USE lib_mpp 19 USE prtctl_trc 20 19 21 20 22 IMPLICIT NONE … … 50 52 REAL(wp), DIMENSION(jpi,jpj) :: zsidep 51 53 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znitrpot, zirondep 54 CHARACTER (len=25) :: charout 52 55 !!--------------------------------------------------------------------- 53 56 … … 221 224 DO ji = 2, jpim1 222 225 zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * e1t(ji,jj) * e2t(ji,jj) & 223 & *fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) * znegtr(ji,jj,jk)226 & *fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) * xnegtr(ji,jj,jk) 224 227 END DO 225 228 END DO … … 231 234 ! ------------------------------------------------------------- 232 235 236 !CDIR NOVERRCHK 233 237 DO jk = 1, jpk 234 DO jj = 1, jpj 238 !CDIR NOVERRCHK 239 DO jj = 1, jpj 240 !CDIR NOVERRCHK 235 241 DO ji = 1, jpi 236 242 zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) … … 265 271 DO ji = 1, jpi 266 272 # if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 267 zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot 273 !! zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot 274 zfact = znitrpot(ji,jj,jk) * 1.e-7 268 275 # else 269 276 zfact = znitrpot(ji,jj,jk) * 1.e-7 … … 285 292 # endif 286 293 ! 294 IF(ln_ctl) THEN ! print mean trends (used for debugging) 295 WRITE(charout, FMT="('sed ')") 296 CALL prt_ctl_trc_info(charout) 297 CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 298 ENDIF 299 287 300 END SUBROUTINE p4z_sed 288 301 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r775 r858 18 18 USE sms 19 19 USE p4zsink2 ! 20 USE prtctl_trc 21 20 22 21 23 IMPLICIT NONE … … 46 48 INTEGER :: iksed 47 49 REAL(wp) :: zagg1, zagg2, zagg3, zagg4 50 REAL(wp) :: zagg , zaggfe, zaggdoc, zaggdoc2 48 51 REAL(wp) :: zfact, zstep, zwsmax 49 52 #if defined key_trc_dia3d … … 53 56 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsinkfer, zsinkfer2 54 57 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zsinkcal, zsinksil 58 CHARACTER (len=25) :: charout 55 59 !!--------------------------------------------------------------------- 56 60 … … 120 124 DO ji = 1, jpi 121 125 122 zfact = zstep * zdiss(ji,jj,jk)126 zfact = zstep * xdiss(ji,jj,jk) 123 127 124 128 ! Part I : Coagulation dependent on turbulence … … 155 159 # endif 156 160 157 xagg (ji,jj,jk)= zagg1 + zagg2 + zagg3 + zagg4158 xaggfe(ji,jj,jk) = xagg(ji,jj,jk)* trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn )161 zagg = zagg1 + zagg2 + zagg3 + zagg4 162 zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 159 163 160 164 ! Aggregation of DOC to small particles 161 165 ! -------------------------------------- 162 166 163 xaggdoc(ji,jj,jk)= ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) &164 # if defined key_off_degrad 165 & 166 # endif 167 & 168 169 xaggdoc2(ji,jj,jk)= 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) &170 # if defined key_off_degrad 171 & 167 zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) & 168 # if defined key_off_degrad 169 & * facvol(ji,jj,jk) & 170 # endif 171 & * zfact * trn(ji,jj,jk,jpdoc) 172 173 zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) & 174 # if defined key_off_degrad 175 & * facvol(ji,jj,jk) & 172 176 # endif 173 & * trn(ji,jj,jk,jpdoc) 177 & * trn(ji,jj,jk,jpdoc) 178 179 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 180 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 181 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 182 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 183 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 174 184 175 185 END DO … … 187 197 # endif 188 198 ! 199 IF(ln_ctl) THEN ! print mean trends (used for debugging) 200 WRITE(charout, FMT="('sink')") 201 CALL prt_ctl_trc_info(charout) 202 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 203 ENDIF 204 189 205 END SUBROUTINE p4z_sink 190 206 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsink2.F90
r775 r858 47 47 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: sinktemp ! ??? 48 48 !! 49 INTEGER :: ji, jj, jk 49 INTEGER :: ji, jj, jk, jnt 50 50 REAL(wp) :: zigma,zew,zstep,zign 51 51 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztraz, zakz 52 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkz , wstmp252 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkz , zwstmp2 53 53 !!--------------------------------------------------------------------- 54 54 55 zstep = rfact2 55 zstep = rfact2 / 2. 56 56 57 57 ztraz(:,:,:) = 0.e0 … … 61 61 DO jk = 1, jpkm1 62 62 # if defined key_off_degrad 63 wstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1)*facvol(:,:,jk)63 zwstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1)*facvol(:,:,jk) 64 64 # else 65 wstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1)65 zwstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1) 66 66 67 67 # endif 68 68 END DO 69 69 70 wstmp2(:,:,1) = 0.e070 zwstmp2(:,:,1) = 0.e0 71 71 ! 72 72 ! Vertical advective flux 73 73 !------------------------------- 74 ! ... first guess of the slopes 75 ! ... interior values 76 DO jk = 2, jpkm1 77 ztraz(:,:,jk) = (trn(:,:,jk-1,jn) - trn(:,:,jk,jn)) *tmask(:,:,jk) 78 END DO 74 75 DO jnt = 1, 2 76 77 ! ... first guess of the slopes interior values 78 79 DO jk = 2, jpkm1 80 ztraz(:,:,jk) = (trn(:,:,jk-1,jn) - trn(:,:,jk,jn)) *tmask(:,:,jk) 81 END DO 82 83 ztraz(:,:,1 ) = 0.0 84 ztraz(:,:,jpk) = 0.0 79 85 ! 80 86 ! slopes 81 DO jk=2,jpkm1 82 DO jj = 1,jpj 83 DO ji = 1, jpi 84 zign = 0.5*(sign(1.,ztraz(ji,jj,jk)*ztraz(ji,jj,jk+1))+1) 85 zakz(ji,jj,jk) = 0.5*(ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 86 END DO 87 END DO 88 END DO 89 ! 90 ! Slopes limitation 91 DO jk = 2, jpkm1 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 zakz(ji,jj,jk) = sign(1.,zakz(ji,jj,jk)) * & 95 & min(abs(zakz(ji,jj,jk)), & 96 & 2.*abs(ztraz(ji,jj,jk+1)), & 97 & 2.*abs(ztraz(ji,jj,jk))) 87 DO jk=2,jpkm1 88 DO jj = 1,jpj 89 DO ji = 1, jpi 90 zign = 0.25 + SIGN( 0.25,ztraz(ji,jj,jk)*ztraz(ji,jj,jk+1) ) 91 zakz(ji,jj,jk) = (ztraz(ji,jj,jk) + ztraz(ji,jj,jk+1) ) * zign 92 END DO 98 93 END DO 99 94 END DO 100 END DO101 102 ! vertical advective flux 103 DO jk = 1, jpkm1104 DO jj = 1, jpj105 DO ji = 1, jpi106 zigma = wstmp2(ji,jj,jk+1)*zstep/fse3w(ji,jj,jk+1)107 zew = wstmp2(ji,jj,jk+1)108 sinktemp(ji,jj,jk+1) = -zew*(trn(ji,jj,jk,jn) &109 & -0.5*(1+zigma)*zakz(ji,jj,jk))*zstep95 ! 96 ! Slopes limitation 97 DO jk = 2, jpkm1 98 DO jj = 1, jpj 99 DO ji = 1, jpi 100 zakz(ji,jj,jk) = SIGN(1.,zakz(ji,jj,jk)) * & 101 & MIN(ABS(zakz(ji,jj,jk)), & 102 & 2.*ABS(ztraz(ji,jj,jk+1)), & 103 & 2.*ABS(ztraz(ji,jj,jk))) 104 END DO 110 105 END DO 111 106 END DO 112 END DO 113 ! 114 ! Boundary conditions 115 sinktemp(:,:,1 ) = 0.e0 116 sinktemp(:,:,jpk) = 0.e0 107 108 ! vertical advective flux 109 DO jk = 1, jpkm1 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 zigma = zwstmp2(ji,jj,jk+1)*zstep/fse3w(ji,jj,jk+1) 113 zew = zwstmp2(ji,jj,jk+1) 114 sinktemp(ji,jj,jk+1) = -zew*(trn(ji,jj,jk,jn) & 115 & -0.5*(1+zigma)*zakz(ji,jj,jk))*zstep 116 END DO 117 END DO 118 END DO 119 ! 120 ! Boundary conditions 121 sinktemp(:,:,1 ) = 0.e0 122 sinktemp(:,:,jpk) = 0.e0 123 124 DO jk=1,jpkm1 125 DO jj = 1,jpj 126 DO ji = 1, jpi 127 trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) & 128 & + (sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1)) & 129 & /fse3t(ji,jj,jk) 130 END DO 131 END DO 132 END DO 133 134 ENDDO 117 135 118 136 DO jk=1,jpkm1 119 137 DO jj = 1,jpj 120 138 DO ji = 1, jpi 121 trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) & 122 & + (sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1)) & 123 & /fse3t(ji,jj,jk) 124 END DO 125 END DO 126 END DO 139 ! 140 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 141 & + 2.*(sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1)) & 142 & /fse3t(ji,jj,jk) 143 ! 144 ENDDO 145 ENDDO 146 ENDDO 147 ! 148 trn(:,:,:,jn) = trb(:,:,:,jn) 149 sinktemp(:,:,:) = 2. * sinktemp(:,:,:) 127 150 128 trb(:,:,:,jn) = trn(:,:,:,jn)129 151 ! 130 152 END SUBROUTINE p4z_sink2 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsink_kriest.F90
r775 r858 20 20 USE sms 21 21 USE p4zsink2 22 USE prtctl_trc 22 23 23 24 IMPLICIT NONE … … 45 46 !! ** Method : - ??? 46 47 !!--------------------------------------------------------------------- 47 INTEGER :: ji, jj, jk 48 INTEGER :: iksed 49 REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh 50 REAL(wp) :: znum , zeps, zfm, zgm, zsm 51 REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 52 REAL(wp) :: zval1, zval2, zval3, zval4 53 REAL(wp) :: zstep 48 INTEGER :: ji, jj, jk 49 INTEGER :: iksed 50 REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh 51 REAL(wp) :: zagg , zaggdoc, znumdoc 52 REAL(wp) :: znum , zeps, zfm, zgm, zsm 53 REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 54 REAL(wp) :: zval1, zval2, zval3, zval4 55 REAL(wp) :: zstep 54 56 #if defined key_trc_dia3d 55 57 REAL(wp) :: zrfact2 … … 59 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: sinkfer 60 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: sinkcal, sinksil 63 CHARACTER (len=25) :: charout 64 61 65 !!--------------------------------------------------------------------- 62 66 … … 184 188 & ) 185 189 186 zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * zdiss(ji,jj,jk) / 1000.190 zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 187 191 188 192 ! Aggregation of small into large particles … … 213 217 zaggsi = ( zagg4 + zagg5 ) * zstep / 10. 214 218 215 xagg(ji,jj,jk)= 0.5 * xkr_stick * ( zaggsh + zaggsi )219 zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 216 220 217 221 ! Aggregation of DOC to small particles 218 222 ! -------------------------------------- 219 223 220 xaggdoc(ji,jj,jk) = ( 0.4 * trn(ji,jj,jk,jpdoc) & 221 & + 1018. * trn(ji,jj,jk,jppoc) ) * zstep & 222 # if defined key_off_degrad 223 & * facvol(ji,jj,jk) & 224 # endif 225 & * zdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 224 zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc) & 225 & + 1018. * trn(ji,jj,jk,jppoc) ) * zstep & 226 # if defined key_off_degrad 227 & * facvol(ji,jj,jk) & 228 # endif 229 & * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 230 231 znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 232 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc 233 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zaggdoc * znumdoc - zagg 234 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc 226 235 227 236 ENDIF … … 246 255 # endif 247 256 ! 257 IF(ln_ctl) THEN ! print mean trends (used for debugging) 258 WRITE(charout, FMT="('sink')") 259 CALL prt_ctl_trc_info(charout) 260 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 261 ENDIF 248 262 END SUBROUTINE p4z_sink_kriest 249 263 -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/sms_pisces.h90
r852 r858 15 15 !! Variable for chemistry of the CO2 cycle 16 16 !! --------------------------------------------------------------------- 17 REAL(wp) :: atcco2 , atcox17 REAL(wp) :: atcco2 18 18 ! 19 19 REAL(wp), DIMENSION(jpi,jpj,jpk) :: akb3, ak13, ak23, aksp, akw3 !: ??? 20 REAL(wp), DIMENSION(jpi,jpj,jpk) :: akp13, akp23, akp33, aksi3, aks3, akf3 !: ???21 20 REAL(wp), DIMENSION(jpi,jpj,jpk) :: hi, borat !: ??? 21 REAL, DIMENSION(2) :: qcumul 22 22 23 23 !!---------------------------------------------------------------------- 24 24 !! Variable for chemistry of the CO2 cycle 25 25 !! --------------------------------------------------------------------- 26 REAL(wp), DIMENSION(10) :: devk1, devk2, devk3, devk4, devk527 26 ! 28 REAL(wp) :: akcc1, akcc2, akcc3, akcc4,akcc5, akcc6, akcc7, akcc8, akcc9 !: ??? 29 REAL(wp) :: bor1, bor2, c00, c01, c02, c03, c04, c05, c10, c11 !: ??? 30 REAL(wp) :: c12, c13, c20, c21, c22, c23, cb0, cb1, cb2, cb3 !: ??? 31 REAL(wp) :: cb4, cb5, cb6, cb7, cb8, cb9, cb10, cb11, c14 !: ??? 32 REAL(wp) :: cw3, cw4, cw5, cw6, cw0, cw1, cw2, ox0, ox1, ox2, ox3, ox4,ox5 !: ??? 33 REAL(wp) :: salchl, rgas, oxyco, ca0, ca1, ca2, ca3, ca4, ca5, ca6 !: ??? 34 REAL(wp) :: cp10, cp11, cp12, cp13, cp14, cp15, cp16, cp20, cp21 !: ??? 35 REAL(wp) :: cp22, cp23, cp24, cp25, cp26, cp30, cp31, cp32, cp33 !: ??? 36 REAL(wp) :: cp34, cp35, cs10, cs11, cs12, cs13, cs14, cs15, cs16 !: ??? 37 REAL(wp) :: cs17, cs18, cs19, cs20, cs21 !: ??? 38 REAL(wp) :: st1, st2, ft1, ft2, ks0, ks1, ks2, ks3, ks4, ks5 !: ??? 39 REAL(wp) :: ks6, ks7, ks8, ks9, ks10, ks11, ks12, kf0, kf1 !: ??? 40 REAL(wp) :: kf2, kf3, kf4 41 ! 42 REAL(wp), DIMENSION(jpi,jpj,3) :: chemc !: ??? 27 REAL(wp), DIMENSION(jpi,jpj,2) :: chemc !: ??? 43 28 44 29 !!---------------------------------------------------------------------- … … 68 53 REAL(wp) :: caco3r, kdca, nca, part, rno3, o2ut, po4r !: ??? 69 54 REAL(wp) :: sco2, dispo0, conc0,sumdepsi,rivalkinput,sedfeinput !: ??? 70 REAL(wp) :: calcon,rivpo4input,nitdepinput,oxymin,spocri !: ???55 REAL(wp) :: rivpo4input,nitdepinput,oxymin,spocri !: ??? 71 56 REAL(wp) :: nitrif,rdenit,o2nit,concnnh4,concdnh4 !: ??? 72 57 REAL(wp) :: pislope,excret,wsbio,resrat,mprat,wchl,wchld !: ??? … … 83 68 !!--------------------------------------------- 84 69 REAL(wp), DIMENSION(3,61) :: xkrgb !: ??? 85 REAL(wp), DIMENSION(jpi,jpj) :: zmeu!: ???70 REAL(wp), DIMENSION(jpi,jpj) :: heup !: ??? 86 71 REAL(wp), DIMENSION(jpi,jpj,jpk) :: etot, etot3, emoy !: ??? 72 REAL(wp), DIMENSION(jpi,jpj,jpk) :: enano, ediat 87 73 88 74 !!---------------------------------------------------------- … … 92 78 ! 93 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: prmax, tgfunc, tgfunc2 !: ??? 94 REAL(wp), DIMENSION(jpi,jpj,jpk) :: prcaca, prorca, prorca2, prorca3 !: ???95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: prorca4, prorca5, prorca6, prorca7 !: ???96 REAL(wp), DIMENSION(jpi,jpj,jpk) :: pronew, pronew2, proreg, proreg2 !: ???97 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xnanono3, xdiatno3, xnanonh4, xdiatnh4 !: ??? 98 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xlimphy, xlimdia, concdfe, concnfe, znegtr !: ??? 99 100 !!------------------------------------------ 101 !! Sinks for phytoplankton 102 !!------------------------------------------ 103 REAL(wp), DIMENSION(jpi,jpj,jpk) :: tortp, tortnf, tortnch !: ??? 104 REAL(wp), DIMENSION(jpi,jpj,jpk) :: respp, respp2, respnch, respdch !: ??? 105 REAL(wp), DIMENSION(jpi,jpj,jpk) :: tortp2, tortdf, tortdch, tortds !: ??? 106 REAL(wp), DIMENSION(jpi,jpj,jpk) :: respds, respdf, respnf !: ??? 107 108 !!------------------------------------ 109 !! SMS for zooplankton 110 !!------------------------------------- 111 REAL(wp), DIMENSION(jpi,jpj,jpk) :: respz, tortz, grazp, grazpf !: ??? 112 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grazpch, grazm, grazmf, grazsd !: ??? 113 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grazsf, grazss, grazsch, grarem !: ??? 114 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grafer,respz2,tortz2,grazd, grazz,grazn !: ??? 115 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grazpoc,graznf, graznch, grazs, grazf !: ??? 116 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grazdch, grazpof, grarem2, grafer2, grapoc2 !: ??? 117 REAL(wp), DIMENSION(jpi,jpj,jpk) :: grapoc, grazffe, grazfff !: ??? 81 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xlimphy, xlimdia, concdfe, concnfe, xnegtr !: ??? 118 82 119 83 !!--------------------------------------------- … … 122 86 REAL(wp) :: wsbio2 123 87 ! 124 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xagg, xaggfe, zdiss, xaggdoc, xaggdfe, xbactfer !: ??? 125 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xscave, olimi, orem, orem2, ofer, ofer2 !: ??? 126 REAL(wp), DIMENSION(jpi,jpj,jpk) :: osil, xaggdoc2, nitrfac, xlimbac !: ??? 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: xdiss, xfracal, nitrfac, xlimbac !: ??? 127 89 REAL(wp), DIMENSION(jpi,jpj,jpk) :: wsbio4, wsbio3, wscal !: ??? 128 90 … … 136 98 REAL(wp), DIMENSION(jpi,jpj) :: dust, cotdep, nitdep, rivinp !: ??? 137 99 REAL(wp), DIMENSION(jpi,jpj,12) :: dustmo !: ??? 138 REAL(wp), DIMENSION(jpi,jpj,jpk) :: onitr,denitr, ironsed !: ???100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: denitr, ironsed !: ??? 139 101 140 102 #if defined key_kriest -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/trcctl.pisces.h90
r855 r858 18 18 ! ----------------------- 19 19 #if defined key_kriest 20 IF( jp tra/= 23) THEN20 IF( jp_pisces /= 23) THEN 21 21 #else 22 IF( jp tra/= 24) THEN22 IF( jp_pisces /= 24) THEN 23 23 #endif 24 24 IF (lwp) THEN … … 26 26 WRITE (numout,*) ' ======= ============= ' 27 27 WRITE (numout,*) & 28 & ' STOP, change jp tra', &28 & ' STOP, change jp_pisces', & 29 29 & ' in parameter.passivetrc.pisces.h ' 30 30 END IF -
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r853 r858 21 21 USE oce_trc ! ocean variables 22 22 USE trp_trc ! 23 USE p4zche 24 USE lbclnk 23 25 24 26 USE iom … … 28 30 29 31 PUBLIC trc_ini_pisces ! called by trcini.F90 module 32 30 33 31 34 # include "domzgr_substitute.h90" … … 295 298 o2ut = 140. / 122. 296 299 297 !----------------------------------------------------------------------298 ! Initialize chemical variables299 !----------------------------------------------------------------------300 301 ! set pre-industrial atmospheric [co2] (ppm) and o2/n2 ratio302 ! ----------------------------------------------------------303 atcox = 0.20946304 305 ! Set lower/upper limits for temperature and salinity306 ! ---------------------------------------------------307 salchl = 1.e0 / 1.80655308 calcon = 1.03e-2309 310 ! Set coefficients for apparent solubility equilibrium of calcite311 ! Millero et al. 1995 from Mucci 1983312 ! --------------------------------------------------------------313 akcc1 = -171.9065314 akcc2 = -0.077993315 akcc3 = 2839.319316 akcc4 = 71.595317 akcc5 = -0.77712318 akcc6 = 0.0028426319 akcc7 = 178.34320 akcc8 = -0.07711321 akcc9 = 0.0041249322 323 ! Set coefficients for seawater pressure correction324 ! -------------------------------------------------325 devk1(1) = -25.5326 devk2(1) = 0.1271327 devk3(1) = 0.e0328 devk4(1) = -3.08E-3329 devk5(1) = 0.0877E-3330 !331 devk1(2) = -15.82332 devk2(2) = -0.0219333 devk3(2) = 0.e0334 devk4(2) = 1.13E-3335 devk5(2) = -0.1475E-3336 !337 devk1(3) = -29.48338 devk2(3) = 0.1622339 devk3(3) = 2.608E-3340 devk4(3) = -2.84E-3341 devk5(3) = 0.e0342 !343 devk1(4) = -14.51344 devk2(4) = 0.1211345 devk3(4) = -0.321E-3346 devk4(4) = -2.67E-3347 devk5(4) = 0.0427E-3348 !349 devk1(5) = -23.12350 devk2(5) = 0.1758351 devk3(5) = -2.647E-3352 devk4(5) = -5.15E-3353 devk5(5) = 0.09E-3354 !355 devk1(6) = -26.57356 devk2(6) = 0.2020357 devk3(6) = -3.042E-3358 devk4(6) = -4.08E-3359 devk5(6) = 0.0714E-3360 !361 devk1(7) = -25.60362 devk2(7) = 0.2324363 devk3(7) = -3.6246E-3364 devk4(7) = -5.13E-3365 devk5(7) = 0.0794E-3366 !367 ! For calcite with Edmond and Gieske 1970368 ! devkst = 0.23369 ! devks = 35.4370 ! Millero 95 takes this depth dependance for calcite371 devk1(8) = -48.76372 devk2(8) = 0.5304373 devk3(8) = 0.e0374 devk4(8) = -11.76E-3375 devk5(8) = 0.3692E-3376 !377 ! Coefficients for sulfate and fluoride378 devk1(9) = -18.03379 devk2(9) = 0.0466380 devk3(9) = 0.316e-3381 devk4(9) = -4.53e-3382 devk5(9) = 0.09e-3383 384 devk1(10) = -9.78385 devk2(10) = -0.0090386 devk3(10) = -0.942e-3387 devk4(10) = -3.91e-3388 devk5(10) = 0.054e-3389 390 391 ! Set universal gas constants392 ! ---------------------------393 rgas = 83.143394 oxyco = 1.e0 / 22.4144395 396 ! Set boron constants397 ! -------------------398 bor1 = 0.00023399 bor2 = 1.e0 / 10.82400 401 ! Set volumetric solubility constants for co2 in ml/l (Weiss, 1974)402 ! -----------------------------------------------------------------403 c00 = -60.2409404 c01 = 93.4517405 c02 = 23.3585406 c03 = 0.023517407 c04 = -0.023656408 c05 = 0.0047036409 !410 ca0 = -162.8301411 ca1 = 218.2968412 ca2 = 90.9241413 ca3 = -1.47696414 ca4 = 0.025695415 ca5 = -0.025225416 ca6 = 0.0049867417 418 ! Set coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)419 ! ---------------------------------------------------------------------420 c10 = -3670.7421 c11 = 62.008422 c12 = -9.7944423 c13 = 0.0118424 c14 = -0.000116425 426 ! Set coeff. for 2. dissoc. of carbonic acid (Edmond and Gieskes, 1970)427 ! ---------------------------------------------------------------------428 c20 = -1394.7429 c21 = -4.777430 c22 = 0.0184431 c23 = -0.000118432 433 ! Set constants for calculate concentrations for sulfate and fluoride434 ! sulfates (Morris & Riley 1966)435 !----------------------------------------------------------------------436 st1 = 0.14437 st2 = 1.e0 / 96.062438 439 ! fluoride440 ! --------441 ft1 = 0.000067442 ft2 = 1.e0 / 18.9984443 444 ! sulfates (Dickson 1990 change to mol:kg soln, idem OCMIP)445 !----------------------------------------------------------446 ks0 = 141.328447 ks1 = -4276.1448 ks2 = -23.093449 ks3 = -13856.450 ks4 = 324.57451 ks5 = -47.986452 ks6 = 35474.453 ks7 = -771.54454 ks8 = 114.723455 ks9 = -2698.456 ks10 = 1776.457 ks11 = 1.458 ks12 = -0.001005459 460 ! fluorides (Dickson & Riley 1979 change to mol/kg soln)461 !-------------------------------------------------------462 kf0 = -12.641463 kf1 = 1590.2464 kf2 = 1.525465 kf3 = 1.0466 kf4 = -0.001005467 468 ! Set coeff. for 1. dissoc. of boric acid (Edmond and Gieskes, 1970)469 ! ------------------------------------------------------------------470 cb0 = -8966.90471 cb1 = -2890.53472 cb2 = -77.942473 cb3 = 1.728474 cb4 = -0.0996475 cb5 = 148.0248476 cb6 = 137.1942477 cb7 = 1.62142478 cb8 = -24.4344479 cb9 = -25.085480 cb10 = -0.2474481 cb11 = 0.053105482 483 ! Set coeff. for dissoc. of water (Dickson and Riley, 1979,484 ! eq. 7, coefficient cw2 corrected from 0.9415 to 0.09415485 ! after pers. commun. to B. Bacastow, 1988)486 ! ---------------------------------------------------------487 cw0 = -13847.26488 cw1 = 148.9652489 cw2 = -23.6521490 cw3 = 118.67491 cw4 = -5.977492 cw5 = 1.0495493 cw6 = -0.01615494 495 ! Set coeff. for dissoc. of phosphate (Millero (1974)496 ! ---------------------------------------------------497 cp10 = 115.54498 cp11 = -4576.752499 cp12 = -18.453500 cp13 = -106.736501 cp14 = 0.69171502 cp15 = -0.65643503 cp16 = -0.01844504 !505 cp20 = 172.1033506 cp21 = -8814.715507 cp22 = -27.927508 cp23 = -160.340509 cp24 = 1.3566510 cp25 = 0.37335511 cp26 = -0.05778512 !513 cp30 = -18.126514 cp31 = -3070.75515 cp32 = 17.27039516 cp33 = 2.81197517 cp34 = -44.99486518 cp35 = -0.09984519 520 ! Set coeff. for dissoc. of phosphate (Millero (1974)521 ! ---------------------------------------------------522 cs10 = 117.385523 cs11 = -8904.2524 cs12 = -19.334525 cs13 = -458.79526 cs14 = 3.5913527 cs15 = 188.74528 cs16 = -1.5998529 cs17 = -12.1652530 cs18 = 0.07871531 cs19 = 0.e0532 cs20 = 1.e0533 cs21 = -0.001005534 535 536 ! Set volumetric solubility constants for o2 in ml/l (Weiss, 1970)537 ! ----------------------------------------------------------------538 ox0 = -58.3877539 ox1 = 85.8079540 ox2 = 23.8439541 ox3 = -0.034892542 ox4 = 0.015568543 ox5 = -0.0019387544 545 300 ! FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE 546 301 ! A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT … … 554 309 555 310 556 CALL p4z che ! initialize the chemical constants311 CALL p4z_che ! initialize the chemical constants 557 312 558 313
Note: See TracChangeset
for help on using the changeset viewer.