- Timestamp:
- 2012-08-10T13:13:55+02:00 (12 years ago)
- Location:
- branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r3443 r3446 121 121 ENDIF 122 122 123 grazing(:,:,1) = 0.e0 ! zooplakton closure ( fbod)123 xksi(:,:) = 0.e0 ! zooplakton closure ( fbod) 124 124 IF( ln_diatrc ) THEN 125 125 zw2d (:,:,:) = 0.e0 … … 186 186 ! closure : flux grazing is redistributed below level jpkbio 187 187 zzoobod = tmminz * zzoo * zzoo 188 grazing(ji,jj,1) = grazing(ji,jj,1) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk)188 xksi(ji,jj) = xksi(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk) 189 189 zboddet = fdbod * zzoobod 190 190 -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
r3443 r3446 95 95 DO ji = fs_2, fs_jpim1 96 96 ze3t = 1. / fse3t(ji,jj,jk) 97 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * grazing(ji,jj,1)97 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * xksi(ji,jj) 98 98 END DO 99 99 END DO … … 112 112 ! Deposition of organic matter in the sediment 113 113 zwork = vsed * trn(ji,jj,ikt,jpdet) 114 zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * grazing(ji,jj,1) &114 zsedpoca(ji,jj) = ( zwork + dminl(ji,jj) * xksi(ji,jj) & 115 115 & - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 116 116 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r3443 r3446 83 83 CALL p4z_opt ( kt, jnt ) ! Optic: PAR in the water column 84 84 CALL p4z_fechem(kt, jnt ) ! Iron chemistry/scavenging 85 CALL p4z_lim ( kt 85 CALL p4z_lim ( kt, jnt ) ! co-limitations by the various nutrients 86 86 CALL p4z_prod ( kt, jnt ) ! phytoplankton growth rate over the global ocean. 87 87 ! ! (for each element : C, Si, Fe, Chl ) … … 89 89 CALL p4z_mort ( kt ) ! phytoplankton mortality 90 90 ! ! zooplankton sources/sinks routines 91 CALL p4z_micro( kt 91 CALL p4z_micro( kt, jnt ) ! microzooplankton 92 92 CALL p4z_meso ( kt, jnt ) ! mesozooplankton 93 93 -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r3443 r3446 37 37 REAL(wp), PUBLIC :: ligand = 0.6E-9_wp !: ligand concentration in the ocean 38 38 39 REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con 39 REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 40 40 41 41 !!* Substitution … … 65 65 ! 66 66 INTEGER :: ji, jj, jk, jic 67 REAL(wp) :: zdep, zlam1 b, zlamfac68 REAL(wp) :: zkeq, zfeequi, zfesatur 69 REAL(wp) :: zdenom1, zscave, zaggdfe , zcoag67 REAL(wp) :: zdep, zlam1a, zlam1b, zlamfac 68 REAL(wp) :: zkeq, zfeequi, zfesatur, zfecoll 69 REAL(wp) :: zdenom1, zscave, zaggdfea, zaggdfeb, zcoag 70 70 REAL(wp) :: ztrc, zdust 71 71 #if ! defined key_kriest … … 74 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig 75 75 REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP 76 REAL(wp) :: zkox, zkph1, zkph2, zph, zionic 76 REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand 77 77 REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za2 78 78 REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2 … … 85 85 ! 86 86 ! Allocate temporary workspace 87 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zTL1, ztotlig ) 88 zFe3 (:,:,:) = 0._wp 89 zTL1 (:,:,:) = 0._wp 90 ztotlig(:,:,:) = 0._wp 87 CALL wrk_alloc( jpi, jpj, jpk, zFe3, zTL1, ztotlig ) 88 IF( ln_diatrc .AND. lk_iomput ) CALL wrk_alloc( jpi, jpj, jpk, zFeL1 ) 89 ! 91 90 IF( ln_fechem ) THEN 92 CALL wrk_alloc( jpi, jpj, jpk, zTL2, zFeP ) 93 zTL2(:,:,:) = 0._wp 94 zFeP(:,:,:) = 0._wp 95 IF( ln_diatrc .AND. lk_iomput ) THEN 96 CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL1, zFeL2 ) 97 zFe2 (:,:,:) = 0._wp 98 zFeL1(:,:,:) = 0._wp 99 zFeL2(:,:,:) = 0._wp 100 ENDIF 91 CALL wrk_alloc( jpi, jpj, jpk, zTL2, zFeP ) 92 IF( ln_diatrc .AND. lk_iomput ) CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2 ) 101 93 ENDIF 102 94 ! Total ligand concentration : Ligands can be chosen to be constant or variable … … 104 96 ! ------------------------------------------------- 105 97 IF( ln_ligvar ) THEN 106 ztotlig(:,:,:) = 0.09 * ( trn(:,:,:,jpdoc) * 1E6 + 40. ) - 3.2107 ztotlig(:,:,:) = MAX( MIN( ztotlig(:,:,:), 10. ), 0.4)98 ztotlig(:,:,:) = 0.09 * trn(:,:,:,jpdoc) * 1E6 + ligand * 1E9 99 ztotlig(:,:,:) = MIN( ztotlig(:,:,:), 10. ) 108 100 ELSE 109 101 ztotlig(:,:,:) = ligand * 1E9 … … 120 112 DO ji = 1, jpi 121 113 ! Calculate ligand concentrations : assume 2/3rd of excess goes to L2 and 1/3rd to L1 122 zTL2(ji,jj,jk) = 0.000001 + 0.67 * ( ztotlig(ji,jj,jk) - 0.4 ) 123 zTL1(ji,jj,jk) = 0.4 - 0.000001 + 0.33 * ( ztotlig(ji,jj,jk) - 0.4 ) 114 ztligand = ztotlig(ji,jj,jk) - ligand * 1E9 115 zTL2(ji,jj,jk) = 0.000001 + 0.67 * ztligand 116 zTL1(ji,jj,jk) = ligand * 1E9 - 0.000001 + 0.33 * ztligand 124 117 ! ionic strength from Millero et al. 1987 125 118 zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn ) … … 150 143 ! calculate some parameters 151 144 za = 1 + ks / kpr 152 zb = 1 + zkph1/ ( zkox + rtrn )145 zb = 1 + ( zkph1 + kth ) / ( zkox + rtrn ) 153 146 zc = 1 + zkph2 / ( zkox + rtrn ) 154 zkappa1 = ( kb1 + zkph1 ) / kl1155 zkappa2 = ( kb2 + zkph2 ) / kl2147 zkappa1 = ( kb1 + zkph1 + kth ) / kl1 148 zkappa2 = ( kb2 + zkph2 ) / kl2 156 149 za2 = zTL1(ji,jj,jk) * zb / za + zTL2(ji,jj,jk) * zc / za + zkappa1 + zkappa2 - ztfe / za 157 150 za1 = zkappa2 * zTL1(ji,jj,jk) * zb / za + zkappa1 * zTL2(ji,jj,jk) * zc / za & … … 216 209 END DO 217 210 END DO 211 IF( ln_diatrc .AND. lk_iomput ) & 212 & zFeL1(:,:,1:jpkm1) = MAX( 0., trn(:,:,1:jpkm1,jpfer) * 1E9 - zFe3(:,:,1:jpkm1) ) 218 213 ! 219 214 ENDIF … … 234 229 ! Scavenging onto dust is also included as evidenced from the DUNE experiments. 235 230 ! -------------------------------------------------------------------------------------- 236 zfeequi = zFe3(ji,jj,jk) * 1E-9 237 IF( ln_fechem ) zfeequi = zfeequi + zFep(ji,jj,jk) * 1E-9 231 IF( ln_fechem ) THEN 232 zfeequi = ( zFe3(ji,jj,jk) + zFe2(ji,jj,jk) ) * 1E-9 233 zfecoll = ( 0.3 * zFeL1(ji,jj,jk) + 0.5 * zFeL2(ji,jj,jk) ) * 1E-9 234 ELSE 235 zfeequi = zFe3(ji,jj,jk) * 1E-9 236 zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 237 ENDIF 238 238 #if defined key_kriest 239 239 ztrc = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6 … … 258 258 ! due to increased lithogenic particles and let say it is unknown processes (precipitation, ...) 259 259 ! ----------------------------------------------------------- 260 ztfe = trn(ji,jj,jk,jpfer) * 1.e9 - 1. 261 IF( ln_fechem ) ztfe = ztfe + 1. - ztotlig(ji,jj,jk) 262 zlam1b = xlam1 * MAX( 0.e0, ztfe ) 260 zlam1b = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 263 261 zcoag = zfeequi * zlam1b * zstep 264 262 … … 269 267 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 270 268 zlamfac = MIN( 1. , zlamfac ) 271 zdep = MIN(1., 1000. / fsdept(ji,jj,jk) ) 272 #if ! defined key_kriest 273 zlam1b = ( 80.* ( trn(ji,jj,jk,jpdoc) + 35.e-6 ) & 274 & + 698.* trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc) ) & 275 & * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 269 zdep = MIN( 1., 1000. / fsdept(ji,jj,jk) ) 270 zlam1a = ( 0.369 * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) & 271 & + ( 114. * 0.3 * trn(ji,jj,jk,jpdoc) + 5.09E3 * trn(ji,jj,jk,jppoc) ) 272 #if defined key_kriest 273 zlam1a = zlam1a + 1E-4 * ( 1. - zlamfac ) * zdep 274 zaggdfea = zlam1a * zstep * zfecoll 275 zaggdfeb = 0. 276 ! 277 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag 278 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb 276 279 #else 277 zlam1b = ( 80.* (trn(ji,jj,jk,jpdoc) + 35E-6) & 278 & + 698.* trn(ji,jj,jk,jppoc) ) & 279 & * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 280 #endif 281 zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 282 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe - zcoag 283 #if defined key_kriest 284 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 285 #else 286 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 287 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 280 zlam1b = 3.53E3 * trn(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 281 zaggdfea = zlam1a * zstep * zfecoll 282 zaggdfeb = zlam1b * zstep * zfecoll 283 ! 284 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag 285 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 286 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 288 287 #endif 289 288 END DO … … 291 290 END DO 292 291 ! 292 ! Define the bioavailable fraction of iron 293 ! ---------------------------------------- 294 IF( ln_fechem ) THEN 295 biron(:,:,:) = MAX( 0., trn(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 296 ELSE 297 biron(:,:,:) = trn(:,:,:,jpfer) 298 ENDIF 293 299 294 300 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 302 308 IF( ln_diatrc .AND. lk_iomput ) THEN 303 309 IF( jnt == nrdttrc ) THEN 304 CALL iom_put("Fe3" , zFe3 (:,:,:) * tmask(:,:,:) ) ! Fe3+ 305 CALL iom_put("TL1" , zTL1 (:,:,:) * tmask(:,:,:) ) ! TL1 306 CALL iom_put("Totlig" , ztotlig(:,:,:) * tmask(:,:,:) ) ! TL 310 CALL iom_put("Fe3" , zFe3 (:,:,:) * tmask(:,:,:) ) ! Fe3+ 311 CALL iom_put("FeL1" , zFeL1 (:,:,:) * tmask(:,:,:) ) ! FeL1 312 CALL iom_put("TL1" , zTL1 (:,:,:) * tmask(:,:,:) ) ! TL1 313 CALL iom_put("Totlig" , ztotlig(:,:,:) * tmask(:,:,:) ) ! TL 314 CALL iom_put("Biron" , biron (:,:,:) * 1e9 * tmask(:,:,:) ) ! TL 307 315 IF( ln_fechem ) THEN 308 CALL iom_put("Fe2" , zFe2 (:,:,:) * tmask(:,:,:) ) ! Fe2+ 309 CALL iom_put("FeL1", zFeL1 (:,:,:) * tmask(:,:,:) ) ! FeL1 310 CALL iom_put("FeL2", zFeL2 (:,:,:) * tmask(:,:,:) ) ! FeL2 311 CALL iom_put("FeP" , zFeP (:,:,:) * tmask(:,:,:) ) ! FeP 312 CALL iom_put("TL2" , zTL2 (:,:,:) * tmask(:,:,:) ) ! TL2 316 CALL iom_put("Fe2" , zFe2 (:,:,:) * tmask(:,:,:) ) ! Fe2+ 317 CALL iom_put("FeL2", zFeL2 (:,:,:) * tmask(:,:,:) ) ! FeL2 318 CALL iom_put("FeP" , zFeP (:,:,:) * tmask(:,:,:) ) ! FeP 319 CALL iom_put("TL2" , zTL2 (:,:,:) * tmask(:,:,:) ) ! TL2 313 320 ENDIF 314 321 ENDIF … … 321 328 ENDIF 322 329 ! 323 CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zTL1, ztotlig ) 330 CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zTL1, ztotlig ) 331 IF( ln_diatrc .AND. lk_iomput ) CALL wrk_dealloc( jpi, jpj, jpk, zFeL1 ) 324 332 IF( ln_fechem ) THEN 325 CALL wrk_dealloc( jpi, jpj, jpk, zTL2, zFeP ) 326 IF( ln_diatrc .AND. lk_iomput ) THEN 327 CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL1, zFeL2 ) 328 ENDIF 333 CALL wrk_dealloc( jpi, jpj, jpk, zTL2, zFeP ) 334 IF( ln_diatrc .AND. lk_iomput ) CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2 ) 329 335 ENDIF 330 336 ! … … 365 371 ! initialization of some constants used by the complexe chemistry scheme 366 372 ! ---------------------------------------------------------------------- 367 spd = 3600. *24.373 spd = 3600. * 24. 368 374 con = 1.E9 369 375 ! LIGAND KINETICS (values from Witter et al. 2000) … … 377 383 ks = 0.075 378 384 kpr = 0.05 385 ! thermal reduction of Fe3 386 kth = 0.0048 * 24. 379 387 ENDIF 380 388 ! -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
r3443 r3446 52 52 tgfunc2(:,:,:) = EXP( 0.07608 * tsn(:,:,:,jp_tem) ) 53 53 54 ! Computation of the silicon dependant half saturation 55 ! constant for silica uptake 54 ! Computation of the silicon dependant half saturation constant for silica uptake 56 55 ! --------------------------------------------------- 57 56 DO ji = 1, jpi … … 63 62 ! 64 63 IF( nday_year == nyear_len(1) ) THEN 65 xksi = xksimax66 xksimax = 0._wp64 xksi (:,:) = xksimax(:,:) 65 xksimax(:,:) = 0._wp 67 66 ENDIF 68 67 ! -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r3443 r3446 19 19 USE sms_pisces ! PISCES variables 20 20 USE p4zopt ! Optical 21 USE iom ! I/O manager 21 22 22 23 IMPLICIT NONE … … 33 34 REAL(wp), PUBLIC :: concnfer = 1.e-9_wp !: Iron half saturation for nanophyto 34 35 REAL(wp), PUBLIC :: concdfer = 2.e-9_wp !: Iron half saturation for diatoms 36 REAL(wp), PUBLIC :: concbno3 = 2.5e-7_wp !: NO3 half saturation for bacteria 37 REAL(wp), PUBLIC :: concbnh4 = 2.5e-8_wp !: NH4 half saturation for bacteria 35 38 REAL(wp), PUBLIC :: xsizedia = 5.e-7_wp !: Minimum size criteria for diatoms 36 39 REAL(wp), PUBLIC :: xsizephy = 1.e-6_wp !: Minimum size criteria for nanophyto … … 59 62 CONTAINS 60 63 61 SUBROUTINE p4z_lim( kt )64 SUBROUTINE p4z_lim( kt, jnt ) 62 65 !!--------------------------------------------------------------------- 63 66 !! *** ROUTINE p4z_lim *** … … 69 72 !!--------------------------------------------------------------------- 70 73 ! 71 INTEGER, INTENT(in) :: kt 74 INTEGER, INTENT(in) :: kt, jnt 72 75 ! 73 76 INTEGER :: ji, jj, jk … … 89 92 zno3 = trn(ji,jj,jk,jpno3) / 40.e-6 90 93 zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 91 zferlim = MIN( zferlim, 3e-11 )94 zferlim = MIN( zferlim, 5e-11 ) 92 95 trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim ) 93 96 … … 110 113 zconc0nnh4 = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trnphy ) 111 114 115 ! Michaelis-Menten Limitation term for nutrients Small bacteria 116 ! ------------------------------------------------------------- 117 zdenom = 1. / ( concbno3 * concbnh4 + concbnh4 * trn(ji,jj,jk,jpno3) + concbno3 * trn(ji,jj,jk,jpnh4) ) 118 xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concbnh4 * zdenom 119 xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * concbno3 * zdenom 120 ! 121 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 122 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concbnh4 ) 123 zlim3 = trn(ji,jj,jk,jpfer) / ( concbfe + trn(ji,jj,jk,jpfer) ) 124 zlim4 = trn(ji,jj,jk,jpdoc) / ( xkdoc + trn(ji,jj,jk,jpdoc) ) 125 xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 126 xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 127 112 128 ! Michaelis-Menten Limitation term for nutrients Small flagellates 113 129 ! ----------------------------------------------- … … 124 140 xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 125 141 ! 126 zlim3 = trn(ji,jj,jk,jpfer) / ( concbfe + trn(ji,jj,jk,jpfer) )127 zlim4 = trn(ji,jj,jk,jpdoc) / ( xkdoc + trn(ji,jj,jk,jpdoc) )128 xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4129 130 142 ! Michaelis-Menten Limitation term for nutrients Diatoms 131 143 ! ---------------------------------------------- … … 137 149 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4 ) 138 150 zlim3 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) ) 139 zratio = trn(ji,jj,jk,jpdfe) /(trn(ji,jj,jk,jpdia)+rtrn)151 zratio = trn(ji,jj,jk,jpdfe) * z1_trndia 140 152 zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 141 153 zlim4 = MAX( 0., ( zratio - zironmin ) / qdfelim ) … … 155 167 & / ( concnno3 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + concnno3 * trn(ji,jj,jk,jpnh4) ) 156 168 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 ) 157 zlim3 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concbfe)169 zlim3 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + 5.E-11 ) 158 170 ztem1 = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 159 171 ztem2 = tsn(ji,jj,jk,jp_tem) - 10. 160 172 zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) 161 zetot2 = 1. / ( 30. + etot(ji,jj,jk) )173 zetot2 = 30. / ( 30. + etot(ji,jj,jk) ) 162 174 163 175 xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 164 176 & * ztem1 / ( 0.1 + ztem1 ) & 165 177 & * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) & 166 & * 2.325 * zetot1 * 30.* zetot2 &178 & * zetot1 * zetot2 & 167 179 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 168 180 & * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) … … 173 185 END DO 174 186 ! 187 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN ! save output diagnostics 188 ! 189 CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) ) ! euphotic layer deptht 190 CALL iom_put( "LNnut" , xlimphy(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 191 CALL iom_put( "LDnut" , xlimdia(:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 192 CALL iom_put( "LNFe" , xlimnfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term 193 CALL iom_put( "LDFe" , xlimdfe(:,:,:) * tmask(:,:,:) ) ! Iron limitation term 194 ! 195 ENDIF 196 197 ! 175 198 IF( nn_timing == 1 ) CALL timing_stop('p4z_lim') 176 199 ! … … 192 215 193 216 NAMELIST/nampislim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe, & 194 & xsizedia, xsizephy, xsizern, xsizerd, xksi1, xksi2, xkdoc,&195 & qnfelim, qdfelim, caco3r217 & concbno3, concbnh4, xsizedia, xsizephy, xsizern, xsizerd, & 218 & xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r 196 219 197 220 REWIND( numnatp ) ! read numnat … … 203 226 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 204 227 WRITE(numout,*) ' mean rainratio caco3r = ', caco3r 205 WRITE(numout,*) ' NO3 half saturation of nanophyto concnno3 = 206 WRITE(numout,*) ' NO3 half saturation of diatoms concdno3 = 228 WRITE(numout,*) ' NO3 half saturation of nanophyto concnno3 = ', concnno3 229 WRITE(numout,*) ' NO3 half saturation of diatoms concdno3 = ', concdno3 207 230 WRITE(numout,*) ' NH4 half saturation for phyto concnnh4 = ', concnnh4 208 231 WRITE(numout,*) ' NH4 half saturation for diatoms concdnh4 = ', concdnh4 … … 214 237 WRITE(numout,*) ' size ratio for nanophytoplankton xsizern = ', xsizern 215 238 WRITE(numout,*) ' size ratio for diatoms xsizerd = ', xsizerd 239 WRITE(numout,*) ' NO3 half saturation of bacteria concbno3 = ', concbno3 240 WRITE(numout,*) ' NH4 half saturation for bacteria concbnh4 = ', concbnh4 216 241 WRITE(numout,*) ' Minimum size criteria for diatoms xsizedia = ', xsizedia 217 242 WRITE(numout,*) ' Minimum size criteria for nanophyto xsizephy = ', xsizephy -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r3443 r3446 81 81 REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 82 82 REAL(wp) :: zgrazfff, zgrazffe 83 REAL(wp) :: zrfact2 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing 83 85 CHARACTER (len=25) :: charout 84 REAL(wp) :: zrfact285 86 !!--------------------------------------------------------------------- 86 87 ! 87 88 IF( nn_timing == 1 ) CALL timing_start('p4z_meso') 88 89 ! 89 90 IF( ln_diatrc .AND. lk_iomput ) CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 91 ! 90 92 DO jk = 1, jpkm1 91 93 DO jj = 1, jpj … … 145 147 146 148 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 147 grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 149 IF( ln_diatrc .AND. lk_iomput ) zgrazing(ji,jj,jk) = zgraztot 150 148 151 ! Mesozooplankton efficiency 149 152 ! -------------------------- … … 213 216 END DO 214 217 ! 215 IF( ln_diatrc .AND. lk_iomput ) THEN218 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN 216 219 zrfact2 = 1.e3 * rfact2r 217 grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) ! Total grazing of phyto by zoo 218 prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) ! Calcite production 219 IF( jnt == nrdttrc ) THEN 220 CALL iom_put( "GRAZ" , grazing ) ! Total grazing of phyto by zooplankton 221 CALL iom_put( "PCAL" , prodcal ) ! Calcite production 222 ENDIF 220 CALL iom_put( "GRAZ2", zgrazing(:,:,:) * zrfact2 * tmask(:,:,:) ) ! Total grazing of phyto by zooplankton 221 CALL iom_put( "PCAL" , prodcal(:,:,:) * zrfact2 * tmask(:,:,:) ) ! Calcite production 223 222 ENDIF 224 223 ! … … 228 227 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 229 228 ENDIF 229 ! 230 IF( ln_diatrc .AND. lk_iomput ) CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 230 231 ! 231 232 IF( nn_timing == 1 ) CALL timing_stop('p4z_meso') -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r3443 r3446 22 22 USE p4zint ! interpolation and computation of various fields 23 23 USE p4zprod ! production 24 USE iom ! I/O manager 24 25 USE prtctl_trc ! print control for debugging 25 26 … … 29 30 PUBLIC p4z_micro ! called in p4zbio.F90 30 31 PUBLIC p4z_micro_init ! called in trcsms_pisces.F90 31 PUBLIC p4z_micro_alloc ! called in trcsms_pisces.F9032 32 33 33 !! * Shared module variables … … 59 59 CONTAINS 60 60 61 SUBROUTINE p4z_micro( kt )61 SUBROUTINE p4z_micro( kt, jnt ) 62 62 !!--------------------------------------------------------------------- 63 63 !! *** ROUTINE p4z_micro *** … … 67 67 !! ** Method : - ??? 68 68 !!--------------------------------------------------------------------- 69 INTEGER, INTENT(in) :: kt ! ocean time step 69 INTEGER, INTENT(in) :: kt ! ocean time step 70 INTEGER, INTENT(in) :: jnt 71 ! 70 72 INTEGER :: ji, jj, jk 71 73 REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc … … 77 79 REAL(wp) :: zgrazp, zgrazm, zgrazsd 78 80 REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 81 REAL(wp) :: zrfact2 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgrazing 79 83 CHARACTER (len=25) :: charout 80 84 !!--------------------------------------------------------------------- … … 82 86 IF( nn_timing == 1 ) CALL timing_start('p4z_micro') 83 87 ! 84 grazing(:,:,:) = 0. !: grazing set to zero 88 IF( ln_diatrc .AND. lk_iomput ) CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 89 ! 85 90 DO jk = 1, jpkm1 86 91 DO jj = 1, jpj … … 127 132 128 133 ! Grazing by microzooplankton 129 grazing(ji,jj,jk) = grazing(ji,jj,jk) +zgraztot134 IF( ln_diatrc .AND. lk_iomput ) zgrazing(ji,jj,jk) = zgraztot 130 135 131 136 ! Various remineralization and excretion terms … … 185 190 END DO 186 191 ! 192 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN 193 zrfact2 = 1.e3 * rfact2r 194 CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * zrfact2 * tmask(:,:,:) ) ! Total grazing of phyto by zooplankton 195 ENDIF 196 ! 187 197 IF(ln_ctl) THEN ! print mean trends (used for debugging) 188 198 WRITE(charout, FMT="('micro')") … … 190 200 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 191 201 ENDIF 202 ! 203 IF( ln_diatrc .AND. lk_iomput ) CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 192 204 ! 193 205 IF( nn_timing == 1 ) CALL timing_stop('p4z_micro') … … 240 252 END SUBROUTINE p4z_micro_init 241 253 242 INTEGER FUNCTION p4z_micro_alloc()243 !!----------------------------------------------------------------------244 !! *** ROUTINE p4z_micro_alloc ***245 !!----------------------------------------------------------------------246 ALLOCATE( grazing(jpi,jpj,jpk), STAT=p4z_micro_alloc )247 IF( p4z_micro_alloc /= 0 ) CALL ctl_warn('p4z_micro_alloc : failed to allocate arrays.')248 249 END FUNCTION p4z_micro_alloc250 251 254 #else 252 255 !!====================================================================== -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r3443 r3446 29 29 REAL(wp), PUBLIC :: wchl = 0.001_wp !: 30 30 REAL(wp), PUBLIC :: wchld = 0.02_wp !: 31 REAL(wp), PUBLIC :: wchldm = 0.05_wp !: 31 32 REAL(wp), PUBLIC :: mprat = 0.01_wp !: 32 33 REAL(wp), PUBLIC :: mprat2 = 0.01_wp !: … … 150 151 REAL(wp) :: zfactfe,zfactsi,zfactch, zcompadi 151 152 REAL(wp) :: zrespp2, ztortp2, zmortp2, zstep 153 REAL(wp) :: zlim2, zlim1 152 154 CHARACTER (len=25) :: charout 153 155 !!--------------------------------------------------------------------- … … 177 179 ! Phytoplankton respiration 178 180 ! ------------------------ 179 ! zrespp2 = 1.e6 * zstep * ( wchl + wchld * max(0.,2. * ( 0.5 - xlimdia(ji,jj,jk) ) ) ) & 180 zrespp2 = 1.e6 * zstep * ( wchl + wchld * ( 1.0 - xlimdia(ji,jj,jk) ) ) & 181 & * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 181 zlim2 = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 182 zlim1 = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 ) 183 zrespp2 = 1.e6 * zstep * ( wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 184 ! zlim1 = 1.0 - xlimdia(ji,jj,jk) 185 ! zrespp2 = 1.e6 * zstep * ( wchl + wchld * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 182 186 183 187 ! Phytoplankton mortality. 184 188 ! ------------------------ 185 ztortp2 189 ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia) / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 186 190 187 191 zmortp2 = zrespp2 + ztortp2 … … 235 239 !!---------------------------------------------------------------------- 236 240 237 NAMELIST/nampismort/ wchl, wchld, mprat, mprat2, mpratm241 NAMELIST/nampismort/ wchl, wchld, wchldm, mprat, mprat2, mpratm 238 242 239 243 REWIND( numnatp ) ! read numnatp … … 246 250 WRITE(numout,*) ' quadratic mortality of phytoplankton wchl =', wchl 247 251 WRITE(numout,*) ' maximum quadratic mortality of diatoms wchld =', wchld 252 WRITE(numout,*) ' maximum quadratic mortality of diatoms wchld =', wchldm 248 253 WRITE(numout,*) ' phytoplankton mortality rate mprat =', mprat 249 254 WRITE(numout,*) ' Diatoms mortality rate mprat2 =', mprat2 -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r3443 r3446 77 77 ! 78 78 INTEGER :: ji, jj, jk 79 REAL(wp) :: zsilfac, z fact, znanotot, zdiattot, zconctemp, zconctemp279 REAL(wp) :: zsilfac, znanotot, zdiattot, zconctemp, zconctemp2 80 80 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap 81 81 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2 … … 135 135 DO ji = 1, jpi 136 136 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 137 zval = MAX( 1., zstrn(ji,jj) )138 zval = 1.5 * zval / ( 12. + zval )139 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval140 zprdia(ji,jj,jk) = zprbio(ji,jj,jk)137 zval = MAX( 1., zstrn(ji,jj) ) 138 zval = 1.5 * zval / ( 12. + zval ) 139 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 140 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 141 141 ENDIF 142 142 END DO … … 156 156 !CDIR NOVERRCHK 157 157 DO ji = 1, jpi 158 159 158 ! Computation of the P-I slope for nanos and diatoms 160 159 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 161 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 162 zadap = ztn / ( 2.+ ztn ) 163 160 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 161 zadap = ztn / ( 2.+ ztn ) 164 162 zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 165 163 zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp 166 167 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 168 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 169 170 zfact = EXP( -0.21 * znanotot ) 171 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) & 164 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 165 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 166 ! 167 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -0.21 * znanotot ) ) & 172 168 & * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 173 169 ! 174 170 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn ) & 175 171 & * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) … … 201 197 ! Computation of the P-I slope for nanos and diatoms 202 198 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 203 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 204 zadap = ztn / ( 2.+ ztn ) 205 199 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 200 zadap = ztn / ( 2.+ ztn ) 206 201 zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 207 202 zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp 208 209 zfact = EXP( -0.21 * enano(ji,jj,jk) ) 210 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) 203 ! 204 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * EXP( -0.21 * enano(ji,jj,jk) ) ) 211 205 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) 212 206 … … 264 258 zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 265 259 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 266 zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) ) 267 zsilfac2 = 1.+ 2.* zsiborn / ( zsiborn + xksi2 ) 268 zsilfac = MIN( 5.4, zsilfac * zsilfac2) 269 zysopt(ji,jj,jk) = grosip * zlim * zsilfac 260 zsiborn = trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) 261 IF (gphit(ji,jj) < -30 ) THEN 262 zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 263 ELSE 264 zsilfac2 = 1. + zsiborn / ( zsiborn + xksi2**3 ) 265 ENDIF 266 zysopt(ji,jj,jk) = grosip * zlim * zsilfac * zsilfac2 270 267 ENDIF 271 268 END DO … … 312 309 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) & 313 310 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 314 & * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) ) &311 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) ) & 315 312 & * zmax * trn(ji,jj,jk,jpphy) * rfact2 316 313 ! production terms for diatomees … … 323 320 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) & 324 321 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 325 & * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) ) &322 & * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) ) & 326 323 & * zmax * trn(ji,jj,jk,jpdia) * rfact2 327 324 ENDIF … … 426 423 IF( lk_iomput ) THEN 427 424 IF( jnt == nrdttrc ) THEN 428 CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto429 CALL iom_put( "PPPHY2" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom430 CALL iom_put( "PPNEWN" , zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto431 CALL iom_put( "PPNEWD" , zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom432 CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production433 CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom434 CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto425 CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto 426 CALL iom_put( "PPPHY2" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom 427 CALL iom_put( "PPNEWN" , zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto 428 CALL iom_put( "PPNEWD" , zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom 429 CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 430 CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom 431 CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto 435 432 CALL iom_put( "Mumax" , prmax(:,:,:) * tmask(:,:,:) ) ! Maximum growth rate 436 CALL iom_put( "MuN" , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto 437 CALL iom_put( "MuD" , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms 438 CALL iom_put( "LNnut" , xlimphy (:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 439 CALL iom_put( "LDnut" , xlimdia (:,:,:) * tmask(:,:,:) ) ! Nutrient limitation term 440 CALL iom_put( "LNFe" , xlimnfe (:,:,:) * tmask(:,:,:) ) ! Iron limitation term 441 CALL iom_put( "LDFe" , xlimdfe (:,:,:) * tmask(:,:,:) ) ! Iron limitation term 442 CALL iom_put( "LNlight" , zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term 443 CALL iom_put( "LDlight" , zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term 433 CALL iom_put( "MuN" , zprbio(:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for nanophyto 434 CALL iom_put( "MuD" , zprdia(:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) ) ! Realized growth rate for diatoms 435 CALL iom_put( "LNlight", zprbio (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term 436 CALL iom_put( "LDlight", zprdia (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) ) ! light limitation term 444 437 ENDIF 445 438 ELSE -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r3443 r3446 72 72 INTEGER :: ji, jj, jk 73 73 REAL(wp) :: zremip, zremik, zsiremin 74 REAL(wp) :: zsatur, zsatur2, znusil, z dep, zfactdep74 REAL(wp) :: zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep 75 75 REAL(wp) :: zbactfer, zorem, zorem2, zofer, zolimit 76 REAL(wp) :: zosil 76 REAL(wp) :: zosil, ztem 77 77 #if ! defined key_kriest 78 78 REAL(wp) :: zofer2 79 79 #endif 80 REAL(wp) :: zonitr, zstep 80 REAL(wp) :: zonitr, zstep, zrfact2 81 81 CHARACTER (len=25) :: charout 82 82 REAL(wp), POINTER, DIMENSION(:,: ) :: ztempbac 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi 83 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod 84 84 !!--------------------------------------------------------------------- 85 85 ! … … 87 87 ! 88 88 ! Allocate temporary workspace 89 CALL wrk_alloc( jpi, jpj, ztempbac )90 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, z olimi )89 CALL wrk_alloc( jpi, jpj, ztempbac ) 90 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi ) 91 91 92 92 ! Initialisation of temprary arrys 93 zdepbac (:,:,:) = 0._wp 94 zolimi (:,:,:) = 0._wp 93 zdepprod(:,:,:) = 1._wp 95 94 ztempbac(:,:) = 0._wp 96 95 … … 108 107 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 109 108 ELSE 110 zdepbac(ji,jj,jk) = MIN( 1., zdep / fsdept(ji,jj,jk) ) * ztempbac(ji,jj) 109 zdepmin = MIN( 1., zdep / fsdept(ji,jj,jk) ) 110 zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj) 111 zdepprod(ji,jj,jk) = zdepmin**0.273 111 112 ENDIF 112 113 END DO … … 190 191 ! studies (especially at Papa) have shown this uptake to be significant 191 192 ! ---------------------------------------------------------- 192 zbactfer = 20.e-6 * rfact2 * prmax(ji,jj,jk) & 193 & * trn(ji,jj,jk,jpfer) / ( concbfe + trn(ji,jj,jk,jpfer) ) & 194 & * trn(ji,jj,jk,jpfer) / ( 5E-10 + trn(ji,jj,jk,jpfer) ) & 195 & * zdepbac(ji,jj,jk) & 196 & * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 ) ) 197 193 zbactfer = 10.e-6 * rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk) & 194 & * trn(ji,jj,jk,jpfer) / ( 2.5E-10 + trn(ji,jj,jk,jpfer) ) & 195 & * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk) 198 196 #if defined key_kriest 199 197 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.05 … … 276 274 zsatur = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 277 275 zsatur = MAX( rtrn, zsatur ) 278 zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 279 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9.25 276 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 277 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 278 znusil2 = 0.225 * ( 1. + tsn(ji,jj,1,jp_tem) / 15.) + 0.775 * zsatur2 279 280 280 ! Two classes of BSi are considered : a labile fraction and 281 281 ! a more refractory one. The ratio between both fractions is … … 284 284 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 285 285 zdep = MAX( 0., fsdept(ji,jj,jk) - zdep ) 286 zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * zdep / wsbio2 ) 286 ztem = MAX( tsn(ji,jj,1,jp_tem), 0. ) 287 zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) 287 288 zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 288 289 zosil = zsiremin * trn(ji,jj,jk,jpgsi) … … 314 315 END DO 315 316 317 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN 318 zrfact2 = 1.e3 * rfact2r 319 CALL iom_put( "REMIN" , zolimi(:,:,:) * tmask(:,:,:) * zrfact2 ) ! Remineralisation rate 320 CALL iom_put( "DENIT" , denitr(:,:,:) * tmask(:,:,:) * zrfact2 ) ! Denitrification 321 ENDIF 316 322 317 323 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 321 327 ENDIF 322 328 ! 323 CALL wrk_dealloc( jpi, jpj, ztempbac )324 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, z olimi )329 CALL wrk_dealloc( jpi, jpj, ztempbac ) 330 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi ) 325 331 ! 326 332 IF( nn_timing == 1 ) CALL timing_stop('p4z_rem') -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r3443 r3446 183 183 ! 184 184 INTEGER :: ji, jj, jk, jm, ifpr 185 INTEGER :: ii0, ii1, ij0, ij1 185 186 INTEGER :: numdust, numsolub, numriv, numiron, numdepo, numhydro 186 187 INTEGER :: ierr, ierr1, ierr2, ierr3 … … 425 426 END DO 426 427 END DO 428 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN 429 ii0 = 176 ; ii1 = 176 ! Southern Island : Kerguelen 430 ij0 = 37 ; ij1 = 37 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 431 ! 432 ii0 = 119 ; ii1 = 119 ! South Georgia 433 ij0 = 29 ; ij1 = 29 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 434 ! 435 ii0 = 111 ; ii1 = 111 ! Falklands 436 ij0 = 35 ; ij1 = 35 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 437 ! 438 ii0 = 168 ; ii1 = 168 ! Crozet 439 ij0 = 40 ; ij1 = 40 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 440 ! 441 ii0 = 119 ; ii1 = 119 ! South Orkney 442 ij0 = 28 ; ij1 = 28 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 443 ! 444 ii0 = 140 ; ii1 = 140 ! Bouvet Island 445 ij0 = 33 ; ij1 = 33 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 446 ! 447 ii0 = 178 ; ii1 = 178 ! Prince edwards 448 ij0 = 34 ; ij1 = 34 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 449 ! 450 ii0 = 43 ; ii1 = 43 ! Balleny islands 451 ij0 = 21 ; ij1 = 21 ; zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 0.3_wp 452 ENDIF 427 453 CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 428 454 DO jk = 1, jpk … … 458 484 ! 459 485 hydrofe(:,:,:) = hydrofe(:,:,:) * hratio / cvol(:,:,:) * ryyss / fse3t(:,:,:) 460 DO jk = 1, jpkm1461 DO jj = 1, jpj462 DO ji = 1, jpi463 hydrofe(ji,jj,jk)= ( hydrofe(ji,jj,jk) * hratio ) &464 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) * ryyss ) / fse3t(ji,jj,jk)465 !! hydrofe(ji,jj,jk)= ( hydrofe(ji,jj,jk) * hratio ) / fse3t(ji,jj,jk)466 END DO467 END DO468 END DO469 486 ENDIF 470 487 ! -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r3443 r3446 177 177 ! 178 178 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) & 179 & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * fse3t(:,:,:) *tmask(:,:,:) ) ! iron inputs from sediments179 & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 180 180 ENDIF 181 181 … … 186 186 ! 187 187 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) & 188 & CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * fse3t(:,:,:) *tmask(:,:,:) ) ! hydrothermal iron input188 & CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input 189 189 ENDIF 190 190 … … 319 319 zfact = zlim * rfact2 320 320 #endif 321 ztrfer = trn(ji,jj,jk,jpfer) / ( concfediaz + trn(ji,jj,jk,jpfer))322 ztrpo4 = trn (ji,jj,jk,jppo4) / ( concnnh4 + trn(ji,jj,jk,jppo4) )321 ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 322 ztrpo4 = trn (ji,jj,jk,jppo4) / ( concnnh4 + trn (ji,jj,jk,jppo4) ) 323 323 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) & 324 324 & * zfact * MIN( ztrfer, ztrpo4 ) * ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) ) … … 343 343 IF( ln_diatrc ) THEN 344 344 zfact = 1.e+3 * rfact2r 345 IF( lk_iomput ) THEN 346 zwork1(:,:) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1) 347 zwork4(:,:) = zwork4(:,:) * zfact * tmask(:,:,1) 348 IF( jnt == nrdttrc ) THEN 349 CALL iom_put( "Nfix" , zwork1 ) ! Nitrate reduction in the sediments 350 CALL iom_put( "Sdenit", zwork4 ) ! Nitrate reduction in the sediments 351 ENDIF 345 IF( lk_iomput .AND. jnt == nrdttrc ) THEN 346 CALL iom_put( "Nfix" , znitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation 347 CALL iom_put( "Sdenit", zwork4(:,:) * rno3 * zfact * tmask(:,:,1) ) ! Nitrate reduction in the sediments 352 348 ELSE 353 349 trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1) -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r3443 r3446 200 200 ! Part I : Coagulation dependent on turbulence 201 201 zagg1 = 25.9 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 202 zagg2 = 44 24. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)202 zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 203 203 204 204 ! Part II : Differential settling 205 205 206 206 ! Aggregation of small into large particles 207 zagg3 = 47. 2* zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)208 zagg4 = 3.3 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)207 zagg3 = 47.1 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 208 zagg4 = 3.3 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 209 209 210 210 zagg = zagg1 + zagg2 + zagg3 + zagg4 … … 215 215 ! 2nd term is shear aggregation of DOC-POC 216 216 ! 3rd term is differential settling of DOC-POC 217 zaggdoc = ( ( 34.9 * trn(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) *zfact &218 & + 2.4 * zstep * trn(ji,jj,jk,jppoc) ) * trn(ji,jj,jk,jpdoc)217 zaggdoc = ( ( 0.369 * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * zfact & 218 & + 2.4 * zstep * trn(ji,jj,jk,jppoc) ) * 0.3 * trn(ji,jj,jk,jpdoc) 219 219 ! zaggdoc = ( 0.83 * trn(ji,jj,jk,jpdoc) + 271. * trn(ji,jj,jk,jppoc) ) * zfact * trn(ji,jj,jk,jpdoc) 220 220 ! transfer of DOC to GOC : 221 221 ! 1st term is shear aggregation 222 222 ! 2nd term is differential settling 223 ! zaggdoc2 = (3.3E3 * zfact + 0.1 * zstep ) * trn(ji,jj,jk,jpgoc)* trn(ji,jj,jk,jpdoc)224 zaggdoc2 = 1.07e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc)223 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trn(ji,jj,jk,jpgoc) * 0.3 * trn(ji,jj,jk,jpdoc) 224 ! zaggdoc2 = 1.07e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 225 225 ! tranfer of DOC to POC due to brownian motion 226 zaggdoc3 = 0.02 * ( 16706. * trn(ji,jj,jk,jppoc) + 231. * trn(ji,jj,jk,jpdoc) ) * zstep * trn(ji,jj,jk,jpdoc) 226 ! zaggdoc3 = 0.02 * ( 16706. * trn(ji,jj,jk,jppoc) + 231. * trn(ji,jj,jk,jpdoc) ) * zstep * trn(ji,jj,jk,jpdoc) 227 zaggdoc3 = ( 5095. * trn(ji,jj,jk,jppoc) + 114. * 0.3 * trn(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trn(ji,jj,jk,jpdoc) 227 228 228 229 ! Update the trends -
branches/2012/dev_r3438_LOCEAN15_PISLOB/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r3443 r3446 19 19 INTEGER :: numnatp 20 20 21 !!* Biological fluxes for light 22 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: neln !: number of T-levels + 1 in the euphotic layer 23 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: heup !: euphotic layer depth 24 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot !: par (photosynthetic available radiation) 25 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: grazing !: Total zooplankton grazing 21 !!* Biological fluxes for light : variables shared by pisces & lobster 22 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: neln !: number of T-levels + 1 in the euphotic layer 23 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: heup !: euphotic layer depth 24 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot !: par (photosynthetic available radiation) 25 ! 26 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksi !: LOBSTER : zooplakton closure 27 ! !: PISCES : silicon dependant half saturation 26 28 27 29 #if defined key_pisces … … 52 54 53 55 !!* Biological fluxes for primary production 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksi !: ???55 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: xksimax !: ??? 56 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnanono3 !: ??? … … 65 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimdfe !: ??? 66 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimsi !: ??? 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: biron !: bioavailable fraction of iron 67 69 68 70 … … 71 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrfac !: ?? 72 74 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbac !: ?? 75 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbacl !: ?? 73 76 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiss !: ?? 74 77 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prodcal !: Calcite production … … 112 115 !!---------------------------------------------------------------------- 113 116 USE lib_mpp , ONLY: ctl_warn 114 INTEGER :: ierr( 7) ! Local variables117 INTEGER :: ierr(6) ! Local variables 115 118 !!---------------------------------------------------------------------- 116 119 ierr(:) = 0 117 !* Biological fluxes for light 118 ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj), STAT=ierr(1) ) 119 ! 120 ALLOCATE( grazing(jpi,jpj,jpk) , STAT=ierr(2) ) 120 !* Biological fluxes for light : shared variables for pisces & lobster 121 ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj), xksi(jpi,jpj), STAT=ierr(1) ) 121 122 ! 122 123 #if defined key_pisces 123 124 !* Biological fluxes for primary production 124 ALLOCATE( xksimax(jpi,jpj) , xksi(jpi,jpj), &125 ALLOCATE( xksimax(jpi,jpj) , biron (jpi,jpj,jpk), & 125 126 & xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk), & 126 127 & xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk), & … … 128 129 & xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk), & 129 130 & xlimsi (jpi,jpj,jpk), concdfe (jpi,jpj,jpk), & 130 & concnfe (jpi,jpj,jpk), STAT=ierr( 3) )131 & concnfe (jpi,jpj,jpk), STAT=ierr(2) ) 131 132 ! 132 133 !* SMS for the organic matter 133 134 ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk), & 134 135 & xlimbac (jpi,jpj,jpk), xdiss (jpi,jpj,jpk), & 135 & prodcal(jpi,jpj,jpk) , STAT=ierr(4) )136 ! 136 & xlimbacl(jpi,jpj,jpk), prodcal(jpi,jpj,jpk), STAT=ierr(3) ) 137 137 138 !* Variable for chemistry of the CO2 cycle 138 139 ALLOCATE( akb3(jpi,jpj,jpk) , ak13 (jpi,jpj,jpk) , & 139 140 & ak23(jpi,jpj,jpk) , aksp (jpi,jpj,jpk) , & 140 141 & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , & 141 & hi (jpi,jpj,jpk) , excess(jpi,jpj,jpk) , STAT=ierr( 5) )142 & hi (jpi,jpj,jpk) , excess(jpi,jpj,jpk) , STAT=ierr(4) ) 142 143 ! 143 144 !* Temperature dependancy of SMS terms 144 ALLOCATE( tgfunc(jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk) , STAT=ierr( 6) )145 ALLOCATE( tgfunc(jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk) , STAT=ierr(5) ) 145 146 ! 146 147 !* Array used to indicate negative tracer values 147 ALLOCATE( xnegtr(jpi,jpj,jpk) , STAT=ierr( 7) )148 ALLOCATE( xnegtr(jpi,jpj,jpk) , STAT=ierr(6) ) 148 149 #endif 149 150 !
Note: See TracChangeset
for help on using the changeset viewer.