Changeset 7180 for branches/CNRS
- Timestamp:
- 2016-11-03T16:41:10+01:00 (7 years ago)
- Location:
- branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 20 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zagg.F90
r6841 r7180 94 94 zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc) 95 95 ! tranfer of DOC to POC due to brownian motion 96 zaggdoc3 = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc)) *zstep * 0.3 * trb(ji,jj,jk,jpdoc)96 zaggdoc3 = 114. * 0.3 * trb(ji,jj,jk,jpdoc) *zstep * 0.3 * trb(ji,jj,jk,jpdoc) 97 97 98 98 ! Update the trends -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r6966 r7180 445 445 ! Liu and Millero (1999) only valid 5 - 50 degC 446 446 ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 447 fesol(ji,jj,jk,1) = 10**( (-13.486) - (0.1856* (zis**0.5)) + (0.3073*zis) + (5254.0/ztkel1))448 fesol(ji,jj,jk,2) = 10**(2.517 - (0.885*(zis**0.5)) + (0.2139 * zis) - (1320.0/ztkel1))449 fesol(ji,jj,jk,3) = 10**(0.4511 - (0.3305*(zis**0.5)) - (1996.0/ztkel1))450 fesol(ji,jj,jk,4) = 10**(-0.2965 - (0.7881*(zis**0.5)) - (4086.0/ztkel1))451 fesol(ji,jj,jk,5) = 10**(4.4466 - (0.8505*(zis**0.5)) - (7980.0/ztkel1))447 fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856*zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 448 fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139*zis - 1320.0/ztkel1 ) 449 fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 450 fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 451 fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 452 452 END DO 453 453 END DO -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90
r6966 r7180 69 69 INTEGER :: ji, jj, jk, jic, jn 70 70 REAL(wp) :: zdep, zlam1a, zlam1b, zlamfac 71 REAL(wp) :: zkeq, zfeequi, zfesatur, zfecoll, fe3sol 71 REAL(wp) :: zkeq, zfeequi, zfesatur, zfecoll, fe3sol, fe3sol1 72 72 REAL(wp) :: zdenom1, zscave, zaggdfea, zaggdfeb, zcoag 73 73 REAL(wp) :: ztrc, zdust … … 279 279 zfecoll = ( 0.3 * zFeL1(ji,jj,jk) + 0.5 * zFeL2(ji,jj,jk) ) * 1E-9 280 280 ELSE 281 zfeequi = zFe3(ji,jj,jk) * 1E-9 281 282 IF (ln_fecolloid) THEN 282 zfeequi = zFe3(ji,jj,jk) * 1E-9283 283 zhplus = max( rtrn, hi(ji,jj,jk) ) 284 fe3sol = fesol(ji,jj,jk,1) * ( fesol(ji,jj,jk,2) * zhplus**2 &284 fe3sol = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2 & 285 285 & + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4) & 286 286 & + fesol(ji,jj,jk,5) / zhplus ) 287 287 zfecoll = max( ( 0.1 * zFeL1(ji,jj,jk) * 1E-9 ), ( zFeL1(ji,jj,jk) * 1E-9 -fe3sol ) ) 288 #if defined key_ligand 289 zligco = max( ( 0.1 * trn(ji,jj,jk,jplgw) ), ( trn(ji,jj,jk,jplgw) - fe3sol ) ) 290 #endif 288 291 ELSE 289 zfeequi = zFe3(ji,jj,jk) * 1E-9290 292 zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 293 #if defined key_ligand 294 zligco = 0.5 * trn(ji,jj,jk,jplgw) 295 #endif 291 296 fe3sol = 0. 292 kfep = 0.293 297 ENDIF 294 298 ENDIF … … 324 328 ! ---------------------------------------------------------------- 325 329 zlam1a = ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk) & 326 & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) + 0. * trb(ji,jj,jk,jppoc))330 & + ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) 327 331 zaggdfea = zlam1a * zstep * zfecoll 328 #if defined key_ligand329 zligco = max( ( 0.1 * trn(ji,jj,jk,jplgw) ), ( trn(ji,jj,jk,jplgw) - fe3sol ) )330 zaggliga = zlam1a * zstep * zligco331 #endif332 332 ! 333 333 #if defined key_kriest 334 334 zaggdfeb = 0. 335 !336 # if defined key_ligand337 zaggligb = 0.338 # endif339 !340 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag341 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb342 !343 335 #else 344 !345 336 zlam1b = 3.53E3 * trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 346 337 zaggdfeb = zlam1b * zstep * zfecoll 347 ! 348 # if defined key_ligand 349 zaggligb = zlam1b * zstep * zligco 350 # endif 338 #endif 351 339 ! precipitation of Fe3+, creation of nanoparticles 352 340 precip(ji,jj,jk) = max( 0., (zfeequi - fe3sol) ) * kfep * zstep … … 355 343 & - zcoag - precip(ji,jj,jk) 356 344 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 345 #if ! defined key_kriest 357 346 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 358 347 #endif 359 348 #if defined key_ligand 349 zaggliga = zlam1a * zstep * zligco 350 # if defined key_kriest 351 zaggligb = 0. 352 # else 353 zaggligb = zlam1b * zstep * zligco 354 # endif 360 355 tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + precip(ji,jj,jk) 361 356 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb … … 404 399 ENDIF 405 400 ! 406 CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 407 IF( ln_fechem ) CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 401 CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 402 IF( ln_fechem ) THEN 403 CALL wrk_dealloc( jpi, jpj, zstrn, zstrn2 ) 404 CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 405 ENDIF 408 406 ! 409 407 IF( nn_timing == 1 ) CALL timing_stop('p4z_fechem') -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zligand.F90
r6841 r7180 75 75 ! --------------------------------------------------------- 76 76 zstep = xstep 77 zstep2 = zstep / 365 ! per year78 77 # if defined key_degrad 79 78 zstep = zstep * facvol(ji,jj,jk) 80 zstep2 = zstep2 * facvol(ji,jj,jk)81 79 # endif 80 zstep2 = zstep / 365. ! per year 82 81 ! production from remineralisation of organic matter 83 82 zlgwp = orem(ji,jj,jk) * rlig … … 88 87 zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * zstep2 * trn(ji,jj,jk,jplgw) 89 88 ! photochem loss of weak ligand 90 zlablgw = MAX( 0., trn(ji,jj,jk, jpfer) * plig(ji,jj,jk) )91 89 zlgwpr = prlgw * zstep * etot(ji,jj,jk) * trn(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj)) 92 90 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr … … 105 103 ! lower in the aphotici zone 106 104 ! ! 25 Wm-2 constant 107 zrfepa = rfep * (1- EXP(- 1*etot(ji,jj,jk) / 25. ) ) * (1.- fr_i(ji,jj))105 zrfepa = rfep * (1- EXP(-etot(ji,jj,jk) / 25. ) ) * (1.- fr_i(ji,jj)) 108 106 zrfepa = MAX( (zrfepa / 10.0), zrfepa ) ! min of 10 days lifetime 109 107 zfepr = rfep * zstep * trn(ji,jj,jk,jpfep) -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r6841 r7180 187 187 & / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) ) 188 188 zlim2 = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 ) 189 zlim3 = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) + 1.E-10 189 zlim3 = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) + 1.E-10 ) 190 190 ztem1 = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 191 191 ztem2 = tsn(ji,jj,jk,jp_tem) - 10. -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r6841 r7180 85 85 DO jj = 1, jpj 86 86 DO ji = 1, jpi 87 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e- 9), 0.e0 )87 zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 88 88 zstep = xstep 89 89 # if defined key_degrad -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r6966 r7180 64 64 INTEGER :: ji, jj, jk, jn 65 65 REAL(wp) :: zremip, zremig, zdep, zorem, zorem2, zofer 66 REAL(wp) :: zsizek, zsizek1, alphat, remint 67 REAL(wp) :: solgoc, zpoc 66 REAL(wp) :: zsizek, zsizek1, alphat, remint, solgoc, zpoc 68 67 #if ! defined key_kriest 69 68 REAL(wp) :: zofer2, zofer3 … … 71 70 REAL(wp) :: zstep, zrfact2 72 71 CHARACTER (len=25) :: charout 73 REAL(wp), POINTER, DIMENSION(:,: ) :: totprod, totthick, totcons74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zremipoc, zremigoc, zorem372 REAL(wp), POINTER, DIMENSION(:,: ) :: totprod, totthick, totcons 73 REAL(wp), POINTER, DIMENSION(:,:,:) :: zremipoc, zremigoc, zorem3 75 74 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: alphag 76 75 !!--------------------------------------------------------------------- … … 79 78 ! 80 79 ! Allocate temporary workspace 81 CALL wrk_alloc( jpi, jpj, totprod, totthick, totcons )80 CALL wrk_alloc( jpi, jpj, totprod, totthick, totcons ) 82 81 CALL wrk_alloc( jpi, jpj, jpk, zremipoc, zremigoc, zorem3 ) 83 82 ALLOCATE( alphag(jpi,jpj,jpk,jcpoc) ) … … 124 123 alphat = 0. 125 124 remint = 0. 125 ! 126 zsizek1 = fse3t(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 127 zsizek = fse3t(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 126 128 ! 127 129 IF ( fsdept(ji,jj,jk-1) <= zdep ) THEN … … 147 149 ! ----------------------------------------------------- 148 150 ! 149 zsizek = zdep / (wsbio2 + rtrn) * tgfunc(ji,jj,jk-1)150 zsizek1 = fse3t(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)151 151 ! the concentration of each lability class is calculated 152 152 ! as the sum of the different sources and sinks 153 153 ! Please note that production of new GOC experiences 154 154 ! degradation 155 alphag(ji,jj,jk,jn) = alphan(jn) / (reminp(jn) * tgfunc(ji,jj,jk-1) ) & 156 & * (1. - exp( -reminp(jn) * zsizek ) ) * exp( -reminp(jn) * zsizek1 ) & 157 & * zpoc + prodgoc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) & 158 & * rday / rfact2 * alphan(jn) / reminp(jn) / tgfunc(ji,jj,jk) 155 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 156 & + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn) & 157 & * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 159 158 alphat = alphat + alphag(ji,jj,jk,jn) 160 159 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) … … 172 171 ! 173 172 DO jn = 1, jcpoc 174 zsizek = fse3t(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 175 zsizek1 = fse3t(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 176 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) & 177 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) & 178 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek ) ) & 179 & * exp( -reminp(jn) * zsizek1 ) + prodgoc(ji,jj,jk) / tgfunc(ji,jj,jk) & 180 & * ( 1. - exp( -reminp(jn) * zsizek1 ) ) ) * rday / rfact2 * alphan(jn) & 181 & / reminp(jn) 173 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek & 174 & + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1. & 175 & - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 176 & / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) 182 177 alphat = alphat + alphag(ji,jj,jk,jn) 183 178 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) … … 208 203 zremig = zremigoc(ji,jj,jk) * zstep * tgfunc(ji,jj,jk) 209 204 zorem2 = zremig * trb(ji,jj,jk,jpgoc) 205 orem(ji,jj,jk) = zorem2 210 206 zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 211 207 zofer2 = zremig * trb(ji,jj,jk,jpbfe) … … 220 216 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3 221 217 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2 222 orem(ji,jj,jk) = zorem2223 218 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 224 219 END DO … … 249 244 DO jj = 1, jpj 250 245 DO ji = 1, jpi 251 IF (tmask(ji,jj,jk) == 1.) THEN 252 zdep = hmld(ji,jj) 253 IF( fsdept(ji,jj,jk) <= zdep ) THEN 254 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * fse3t(ji,jj,jk) * rday/ rfact2 255 ! The temperature effect is included here 256 totthick(ji,jj) = totthick(ji,jj) + fse3t(ji,jj,jk)* tgfunc(ji,jj,jk) 257 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * fse3t(ji,jj,jk) * rday/ rfact2 & 258 & / ( trb(ji,jj,jk,jppoc) + rtrn ) 259 ENDIF 246 zdep = hmld(ji,jj) 247 IF (tmask(ji,jj,jk) == 1. .AND. fsdept(ji,jj,jk) <= zdep ) THEN 248 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * fse3t(ji,jj,jk) * rday/ rfact2 249 ! The temperature effect is included here 250 totthick(ji,jj) = totthick(ji,jj) + fse3t(ji,jj,jk)* tgfunc(ji,jj,jk) 251 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * fse3t(ji,jj,jk) * rday/ rfact2 & 252 & / ( trb(ji,jj,jk,jppoc) + rtrn ) 260 253 ENDIF 261 254 END DO … … 310 303 remint = 0. 311 304 ! 305 ! the scale factors are corrected with temperature 306 zsizek1 = fse3t(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 307 zsizek = fse3t(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 308 ! 312 309 ! Special treatment of the level just below the MXL 313 310 ! See the comments in the GOC section … … 323 320 ! 324 321 DO jn = 1, jcpoc 325 ! the scale factor is corrected with temperature326 zsizek1 = fse3t(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)327 322 ! computation of the lability spectrum applying the 328 323 ! different sources and sinks 329 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) + zorem3(ji,jj,jk) & 330 & * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * rday / rfact2 & 331 & * alphag(ji,jj,jk,jn) / reminp(jn) / tgfunc(ji,jj,jk) 324 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 325 & + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 326 & / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn) & 327 & * zsizek ) ) 332 328 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 333 329 alphat = alphat + alphap(ji,jj,jk,jn) … … 346 342 ! 347 343 DO jn = 1, jcpoc 348 zsizek = fse3t(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 349 zsizek1 = fse3t(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 350 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) & 351 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) & 352 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek ) ) & 353 & * exp( -reminp(jn) * zsizek1 ) + prodpoc(ji,jj,jk) / tgfunc(ji,jj,jk) & 354 & * ( 1. - exp( -reminp(jn) * zsizek1 ) ) ) * rday / rfact2 * alphan(jn) & 355 & / reminp(jn) 356 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) + zorem3(ji,jj,jk-1) & 357 & * alphag(ji,jj,jk-1,jn) / tgfunc(ji,jj,jk-1) * rday / rfact2 * ( 1. & 358 & - exp( -reminp(jn) * zsizek ) ) * exp( -reminp(jn) * zsizek1 ) & 359 & + zorem3(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * rday & 360 & / rfact2 * alphag(ji,jj,jk,jn) / reminp(jn) / tgfunc(ji,jj,jk) 344 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) & 345 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn) & 346 & + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn) & 347 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) & 348 & * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) & 349 & * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1. & 350 & - exp( -reminp(jn) * zsizek ) ) 361 351 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 362 352 alphat = alphat + alphap(ji,jj,jk,jn) -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r6966 r7180 81 81 REAL(wp) :: zprod, zproreg, zproreg2, zprochln, zprochld 82 82 REAL(wp) :: zmaxday, zdocprod, zpislopen, zpisloped 83 REAL(wp) :: zrum, zcodel, zargu, zval, zfeup 83 REAL(wp) :: zmxltst, zmxlday 84 REAL(wp) :: zrum, zcodel, zargu, zval, zfeup, chlcnm_n, chlcdm_n 84 85 REAL(wp) :: zfact 85 86 CHARACTER (len=25) :: charout 86 REAL(wp), POINTER, DIMENSION(:,: ) :: zstrn, zw2d 87 REAL(wp), POINTER, DIMENSION(:,: ) :: zstrn, zw2d, zmixnano, zmixdiat 87 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d 88 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd … … 93 94 ! 94 95 ! Allocate temporary workspace 95 CALL wrk_alloc( jpi, jpj, z strn )96 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 96 97 CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 97 98 CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) … … 104 105 105 106 ! Computation of the optimal production 106 prmax(:,:,:) = 0. 6_wp * r1_rday * tgfunc(:,:,:)107 prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:) 107 108 IF( lk_degrad ) prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:) 108 109 … … 127 128 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 128 129 zval = MAX( 1., zstrn(ji,jj) ) 129 zmxl_fac(ji,jj,jk) = zval 130 IF( fsdept(ji,jj,jk) <= hmld(ji,jj) ) THEN 131 zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 132 ENDIF 130 133 zmxl_chl(ji,jj,jk) = zval / 24. 131 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 132 zval = MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 133 zmxl_fac(ji,jj,jk) = zmxl_fac(ji,jj,jk) * zval 134 zmxl_chl(ji,jj,jk) = zmxl_chl(ji,jj,jk) * zval 135 ENDIF 136 zmxl_fac(ji,jj,jk) = ( 1. - exp( -0.2 * zmxl_fac(ji,jj,jk) ) ) 137 zmxl_chl(ji,jj,jk) = zmxl_chl(ji,jj,jk) 134 zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 138 135 ENDIF 139 136 END DO … … 143 140 zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 144 141 zprdia(:,:,:) = zprbio(:,:,:) 142 143 ! Maximum light intensity 144 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 145 145 146 146 ! Computation of the P-I slope for nanos and diatoms … … 253 253 END DO 254 254 255 ! Mixed-layer effect on production 255 256 ! Sea-ice effect on production 256 257 257 258 DO jk = 1, jpkm1 258 zprbio(:,:,jk) = zprbio(:,:,jk) * ( 1. - fr_i(:,:) ) 259 zprdia(:,:,jk) = zprdia(:,:,jk) * ( 1. - fr_i(:,:) ) 260 END DO 261 259 DO jj = 1, jpj 260 DO ji = 1, jpi 261 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 262 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 263 END DO 264 END DO 265 END DO 262 266 263 267 ! Computation of the various production terms … … 303 307 zprod = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 304 308 zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 305 zprochln = zprochln + (chlcnm-chlcmin) * 12. * zprod / & 309 chlcnm_n = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 310 zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 306 311 & ( zpislopeadn(ji,jj,jk) * znanotot +rtrn) 307 312 ! production terms for diatoms ( chlorophyll ) … … 309 314 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 310 315 zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 311 zprochld = zprochld + (chlcdm-chlcmin) * 12. * zprod / & 316 chlcdm_n = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 317 zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 312 318 & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 313 319 ! Update the arrays TRA which contain the Chla sources and sinks … … 485 491 ENDIF 486 492 ! 487 CALL wrk_dealloc( jpi, jpj, zstrn )493 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 488 494 CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt ) 489 495 CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90
r6841 r7180 25 25 USE p4zlim ! Phytoplankton limitation factors 26 26 USE p4zprod ! Growth rate of the 2 phyto groups 27 USE p4zsink ! Sinking of particles 27 28 USE prtctl_trc ! print control for debugging 28 29 USE iom ! I/O manager … … 43 44 REAL(wp), PUBLIC :: xsilab !: fraction of labile biogenic silica 44 45 REAL(wp), PUBLIC :: oxymin !: halk saturation constant for anoxia 46 REAL(wp), PUBLIC :: oxymin2 !: Minimum O2 concentration for oxic remin. 47 REAL(wp), PUBLIC :: feratb !: Fe/C quota in bacteria 48 REAL(wp), PUBLIC :: xkferb !: Half-saturation constant for bacteria Fe/C 45 49 46 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitnh4 !: - - - - -48 51 49 52 … … 71 74 REAL(wp) :: zremik, zsiremin 72 75 REAL(wp) :: zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep 73 REAL(wp) :: zbactfer, zolimit 74 REAL(wp) :: zosil, ztem 76 REAL(wp) :: zbactfer, zolimit, zdenitnh4 77 REAL(wp) :: zosil, ztem,ztoto,zpuis 75 78 REAL(wp) :: zonitr, zstep, zrfact2 76 79 CHARACTER (len=25) :: charout 77 80 REAL(wp), POINTER, DIMENSION(:,: ) :: ztempbac 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zfacsi, zfacsib 79 82 !!--------------------------------------------------------------------- 80 83 ! … … 83 86 ! Allocate temporary workspace 84 87 CALL wrk_alloc( jpi, jpj, ztempbac ) 85 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi )88 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib ) 86 89 87 90 ! Initialization of local variables … … 91 94 zdepprod(:,:,:) = 1._wp 92 95 ztempbac(:,:) = 0._wp 96 zfacsib(:,:,:) = xsilab / ( 1.0 - xsilab ) 97 zfacsi(:,:,:) = xsilab 93 98 94 99 ! Computation of the mean phytoplankton concentration as … … 117 122 DO ji = 1, jpi 118 123 ! denitrification factor computed from O2 levels 119 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trb(ji,jj,jk,jpoxy) ) & 124 ! ---------------------------------------------- 125 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( oxymin2 - trb(ji,jj,jk,jpoxy) ) & 120 126 & / ( oxymin + trb(ji,jj,jk,jpoxy) ) ) 121 127 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) … … 147 153 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 148 154 denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 149 ! 155 ! Update of the tracers trends 156 ! ---------------------------- 157 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 158 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 159 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit 160 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) 161 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut 162 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 163 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk) & 164 & + ( rdenit + 1.) * denitr(ji,jj,jk) ) 150 165 END DO 151 166 END DO … … 165 180 zonitr = nitrif * zstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) ) & 166 181 & / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) ) 167 denitnh4(ji,jj,jk)= nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)182 zdenitnh4 = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 168 183 ! Update of the tracers trends 169 184 ! ---------------------------- 170 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk)171 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk)185 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4 186 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4 172 187 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 173 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk)174 END DO 175 END DO 176 END DO 177 178 188 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 189 END DO 190 END DO 191 END DO 192 193 IF(ln_ctl) THEN ! print mean trends (used for debugging) 179 194 WRITE(charout, FMT="('rem1')") 180 195 CALL prt_ctl_trc_info(charout) 181 196 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 182 197 ENDIF 183 198 184 199 DO jk = 1, jpkm1 … … 190 205 ! studies (especially at Papa) have shown this uptake to be significant 191 206 ! ---------------------------------------------------------- 192 zbactfer = 10.e-6* rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk) &193 & * trb(ji,jj,jk,jpfer) / ( 2.5E-10+ trb(ji,jj,jk,jpfer) ) &207 zbactfer = feratb * rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk) & 208 & * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) ) & 194 209 & * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk) 195 210 #if defined key_kriest … … 205 220 END DO 206 221 207 222 IF(ln_ctl) THEN ! print mean trends (used for debugging) 208 223 WRITE(charout, FMT="('rem2')") 209 224 CALL prt_ctl_trc_info(charout) 210 225 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 211 ENDIF 226 ENDIF 227 228 ! Initialization of the array which contains the labile fraction 229 ! of bSi. Set to a constant in the upper ocean 230 ! --------------------------------------------------------------- 212 231 213 232 DO jk = 1, jpkm1 … … 218 237 zstep = zstep * facvol(ji,jj,jk) 219 238 # endif 239 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 240 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 241 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 242 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 243 220 244 ! Remineralization rate of BSi depedant on T and saturation 221 245 ! --------------------------------------------------------- 222 zsatur = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 223 zsatur = MAX( rtrn, zsatur ) 224 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 225 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 226 znusil2 = 0.225 * ( 1. + tsn(ji,jj,1,jp_tem) / 15.) + 0.775 * zsatur2 227 228 ! Two classes of BSi are considered : a labile fraction and 229 ! a more refractory one. The ratio between both fractions is 230 ! constant and specified in the namelist. 231 ! ---------------------------------------------------------- 232 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 233 zdep = MAX( 0., fsdept(ji,jj,jk) - zdep ) 234 ztem = MAX( tsn(ji,jj,1,jp_tem), 0. ) 235 zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) 236 zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 246 IF ( fsdept(ji,jj,jk) > zdep ) THEN 247 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem ) & 248 & * znusil * fse3t(ji,jj,jk) / wsbio4(ji,jj,jk) ) 249 zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 250 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem ) & 251 & * znusil * fse3t(ji,jj,jk) / wsbio4(ji,jj,jk) ) 252 ENDIF 253 zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * zstep * znusil 237 254 zosil = zsiremin * trb(ji,jj,jk,jpgsi) 238 255 ! 239 256 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil 240 257 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 241 !242 243 244 END DO258 END DO 259 END DO 260 END DO 261 245 262 246 263 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 250 267 ENDIF 251 268 252 ! Update the arrays TRA which contain the biological sources and sinks253 ! --------------------------------------------------------------------254 255 DO jk = 1, jpkm1256 tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk)257 tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk)258 tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit259 tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk)260 tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi (:,:,jk) * o2ut261 tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk)262 tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) )263 END DO264 265 269 IF( ln_diatrc .AND. lk_iomput .AND. jnt == nrdttrc ) THEN 266 270 zrfact2 = 1.e3 * rfact2r … … 268 272 CALL iom_put( "DENIT" , denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zrfact2 ) ! Denitrification 269 273 ENDIF 270 271 IF(ln_ctl) THEN ! print mean trends (used for debugging)272 WRITE(charout, FMT="('rem4')")273 CALL prt_ctl_trc_info(charout)274 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)275 ENDIF276 274 ! 277 275 CALL wrk_dealloc( jpi, jpj, ztempbac ) 278 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi )276 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib ) 279 277 ! 280 278 IF( nn_timing == 1 ) CALL timing_stop('p4z_rem') … … 296 294 !!---------------------------------------------------------------------- 297 295 NAMELIST/nampisrem/ xremik, nitrif, xsirem, xsiremlab, xsilab, & 298 & oxymin 296 & oxymin, oxymin2, feratb, xkferb 299 297 INTEGER :: ios ! Local integer output status for namelist read 300 298 … … 318 316 WRITE(numout,*) ' NH4 nitrification rate nitrif =', nitrif 319 317 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =', oxymin 318 WRITE(numout,*) ' Minimum O2 concentration for oxic remin. oxymin2 =', oxymin2 319 WRITE(numout,*) ' Bacterial Fe/C ratio feratb =', feratb 320 WRITE(numout,*) ' Half-saturation constant for bact. Fe/C xkferb =', xkferb 320 321 ENDIF 321 322 ! 322 323 nitrfac (:,:,:) = 0._wp 323 324 denitr (:,:,:) = 0._wp 324 denitnh4(:,:,:) = 0._wp325 325 326 326 END SUBROUTINE p4z_rem_init … … 331 331 !! *** ROUTINE p4z_rem_alloc *** 332 332 !!---------------------------------------------------------------------- 333 ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk),STAT=p4z_rem_alloc )333 ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 334 334 ! 335 335 IF( p4z_rem_alloc /= 0 ) CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r6841 r7180 199 199 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 200 200 #if defined key_ligand 201 tr n(:,:,:,jpfep) = trn(:,:,:,jpfep) + (ironsed(:,:,:) * fep_rats ) * rfact2201 tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + (ironsed(:,:,:) * fep_rats ) * rfact2 202 202 #endif 203 203 ! … … 211 211 tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 212 212 #if defined key_ligand 213 tr n(:,:,:,jpfep) = trn(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2214 tr n(:,:,:,jplgw) = trn(:,:,:,jplgw) + ( hydrofe(:,:,:) * 0.5 ) * rfact2213 tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2 214 tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * 0.5 ) * rfact2 215 215 #endif 216 216 ! … … 343 343 zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 344 344 # if defined key_ligand 345 tr n(ji,jj,ikt,jpfep) = trn(ji,jj,ikt,jpfep) - trn(ji,jj,ikt,jpfep) * zwssfep345 tra(ji,jj,ikt,jpfep) = tra(ji,jj,ikt,jpfep) - trn(ji,jj,ikt,jpfep) * zwssfep 346 346 # endif 347 347 # else … … 351 351 zwstpoc = trb(ji,jj,ikt,jppoc) * zws3 352 352 # if defined key_ligand 353 tr n(ji,jj,ikt,jpfep) = trn(ji,jj,ikt,jpfep) - trn(ji,jj,ikt,jpfep) * zwssfep353 tra(ji,jj,ikt,jpfep) = tra(ji,jj,ikt,jpfep) - trn(ji,jj,ikt,jpfep) * zwssfep 354 354 # endif 355 355 # endif -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r6841 r7180 172 172 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2 ) ) 173 173 #if defined key_ligand 174 wsfep(ji,jj,jk) = MIN( wsfep(ji,jj,jk), zwsmax * FLOAT( iiter1 ) )174 wsfep(ji,jj,jk) = MIN( wsfep(ji,jj,jk), zwsmax * FLOAT( iiter1 ) ) 175 175 #endif 176 176 ENDIF -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zmeso.F90
r6453 r7180 371 371 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 372 372 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe 373 zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jppoc) +trb(ji,jj,jk,jpgoc) + rtrn )374 zgrazcal = ( zgrazffeg + zgrazpoc )* (1. - part2) * zfracal373 zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 374 zgrazcal = zgrazffeg * (1. - part2) * zfracal 375 375 #endif 376 376 ! calcite production -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zmicro.F90
r6453 r7180 84 84 REAL(wp) :: zgraztotc, zgraztotn, zgraztotp, zgraztotf, zbasresn, zbasresp, zbasresf 85 85 REAL(wp) :: zgradoc, zgradon, zgradop, zgraref, zgradoct, zgradont, zgradopt, zgrareft 86 REAL(wp) :: zexcess, zgraren, zgrarep, zgrarem , zfracal, zgrazcal86 REAL(wp) :: zexcess, zgraren, zgrarep, zgrarem 87 87 REAL(wp) :: zgrapoc, zgrapon, zgrapop, zgrapof, zprcaca, zmortz 88 88 REAL(wp) :: zrespz, ztortz, zgrasratf, zgrasratn, zgrasratp … … 172 172 zgrazpon = zgrazpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn ) 173 173 zgrazpop = zgrazpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn ) 174 zgrazpof = zgrazpoc* trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 174 175 zgrazdc = zgraze * ztmp4 * zdenom 175 176 zgrazdn = zgrazdc * trb(ji,jj,jk,jpndi) / (trb(ji,jj,jk,jpdia) + rtrn) 176 177 zgrazdp = zgrazdc * trb(ji,jj,jk,jppdi) / (trb(ji,jj,jk,jpdia) + rtrn) 177 178 zgrazdf = zgrazdc * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 178 zgrazpof = zgrazpoc* trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)179 179 ! 180 180 zgraztotc = zgraznc + zgrazpoc + zgrazdc + zgrazz + zgrazpc … … 296 296 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 297 297 ! 298 zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn )299 zgrazcal = zgrazpoc * (1. - part ) * zfracal300 298 zprcaca = part * zprcaca 301 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca + zgrazcal302 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca )&299 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem - zprcaca 300 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca & 303 301 & + rno3 * zgraren 304 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca - zgrazcal302 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 305 303 #if defined key_kriest 306 304 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortz * xkr_dmicro & -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zmort.F90
r6453 r7180 204 204 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 205 205 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortp 206 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortp207 206 #endif 208 207 END DO … … 285 284 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe 286 285 #else 287 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2288 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + (zrespp2 + 0.5 * ztortp2)* zfactn289 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + (zrespp2 + 0.5 * ztortp2)* zfactp290 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + (zrespp2 + 0.5 * ztortp2)* zfactfe291 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 *ztortp2292 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + 0.5 *ztortp2 * zfactn293 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 0.5 *ztortp2 * zfactp294 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 *ztortp2 * zfactfe295 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 *ztortp2296 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2286 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 287 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zrespp2 * zfactn 288 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zrespp2 * zfactp 289 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zrespp2 * zfactfe 290 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ztortp2 291 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + ztortp2 * zfactn 292 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + ztortp2 * zfactp 293 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ztortp2 * zfactfe 294 prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ztortp2 295 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 297 296 #endif 298 297 END DO -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zpoc.F90
r6966 r7180 128 128 remint = 0. 129 129 ! 130 zsizek1 = fse3t(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 131 zsizek = fse3t(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 132 ! 130 133 IF ( fsdept(ji,jj,jk-1) <= zdep ) THEN 131 134 ! … … 150 153 ! ----------------------------------------------------- 151 154 ! 152 zsizek = zdep / (wsbio2 + rtrn) * tgfunc(ji,jj,jk-1)153 zsizek1 = fse3t(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)154 155 ! the concentration of each lability class is calculated 155 156 ! as the sum of the different sources and sinks 156 157 ! Please note that production of new GOC experiences 157 158 ! degradation 158 alphag(ji,jj,jk,jn) = alphan(jn) / (reminp(jn) * tgfunc(ji,jj,jk-1) ) & 159 & * (1. - exp( -reminp(jn) * zsizek ) ) * exp( -reminp(jn) * zsizek1 ) & 160 & * zpoc + prodgoc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) & 161 & * rday / rfact2 * alphan(jn) / reminp(jn) / tgfunc(ji,jj,jk) 159 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 160 & + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn) & 161 & * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2 162 162 alphat = alphat + alphag(ji,jj,jk,jn) 163 163 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) … … 175 175 ! 176 176 DO jn = 1, jcpoc 177 zsizek = fse3t(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 178 zsizek1 = fse3t(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 179 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) & 180 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) & 181 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek ) ) & 182 & * exp( -reminp(jn) * zsizek1 ) + prodgoc(ji,jj,jk) / tgfunc(ji,jj,jk) & 183 & * ( 1. - exp( -reminp(jn) * zsizek1 ) ) ) * rday / rfact2 * alphan(jn) & 184 & / reminp(jn) 177 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek & 178 & + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1. & 179 & - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 180 & / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) 185 181 alphat = alphat + alphag(ji,jj,jk,jn) 186 182 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) … … 212 208 zopoc2 = zremig * trb(ji,jj,jk,jpgoc) 213 209 orem(ji,jj,jk) = zopoc2 210 zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 214 211 zopon2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpgon) 215 212 zopop2 = xremipp / xremipc * zremig * trb(ji,jj,jk,jpgop) 216 213 zofer2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpbfe) 217 zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc)218 214 219 215 ! Update the appropriate tracers trends … … 258 254 DO jj = 1, jpj 259 255 DO ji = 1, jpi 260 IF (tmask(ji,jj,jk) == 1.) THEN 261 zdep = hmld(ji,jj) 262 IF( fsdept(ji,jj,jk) <= zdep ) THEN 263 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * fse3t(ji,jj,jk) * rday/ rfact2 264 ! The temperature effect is included here 265 totthick(ji,jj) = totthick(ji,jj) + fse3t(ji,jj,jk)* tgfunc(ji,jj,jk) 266 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * fse3t(ji,jj,jk) * rday/ rfact2 & 267 & / ( trb(ji,jj,jk,jppoc) + rtrn ) 268 ENDIF 256 zdep = hmld(ji,jj) 257 IF (tmask(ji,jj,jk) == 1. .AND. fsdept(ji,jj,jk) <= zdep ) THEN 258 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * fse3t(ji,jj,jk) * rday/ rfact2 259 ! The temperature effect is included here 260 totthick(ji,jj) = totthick(ji,jj) + fse3t(ji,jj,jk)* tgfunc(ji,jj,jk) 261 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * fse3t(ji,jj,jk) * rday/ rfact2 & 262 & / ( trb(ji,jj,jk,jppoc) + rtrn ) 269 263 ENDIF 270 264 END DO … … 319 313 remint = 0. 320 314 ! 315 ! the scale factors are corrected with temperature 316 zsizek1 = fse3t(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 317 zsizek = fse3t(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 318 ! 321 319 ! Special treatment of the level just below the MXL 322 320 ! See the comments in the GOC section … … 332 330 ! 333 331 DO jn = 1, jcpoc 334 ! the scale factor is corrected with temperature335 zsizek1 = fse3t(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk)336 332 ! computation of the lability spectrum applying the 337 333 ! different sources and sinks 338 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) + zorem3(ji,jj,jk) & 339 & * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * rday / rfact2 & 340 & * alphag(ji,jj,jk,jn) / reminp(jn) / tgfunc(ji,jj,jk) 334 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 335 & + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 336 & / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn) & 337 & * zsizek ) ) 341 338 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 342 339 alphat = alphat + alphap(ji,jj,jk,jn) … … 355 352 ! 356 353 DO jn = 1, jcpoc 357 zsizek = fse3t(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 358 zsizek1 = fse3t(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 359 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) & 360 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) & 361 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek ) ) & 362 & * exp( -reminp(jn) * zsizek1 ) + prodpoc(ji,jj,jk) / tgfunc(ji,jj,jk) & 363 & * ( 1. - exp( -reminp(jn) * zsizek1 ) ) ) * rday / rfact2 * alphan(jn) & 364 & / reminp(jn) 365 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) + zorem3(ji,jj,jk-1) & 366 & * alphag(ji,jj,jk-1,jn) / tgfunc(ji,jj,jk-1) * rday / rfact2 * ( 1. & 367 & - exp( -reminp(jn) * zsizek ) ) * exp( -reminp(jn) * zsizek1 ) & 368 & + zorem3(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * rday & 369 & / rfact2 * alphag(ji,jj,jk,jn) / reminp(jn) / tgfunc(ji,jj,jk) 354 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) & 355 & * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn) & 356 & + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn) & 357 & / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) & 358 & * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) & 359 & * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1. & 360 & - exp( -reminp(jn) * zsizek ) ) 370 361 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 371 362 alphat = alphat + alphap(ji,jj,jk,jn) -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zprod.F90
r6966 r7180 88 88 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zprontot, zproptot, zprodtot 89 89 REAL(wp) :: zprnutmax, zdocprod, zprochln, zprochld, zprochlp 90 REAL(wp) :: zpislopen, zpislopep, zpisloped 90 REAL(wp) :: zpislopen, zpislopep, zpisloped, thetannm_n, thetandm_n, thetanpm_n 91 91 REAL(wp) :: zrum, zcodel, zargu, zval, zfeup 92 92 REAL(wp) :: zrfact2 … … 382 382 znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 383 383 zprod = rday * (zpronewn(ji,jj,jk) + zproregn(ji,jj,jk)) * zprchln(ji,jj,jk) * xlimphy(ji,jj,jk) 384 zprochln = thetannm * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 384 thetannm_n = MIN ( thetannm, ( thetannm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) & 385 & * (1. - 1.14 / 43.4 * 20.)) 386 zprochln = thetannm_n * zprod / ( zpislopeadn(ji,jj,jk) * znanotot + rtrn ) 385 387 zprochln = MAX(zprochln, chlcmin * 12. * zprorcan (ji,jj,jk) ) 386 388 ! production terms for picophyto. ( chlorophyll ) 387 389 zpicotot = epico(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 388 390 zprod = rday * (zpronewp(ji,jj,jk) + zproregp(ji,jj,jk)) * zprchlp(ji,jj,jk) * xlimpic(ji,jj,jk) 389 zprochlp = thetanpm * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 391 thetanpm_n = MIN ( thetanpm, ( thetanpm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) & 392 & * (1. - 1.14 / 43.4 * 20.)) 393 zprochlp = thetanpm_n * zprod / ( zpislopeadp(ji,jj,jk) * zpicotot + rtrn ) 390 394 zprochlp = MAX(zprochlp, chlcmin * 12. * zprorcap(ji,jj,jk) ) 391 395 ! production terms for diatomees ( chlorophyll ) 392 396 zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 393 397 zprod = rday * (zpronewd(ji,jj,jk) + zproregd(ji,jj,jk)) * zprchld(ji,jj,jk) * xlimdia(ji,jj,jk) 394 zprochld = thetandm * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 398 thetandm_n = MIN ( thetandm, ( thetandm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) & 399 & * (1. - 1.14 / 43.4 * 20.)) 400 zprochld = thetandm_n * zprod / ( zpislopeadd(ji,jj,jk) * zdiattot + rtrn ) 395 401 zprochld = MAX(zprochld, chlcmin * 12. * zprorcad(ji,jj,jk) ) 396 402 ! Update the arrays TRA which contain the Chla sources and sinks -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P5Z/p5zrem.F90
r6841 r7180 75 75 REAL(wp) :: zremik, zremikc, zremikn, zremikp, zsiremin 76 76 REAL(wp) :: zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep 77 REAL(wp) :: zbactfer, zolimit 77 REAL(wp) :: zbactfer, zolimit, zonitr, zstep, zrfact2 78 78 REAL(wp) :: zosil, ztem, zdenitnh4, zolimic, zolimin, zolimip, zdenitrn, zdenitrp 79 REAL(wp) :: zonitr, zstep, zrfact280 79 CHARACTER (len=25) :: charout 81 80 REAL(wp), POINTER, DIMENSION(:,: ) :: ztempbac 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zwork1, zdepprod 81 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zwork1, zdepprod, zfacsi, zfacsib 83 82 !!--------------------------------------------------------------------- 84 83 ! … … 87 86 ! Allocate temporary workspace 88 87 CALL wrk_alloc( jpi, jpj, ztempbac ) 89 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zwork1 )88 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zwork1, zfacsi, zfacsib ) 90 89 91 90 ! Initialisation of temprary arrys 92 91 zdepprod(:,:,:) = 1._wp 93 92 ztempbac(:,:) = 0._wp 93 zfacsib(:,:,:) = xsilab / ( 1.0 - xsilab ) 94 zfacsi(:,:,:) = xsilab 94 95 95 96 ! Computation of the mean phytoplankton concentration as … … 236 237 ENDIF 237 238 239 ! Initialization of the array which contains the labile fraction 240 ! of bSi. Set to a constant in the upper ocean 241 ! --------------------------------------------------------------- 242 238 243 DO jk = 1, jpkm1 239 244 DO jj = 1, jpj … … 243 248 zstep = zstep * facvol(ji,jj,jk) 244 249 # endif 250 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 251 zsatur = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 252 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 253 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 254 245 255 ! Remineralization rate of BSi depedant on T and saturation 246 256 ! --------------------------------------------------------- 247 zsatur = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 248 zsatur = MAX( rtrn, zsatur ) 249 zsatur2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 250 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 251 znusil2 = 0.225 * ( 1. + tsn(ji,jj,1,jp_tem) / 15.) + 0.775 * zsatur2 252 253 ! Two classes of BSi are considered : a labile fraction and 254 ! a more refractory one. The ratio between both fractions is 255 ! constant and specified in the namelist. 256 ! ---------------------------------------------------------- 257 zdep = MAX( hmld(ji,jj), heup_01(ji,jj) ) 258 zdep = MAX( 0., fsdept(ji,jj,jk) - zdep ) 259 ztem = MAX( tsn(ji,jj,1,jp_tem), 0. ) 260 zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) 261 zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 257 IF ( fsdept(ji,jj,jk) > zdep ) THEN 258 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem ) & 259 & * znusil * fse3t(ji,jj,jk) / wsbio4(ji,jj,jk) ) 260 zfacsi(ji,jj,jk) = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 261 zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem ) & 262 & * znusil * fse3t(ji,jj,jk) / wsbio4(ji,jj,jk) ) 263 ENDIF 264 zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * zstep * znusil 262 265 zosil = zsiremin * trb(ji,jj,jk,jpgsi) 263 266 ! 264 267 tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil 265 268 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 266 !269 ENDIF 267 270 END DO 268 271 END DO … … 280 283 CALL iom_put( "DENIT" , denitrc(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zrfact2 ) ! Denitrification 281 284 ENDIF 282 283 IF(ln_ctl) THEN ! print mean trends (used for debugging)284 WRITE(charout, FMT="('rem4')")285 CALL prt_ctl_trc_info(charout)286 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)287 ENDIF288 285 ! 289 286 CALL wrk_dealloc( jpi, jpj, ztempbac ) 290 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zwork1 )287 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zwork1, zfacsi, zfacsib ) 291 288 ! 292 289 IF( nn_timing == 1 ) CALL timing_stop('p5z_rem') -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r6455 r7180 176 176 #if defined key_ligand 177 177 trn(:,:,:,jplgw) = 0.6E-9 178 trn(:,:,:,jpfep) = 0. * 5.e-6178 trn(:,:,:,jpfep) = 0. 179 179 #endif 180 180 … … 316 316 #if defined key_ligand 317 317 trn(:,:,:,jplgw) = 0.6E-9 318 trn(:,:,:,jpfep) = 0. * 5.e-6318 trn(:,:,:,jpfep) = 0. 319 319 #endif 320 320 -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r4990 r7180 54 54 CHARACTER (len=22) :: charout 55 55 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 56 INTEGER :: jn 56 57 !!---------------------------------------------------------------------- 57 58 ! -
branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r6455 r7180 102 102 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 103 103 104 IF( ln_rsttr .AND. &! Restart: read in restart file104 IF( ln_rsttr .AND. .NOT. ln_top_euler .AND. & ! Restart: read in restart file 105 105 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 106 106 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file'
Note: See TracChangeset
for help on using the changeset viewer.