Changeset 775 for branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zbio.F90
- Timestamp:
- 2007-12-19T14:45:15+01:00 (16 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zbio.F90
r774 r775 1 2 CCC $Header$ 3 CCC TOP 1.0 , LOCEAN-IPSL (2005) 4 C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 5 C --------------------------------------------------------------------------- 6 SUBROUTINE p4zbio 7 CDIR$ LIST 8 #if defined key_top && defined key_pisces 9 CCC ------------------------------------------------------------------ 10 CCC 11 CCC ROUTINE p4zbio : PISCES MODEL 12 CCC ***************************** 13 CCC 14 CC 15 CC PURPOSE. 16 CC -------- 17 CC *P4ZBIO* ECOSYSTEM MODEL IN THE WHOLE OCEAN 18 CC THIS ROUTINE COMPUTES THE DIFFERENT INTERACTIONS 19 CC BETWEEN THE DIFFERENT COMPARTMENTS OF THE MODEL 20 CC EXTERNAL : 21 CC ---------- 22 CC p4zopt, p4zprod, p4znano, p4zdiat, p4zmicro, p4zmeso 23 CC p4zsink, p4zrem 24 CC 25 CC MODIFICATIONS: 26 CC -------------- 27 CC original : 2004 O. Aumont 28 CC ---------------------------------------------------------------- 29 CC parameters and commons 30 CC ====================== 31 CDIR$ NOLIST 32 USE oce_trc 33 USE trp_trc 34 USE sms 35 IMPLICIT NONE 36 #include "domzgr_substitute.h90" 37 CDIR$ LIST 38 CC----------------------------------------------------------------- 39 CC local declarations 40 CC ================== 41 C 42 INTEGER ji, jj, jk, jn 43 44 REAL zdenom,zdenom1(jpi,jpj,jpk) 45 REAL prodca,ztemp 46 1 MODULE p4zbio 2 !!====================================================================== 3 !! *** MODULE p4zbio *** 4 !! TOP : PISCES bio-model 5 !!====================================================================== 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !!---------------------------------------------------------------------- 9 #if defined key_pisces 10 !!---------------------------------------------------------------------- 11 !! 'key_pisces' PISCES bio-model 12 !!---------------------------------------------------------------------- 13 !! p4z_bio : computes the interactions between the different 14 !! compartments of PISCES 15 !!---------------------------------------------------------------------- 16 USE oce_trc ! 17 USE trp_trc ! 18 USE sms ! 19 USE p4zsink ! 20 USE p4zsink_kriest ! 21 USE p4zopt ! 22 USE p4zlim ! 23 USE p4zprod ! 24 USE p4znano ! 25 USE p4zdiat ! 26 USE p4zmicro ! 27 USE p4zmeso ! 28 USE p4zrem ! 29 30 IMPLICIT NONE 31 PRIVATE 32 33 PUBLIC p4z_bio ! called in p4zprg.F90 34 35 !!* Substitution 36 # include "domzgr_substitute.h90" 37 !!---------------------------------------------------------------------- 38 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 39 !! $Header:$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 43 CONTAINS 44 45 SUBROUTINE p4z_bio 46 !!--------------------------------------------------------------------- 47 !! *** ROUTINE p4z_bio *** 48 !! 49 !! ** Purpose : Ecosystem model in the whole ocean: computes the 50 !! different interactions between the different compartments 51 !! of PISCES 52 !! 53 !! ** Method : - ??? 54 !!--------------------------------------------------------------------- 55 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 65 !!--------------------------------------------------------------------- 66 67 ! ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION 68 ! OF PHYTOPLANKTON AND DETRITUS 69 70 zdiss(:,:,:) = 0.01 71 72 !!gm the use of nmld should be better here? 73 DO jk = 1, jpkm1 74 DO jj = 1, jpj 75 DO ji = 1, jpi 76 IF( fsdepw(ji,jj,jk+1) .le. hmld(ji,jj) ) zdiss(ji,jj,jk) = 1.e0 77 END DO 78 END DO 79 END DO 80 81 ! Compute de different ratios for scavenging of iron 82 ! -------------------------------------------------- 83 84 DO jk = 1, jpk 85 DO jj = 1, jpj 86 DO ji = 1, jpi 47 87 #if ! defined key_kriest 48 REAL zdenom2(jpi,jpj,jpk) 88 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) * zdenom 91 zdenom2(ji,jj,jk) = trn(ji,jj,jk,jpgoc) * zdenom 49 92 #else 50 REAL znumpoc, znumdoc 93 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) * zdenom 51 96 #endif 52 C 53 REAL prodt 54 REAL zfracal(jpi,jpj,jpk) 55 C 56 C ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION 57 C OF PHYTOPLANKTON AND DETRITUS 58 C 59 zdiss(:,:,:) = 0.01 60 C 61 DO jk=1,jpkm1 62 DO jj=1,jpj 63 DO ji=1,jpi 64 if (fsdepw(ji,jj,jk+1).le.hmld(ji,jj)) zdiss(ji,jj,jk)=1. 65 END DO 66 END DO 67 END DO 68 C 69 C Compute de different ratios for scavenging of iron 70 C -------------------------------------------------- 71 C 72 DO jk=1,jpk 73 DO jj=1,jpj 74 DO ji=1,jpi 75 #if ! defined key_kriest 76 zdenom=1./(trn(ji,jj,jk,jppoc)+trn(ji,jj,jk,jpgoc) 77 $ +trn(ji,jj,jk,jpdsi)+trn(ji,jj,jk,jpcal)+rtrn) 78 C 79 zdenom1(ji,jj,jk)=trn(ji,jj,jk,jppoc)*zdenom 80 zdenom2(ji,jj,jk)=trn(ji,jj,jk,jpgoc)*zdenom 97 END DO 98 END DO 99 END DO 100 101 ! Compute the fraction of nanophytoplankton that is made of calcifiers 102 ! -------------------------------------------------------------------- 103 104 DO jk = 1, jpkm1 105 DO jj = 1, jpj 106 DO ji = 1, jpi 107 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 DO 114 END DO 115 END DO 116 117 ! computation of the vertical flux of particulate organic matter 118 ! -------------------------------------------------------------- 119 120 IF( lk_kriest ) THEN ; CALL p4z_sink_kriest ! Sink due to vertical flux of POM 121 ELSE ; CALL p4z_sink ! 122 ENDIF 123 124 ! compute the PAR in the water column 125 ! ----------------------------------- 126 127 CALL p4z_opt ! Optical 128 129 ! compute the co-limitations by the various nutrients 130 ! ---------------------------------------------------- 131 132 CALL p4z_lim 133 134 ! compute phytoplankton growth rate over the global ocean. 135 ! ------------------------------------------------------- 136 ! (Growth rates for each element is computed (C, Si, Fe, Chl)) 137 138 CALL p4z_prod 139 140 ! phytoplankton mortality (Mortality losses for each elements are computed (C, Fe, Si, Chl) ) 141 ! ----------------------- 142 143 CALL p4z_nano ! nanophytoplankton 144 145 CALL p4z_diat ! diatoms 146 147 ! zooplankton sources/sinks routines (each elements are computed (C, Fe, Si, Chl) ) 148 ! ---------------------------------- 149 150 CALL p4z_micro ! microzooplankton 151 152 CALL p4z_meso ! mesozooplankton 153 154 ! computation of remineralization terms of organic matter + scavenging of Fe 155 ! -------------------------------------------------------------------------- 156 157 CALL p4z_rem ! remineralization 158 159 160 ! Determination of tracers concentration as a function of biological sources and sinks 161 ! ------------------------------------------------------------------------------------ 162 163 DO jk = 1, jpkm1 164 165 ! Evolution of PO4 166 ! ---------------- 167 trn(:,:,jk,jppo4) = trn(:,:,jk,jppo4) - prorca(:,:,jk) - prorca2(:,:,jk) & 168 & + olimi (:,:,jk) + grarem (:,:,jk) * sigma1 & 169 & + denitr(:,:,jk) + grarem2(:,:,jk) * sigma2 170 171 ! Evolution of NO3 and NH4 172 ! ------------------------ 173 trn(:,:,jk,jpno3) = trn(:,:,jk,jpno3) - pronew(:,:,jk) - pronew2(:,:,jk) & 174 & + onitr (:,:,jk) - denitr (:,:,jk) * rdenit 175 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 Phytoplankton 182 ! -------------------------- 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 Diatoms 190 ! -------------------- 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 Zooplankton 198 ! ------------------------ 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 Mesozooplankton 203 ! ------------------------ 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 O2 209 ! --------------- 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 IRON 216 ! ----------------- 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 DO 223 224 225 #if defined key_kriest 226 227 #include "p4zbio_kriest.h90" 81 228 82 229 #else 83 zdenom=1./(trn(ji,jj,jk,jppoc) 84 $ +trn(ji,jj,jk,jpdsi)+trn(ji,jj,jk,jpcal)+rtrn) 85 zdenom1(ji,jj,jk)=trn(ji,jj,jk,jppoc)*zdenom 230 231 #include "p4zbio_std.h90" 86 232 87 233 #endif 88 END DO 89 END DO 90 END DO 91 C 92 C Compute the fraction of nanophytoplankton that is made 93 C of calcifiers 94 C ------------------------------------------------------ 95 C 96 DO jk=1,jpkm1 97 DO jj=1,jpj 98 DO ji=1,jpi 99 ztemp=max(0.,tn(ji,jj,jk)) 100 zfracal(ji,jj,jk)=caco3r*xlimphy(ji,jj,jk)*max(0.0001 101 & ,ztemp/(2.+ztemp))*max(1.,trn(ji,jj,jk,jpphy)*1E6/2.) 102 zfracal(ji,jj,jk)=min(0.8,zfracal(ji,jj,jk)) 103 zfracal(ji,jj,jk)=max(0.01,zfracal(ji,jj,jk)) 104 END DO 105 END DO 106 END DO 107 108 C 109 C Call subroutine for computation of the vertical flux 110 C of particulate organic matter 111 C ---------------------------------------------------- 112 C 113 CALL p4zsink 114 115 C 116 C Call optical routine to compute the PAR in the water column 117 C ----------------------------------------------------------- 118 C 119 CALL p4zopt 120 C 121 C Call routine to compute the co-limitations by the various 122 C nutrients 123 C --------------------------------------------------------- 124 C 125 CALL p4zlim 126 C 127 C Call production routine to compute phytoplankton growth rate 128 C over the global ocean. Growth rates for each element is 129 C computed (C, Si, Fe, Chl) 130 C ------------------------------------------------------------ 131 C 132 CALL p4zprod 133 C 134 C Call phytoplankton mortality routines. Mortality losses for 135 C Each elements are computed (C, Fe, Si, Chl) 136 C ----------------------------------------------------------- 137 C 138 CALL p4znano 139 CALL p4zdiat 140 C 141 C Call zooplankton sources/sinks routines. 142 C Each elements are computed (C, Fe, Si, Chl) 143 C ----------------------------------------------------------- 144 C 145 CALL p4zmicro 146 CALL p4zmeso 147 148 C 149 C Call subroutine for computation of remineralization 150 C terms of organic matter+scavenging of Fe 151 C ---------------------------------------------------- 152 CALL p4zrem 153 C 154 C Determination of tracers concentration as a function of 155 C biological sources and sinks 156 C -------------------------------------------------------- 157 C 158 DO jk = 1,jpkm1 159 DO jj = 1,jpj 160 DO ji = 1,jpi 161 C 162 C Evolution of PO4 163 C ---------------- 164 C 165 trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) 166 & -prorca(ji,jj,jk)-prorca2(ji,jj,jk) 167 & +olimi(ji,jj,jk)+grarem(ji,jj,jk)*sigma1+denitr(ji,jj,jk) 168 & +grarem2(ji,jj,jk)*sigma2 169 C 170 C Evolution of NO3 and NH4 171 C ------------------------ 172 C 173 trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3) 174 & -pronew(ji,jj,jk)-pronew2(ji,jj,jk)+onitr(ji,jj,jk) 175 & -denitr(ji,jj,jk)*rdenit 176 177 trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) 178 & -proreg(ji,jj,jk)-proreg2(ji,jj,jk)+olimi(ji,jj,jk) 179 & +grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2 180 & -onitr(ji,jj,jk)+denitr(ji,jj,jk) 181 182 END DO 183 END DO 184 END DO 185 186 DO jk = 1,jpkm1 187 DO jj = 1,jpj 188 DO ji = 1,jpi 189 190 C 191 C Evolution of Phytoplankton 192 C -------------------------- 193 C 194 trn(ji,jj,jk,jpphy) = trn(ji,jj,jk,jpphy) 195 & +prorca(ji,jj,jk)*(1.-excret)-tortp(ji,jj,jk) 196 & -grazp(ji,jj,jk)-grazn(ji,jj,jk)-respp(ji,jj,jk) 197 198 trn(ji,jj,jk,jpnch) = trn(ji,jj,jk,jpnch) 199 & +prorca6(ji,jj,jk)*(1.-excret)-tortnch(ji,jj,jk) 200 & -grazpch(ji,jj,jk)-graznch(ji,jj,jk)-respnch(ji,jj,jk) 201 C 202 C Evolution of Diatoms 203 C ------------------ 204 C 205 trn(ji,jj,jk,jpdia) = trn(ji,jj,jk,jpdia) 206 & +prorca2(ji,jj,jk)*(1.-excret2)-tortp2(ji,jj,jk) 207 & -respp2(ji,jj,jk)-grazd(ji,jj,jk)-grazsd(ji,jj,jk) 208 209 trn(ji,jj,jk,jpdch) = trn(ji,jj,jk,jpdch) 210 & +prorca7(ji,jj,jk)*(1.-excret2)-tortdch(ji,jj,jk) 211 & -respdch(ji,jj,jk)-grazdch(ji,jj,jk)-grazsch(ji,jj,jk) 212 END DO 213 END DO 214 END DO 215 216 DO jk = 1,jpkm1 217 DO jj = 1,jpj 218 DO ji = 1,jpi 219 C 220 C Evolution of Zooplankton 221 C ------------------------ 222 C 223 trn(ji,jj,jk,jpzoo) = trn(ji,jj,jk,jpzoo) 224 & +epsher*(grazp(ji,jj,jk)+grazm(ji,jj,jk)+grazsd(ji,jj,jk)) 225 & -grazz(ji,jj,jk)-tortz(ji,jj,jk)-respz(ji,jj,jk) 226 C 227 C Evolution of Mesozooplankton 228 C ------------------------ 229 C 230 trn(ji,jj,jk,jpmes) = trn(ji,jj,jk,jpmes) 231 & +epsher2*(grazd(ji,jj,jk)+grazz(ji,jj,jk)+grazn(ji,jj,jk) 232 & +grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))-tortz2(ji,jj,jk) 233 & -respz2(ji,jj,jk) 234 END DO 235 END DO 236 END DO 237 238 239 DO jk = 1,jpkm1 240 DO jj = 1,jpj 241 DO ji = 1,jpi 242 C 243 C Evolution of O2 244 C --------------- 245 C 246 trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) 247 & +o2ut*(proreg(ji,jj,jk)+proreg2(ji,jj,jk)-olimi(ji,jj,jk) 248 & -grarem(ji,jj,jk)*sigma1-grarem2(ji,jj,jk)*sigma2) 249 & +(o2ut+o2nit)*( pronew(ji,jj,jk)+pronew2(ji,jj,jk)) 250 & -o2nit*onitr(ji,jj,jk) 251 C 252 END DO 253 END DO 254 END DO 255 256 257 DO jk = 1,jpkm1 258 DO jj = 1,jpj 259 DO ji = 1,jpi 260 C 261 C Evolution of IRON 262 C ----------------- 263 C 264 trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) 265 & +(excret-1.)*prorca5(ji,jj,jk)-xaggdfe(ji,jj,jk) 266 & +(excret2-1.)*prorca4(ji,jj,jk)-xbactfer(ji,jj,jk) 267 & +grafer(ji,jj,jk)+grafer2(ji,jj,jk) 268 & +ofer(ji,jj,jk)-xscave(ji,jj,jk) 269 C 270 END DO 271 END DO 272 END DO 273 274 275 #if defined key_kriest 276 277 #include "p4zbio.kriest.h" 234 235 236 DO jk = 1, jpkm1 237 238 ! Evolution of biogenic Silica 239 ! ---------------------------- 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 silica 244 ! ------------------------------------ 245 trn(:,:,jk,jpdsi) = trn(:,:,jk,jpdsi) + tortds (:,:,jk) + respds(:,:,jk) + grazs(:,:,jk) & 246 & - osil (:,:,jk) + grazss(:,:,jk) 247 248 ! Evolution of biogenic diatom Iron 249 ! --------------------------------- 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 Iron 254 ! -------------------------------------------- 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 Silica 259 ! ----------------------------- 260 trn(:,:,jk,jpsil) = trn(:,:,jk,jpsil) - ( 1.- excret2 ) * prorca3(:,:,jk) + osil(:,:,jk) 261 262 END DO 263 264 ! Evolution of calcite and silicates as a function of the two tracers 265 ! ------------------------------------------------------------------- 266 DO jk = 1, jpkm1 267 DO jj = 1, jpj 268 DO ji = 1, jpi 269 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 silicate 275 ! ------------------------------------------------------ 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)O2 281 ! ---------------------------- 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 of 285 ! alkalinity due to nitrate consumption during organic soft tissue production 286 ! --------------------------------------------------------- 287 trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zprodca - 2.* prcaca(ji,jj,jk) 288 ! 289 END DO 290 END DO 291 END DO 292 293 294 ! Production of calcite due to biological production 295 ! -------------------------------------------------- 296 DO jk = 1, jpkm1 297 trn(:,:,jk,jpcal) = trn(:,:,jk,jpcal) + prcaca(:,:,jk) 298 END DO 299 300 301 ! Loop to test if tracers concentrations fall below 0. 302 ! ---------------------------------------------------- 303 304 znegtr(:,:,:) = 1.e0 305 DO jn = 1, jptra 306 DO jk = 1, jpk 307 DO jj = 1, jpj 308 DO ji = 1, jpi 309 IF( trn(ji,jj,jk,jn) < 0.e0 ) znegtr(ji,jj,jk) = 0.e0 310 END DO 311 END DO 312 END DO 313 END DO 314 ! ! where at least 1 tracer concentration becomes negative 315 ! ! all tracer tendancy are set to zero (i.e. trn = trb) 316 DO jn = 1, jptra 317 trn(:,:,:,jn) = trb(:,:,:,jn) + znegtr(:,:,:) * ( trn(:,:,:,jn) - trb(:,:,:,jn) ) 318 END DO 319 320 # if defined key_trc_dia3d 321 !!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 334 # endif 335 ! 336 END SUBROUTINE p4z_bio 278 337 279 338 #else 280 281 #include "p4zbio.std.h" 282 283 #endif 284 285 286 287 DO jk = 1,jpkm1 288 DO jj = 1,jpj 289 DO ji = 1,jpi 290 C 291 C Evolution of biogenic Silica 292 C ---------------------------- 293 C 294 trn(ji,jj,jk,jpbsi) = trn(ji,jj,jk,jpbsi) 295 & +prorca3(ji,jj,jk)*(1.-excret2)-grazss(ji,jj,jk) 296 & -tortds(ji,jj,jk)-respds(ji,jj,jk)-grazs(ji,jj,jk) 297 C 298 END DO 299 END DO 300 END DO 301 302 DO jk = 1,jpkm1 303 DO jj = 1,jpj 304 DO ji = 1,jpi 305 C 306 C Evolution of sinking biogenic silica 307 C ------------------------------------ 308 C 309 trn(ji,jj,jk,jpdsi)=trn(ji,jj,jk,jpdsi) 310 & +tortds(ji,jj,jk)+respds(ji,jj,jk)+grazs(ji,jj,jk) 311 & -osil(ji,jj,jk)+grazss(ji,jj,jk) 312 C 313 END DO 314 END DO 315 END DO 316 317 DO jk = 1,jpkm1 318 DO jj = 1,jpj 319 DO ji = 1,jpi 320 C 321 C Evolution of biogenic diatom Iron 322 C --------------------------------- 323 C 324 trn(ji,jj,jk,jpdfe) = trn(ji,jj,jk,jpdfe) 325 & +prorca4(ji,jj,jk)*(1.-excret2)-grazsf(ji,jj,jk) 326 & -tortdf(ji,jj,jk)-respdf(ji,jj,jk)-grazf(ji,jj,jk) 327 C 328 C Evolution of biogenic nanophytoplankton Iron 329 C -------------------------------------------- 330 C 331 trn(ji,jj,jk,jpnfe) = trn(ji,jj,jk,jpnfe) 332 & +prorca5(ji,jj,jk)*(1.-excret)-graznf(ji,jj,jk) 333 & -tortnf(ji,jj,jk)-respnf(ji,jj,jk)-grazpf(ji,jj,jk) 334 C 335 C Evolution of dissolved Silica 336 C ----------------------------- 337 C 338 trn(ji,jj,jk,jpsil) = trn(ji,jj,jk,jpsil) 339 & -(1.-excret2)*prorca3(ji,jj,jk)+osil(ji,jj,jk) 340 C 341 END DO 342 END DO 343 END DO 344 C 345 C Evolution of calcite and silicates as a function of the two tracers 346 C ------------------------------------------------------------------- 347 C 348 DO jk = 1,jpkm1 349 DO jj = 1,jpj 350 DO ji = 1,jpi 351 C 352 prodt = prorca(ji,jj,jk)+prorca2(ji,jj,jk) 353 & -olimi(ji,jj,jk)-grarem(ji,jj,jk)*sigma1 354 & -grarem2(ji,jj,jk)*sigma2-denitr(ji,jj,jk) 355 356 prodca = pronew(ji,jj,jk)+pronew2(ji,jj,jk) 357 & -onitr(ji,jj,jk)+rdenit*denitr(ji,jj,jk) 358 C 359 C potential production of calcite and biogenic silicate 360 C ------------------------------------------------------ 361 C 362 prcaca(ji,jj,jk)= 363 & zfracal(ji,jj,jk)*(part*(unass*grazp(ji,jj,jk)+ 364 & unass2*grazn(ji,jj,jk))+tortp(ji,jj,jk)+respp(ji,jj,jk)) 365 C 366 C Consumption of Total (12C)O2 367 C ---------------------------- 368 C 369 trn(ji,jj,jk,jpdic) = trn(ji,jj,jk,jpdic) 370 & -prodt-prcaca(ji,jj,jk) 371 C 372 C Consumption of alkalinity due to ca++ uptake and increase 373 C of alkalinity due to nitrate consumption during organic 374 C soft tissue production 375 C --------------------------------------------------------- 376 C 377 trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) 378 & +rno3*prodca-2.*prcaca(ji,jj,jk) 379 END DO 380 END DO 381 END DO 382 C 383 DO jk = 1,jpkm1 384 DO jj = 1,jpj 385 DO ji = 1,jpi 386 C 387 C Production of calcite due to biological production 388 C -------------------------------------------------- 389 C 390 trn(ji,jj,jk,jpcal) = trn(ji,jj,jk,jpcal) 391 & +prcaca(ji,jj,jk) 392 END DO 393 END DO 394 ENDDO 395 C 396 C 397 C Loop to test if tracers concentrations fall below 0. 398 C ---------------------------------------------------- 399 C 400 C 401 znegtr(:,:,:) = 1. 402 C 403 DO jn = 1,jptra 404 DO jk = 1,jpk 405 DO jj = 1,jpj 406 DO ji = 1,jpi 407 if (trn(ji,jj,jk,jn).lt.0.) then 408 znegtr(ji,jj,jk)=0. 409 endif 410 END DO 411 END DO 412 END DO 413 END DO 414 C 415 DO jn = 1,jptra 416 trn(:,:,:,jn) = trb(:,:,:,jn)+ 417 & znegtr(:,:,:)*(trn(:,:,:,jn)-trb(:,:,:,jn)) 418 END DO 419 C 420 # if defined key_trc_dia3d 421 trc3d(:,:,:,4)=etot(:,:,:) 422 trc3d(:,:,:,5)=prorca(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 423 trc3d(:,:,:,6)=prorca2(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 424 trc3d(:,:,:,7)=pronew(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 425 trc3d(:,:,:,8)=pronew2(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 426 trc3d(:,:,:,9)=prorca3(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 427 trc3d(:,:,:,10)=prorca4(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 428 #if ! defined key_kriest 429 trc3d(:,:,:,11)=prorca5(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 430 #else 431 trc3d(:,:,:,11)=prcaca(:,:,:)*znegtr(:,:,:)*1e3*rfact2r 432 #endif 433 # endif 434 C 435 #endif 436 C 437 RETURN 438 END 339 !!====================================================================== 340 !! Dummy module : No PISCES bio-model 341 !!====================================================================== 342 CONTAINS 343 SUBROUTINE p4z_bio ! Empty routine 344 END SUBROUTINE p4z_bio 345 #endif 346 347 !!====================================================================== 348 END MODULE p4zbio
Note: See TracChangeset
for help on using the changeset viewer.