- Timestamp:
- 2016-11-01T14:23:51+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r7012_ROBUST5_CNRS/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r7068 r7162 76 76 CALL p4z_che ! initialize the chemical constants 77 77 ! 78 IF( .NOT. ln_rsttr ) THEN ; CALL p4z_ph_ini! set PH at kt=nit00078 IF( .NOT. ln_rsttr ) THEN ; CALL ahini_for_at(hi) ! set PH at kt=nit000 79 79 ELSE ; CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields 80 80 ENDIF … … 84 84 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers 85 85 ! 86 ! ! set time step size (Euler/Leapfrog) 87 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc ! at nittrc000 88 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog) 89 ENDIF 86 rfact = r2dttrc 90 87 ! 91 88 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN … … 195 192 !! namelist: natext, natbio, natsms 196 193 !!---------------------------------------------------------------------- 197 NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, niter1max, niter2max 194 NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, wsbio2max, wsbio2scale, & 195 & niter1max, niter2max, wfep, ldocp, ldocz, lthet, & 196 & no3rat3, po4rat3 197 198 198 NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp 199 199 NAMELIST/nampismass/ ln_check_mass … … 212 212 IF(lwp) THEN ! control print 213 213 WRITE(numout,*) ' Namelist : nampisbio' 214 WRITE(numout,*) ' frequence pour la biologie nrdttrc =', nrdttrc 215 WRITE(numout,*) ' POC sinking speed wsbio =', wsbio 216 WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort 217 WRITE(numout,*) ' Fe/C in zooplankton ferat3 =', ferat3 218 WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2 214 WRITE(numout,*) ' frequence pour la biologie nrdttrc =', nrdttrc 215 WRITE(numout,*) ' POC sinking speed wsbio =', wsbio 216 WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort 217 IF( ln_p5z ) THEN 218 WRITE(numout,*) ' N/C in zooplankton no3rat3 =', no3rat3 219 WRITE(numout,*) ' P/C in zooplankton po4rat3 =', po4rat3 220 ENDIF 221 WRITE(numout,*) ' Fe/C in zooplankton ferat3 =', ferat3 222 WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2 223 WRITE(numout,*) ' Big particles maximum sinking speed wsbio2max =', wsbio2max 224 WRITE(numout,*) ' Big particles sinking speed length scale wsbio2scale =', wsbio2scale 219 225 WRITE(numout,*) ' Maximum number of iterations for POC niter1max =', niter1max 220 226 WRITE(numout,*) ' Maximum number of iterations for GOC niter2max =', niter2max 221 ENDIF 227 IF( ln_ligand ) THEN 228 WRITE(numout,*) ' FeP sinking speed wfep =', wfep 229 IF( ln_p4z ) THEN 230 WRITE(numout,*) ' Phyto ligand production per unit doc ldocp =', ldocp 231 WRITE(numout,*) ' Zoo ligand production per unit doc ldocz =', ldocz 232 WRITE(numout,*) ' Proportional loss of ligands due to Fe uptake lthet =', lthet 233 ENDIF 234 ENDIF 235 ENDIF 236 222 237 223 238 REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping … … 256 271 END SUBROUTINE p4z_sms_init 257 272 258 SUBROUTINE p4z_ph_ini259 !!---------------------------------------------------------------------260 !! *** ROUTINE p4z_ini_ph ***261 !!262 !! ** Purpose : Initialization of chemical variables of the carbon cycle263 !!---------------------------------------------------------------------264 INTEGER :: ji, jj, jk265 REAL(wp) :: zcaralk, zbicarb, zco3266 REAL(wp) :: ztmas, ztmas1267 !!---------------------------------------------------------------------268 269 ! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???)270 ! --------------------------------------------------------271 DO jk = 1, jpk272 DO jj = 1, jpj273 DO ji = 1, jpi274 ztmas = tmask(ji,jj,jk)275 ztmas1 = 1. - tmask(ji,jj,jk)276 zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) )277 zco3 = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1278 zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk )279 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1280 END DO281 END DO282 END DO283 !284 END SUBROUTINE p4z_ph_ini285 286 273 SUBROUTINE p4z_rst( kt, cdrw ) 287 274 !!--------------------------------------------------------------------- … … 297 284 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 298 285 ! 299 INTEGER :: ji, jj, jk300 REAL(wp) :: zcaralk, zbicarb, zco3301 REAL(wp) :: ztmas, ztmas1302 286 !!--------------------------------------------------------------------- 303 287 … … 311 295 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 312 296 ELSE 313 ! hi(:,:,:) = 1.e-9 314 CALL p4z_ph_ini 297 CALL ahini_for_at(hi) 315 298 ENDIF 316 299 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) … … 327 310 ENDIF 328 311 ! 312 IF( ln_p5z ) THEN 313 IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 314 CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sized(:,:,:) ) 315 CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sized(:,:,:) ) 316 CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:) ) 317 ELSE 318 sizep(:,:,:) = 1. 319 sizen(:,:,:) = 1. 320 sized(:,:,:) = 1. 321 ENDIF 322 ENDIF 323 ! 329 324 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 330 325 IF( kt == nitrst ) THEN … … 337 332 CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 338 333 CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) 334 IF( ln_p5z ) THEN 335 CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sized(:,:,:) ) 336 CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sized(:,:,:) ) 337 CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) ) 338 ENDIF 339 339 ENDIF 340 340 ! … … 423 423 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 424 424 CHARACTER(LEN=100) :: cltxt 425 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol426 425 INTEGER :: jk 426 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork 427 427 !!---------------------------------------------------------------------- 428 428 … … 444 444 ENDIF 445 445 446 CALL wrk_alloc( jpi, jpj, jpk, zwork ) 446 447 ! 447 448 IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 448 449 ! Compute the budget of NO3, ALK, Si, Fer 449 no3budget = glob_sum( ( trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) & 450 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 451 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) & 452 & + trn(:,:,:,jppoc) & 453 & + trn(:,:,:,jpgoc) & 454 & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) ) 455 ! 456 no3budget = no3budget / areatot 457 CALL iom_put( "pno3tot", no3budget ) 450 IF( ln_p4z ) THEN 451 zwork(:,:,:) = trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) & 452 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 453 & + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) & 454 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 455 ELSE 456 zwork(:,:,:) = trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph) & 457 & + trn(:,:,:,jpndi) + trn(:,:,:,jpnpi) & 458 & + trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon) & 459 & + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3 460 ENDIF 461 ! 462 no3budget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) 463 no3budget = no3budget / areatot 464 CALL iom_put( "pno3tot", no3budget ) 458 465 ENDIF 459 466 ! 460 467 IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 461 po4budget = glob_sum( ( trn(:,:,:,jppo4) & 462 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 463 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) & 464 & + trn(:,:,:,jppoc) & 465 & + trn(:,:,:,jpgoc) & 466 & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) ) 467 po4budget = po4budget / areatot 468 CALL iom_put( "ppo4tot", po4budget ) 468 IF( ln_p4z ) THEN 469 zwork(:,:,:) = trn(:,:,:,jppo4) & 470 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 471 & + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) & 472 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 473 ELSE 474 zwork(:,:,:) = trn(:,:,:,jppo4) + trn(:,:,:,jppph) & 475 & + trn(:,:,:,jppdi) + trn(:,:,:,jpppi) & 476 & + trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop) & 477 & + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3 478 ENDIF 479 ! 480 po4budget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) 481 po4budget = po4budget / areatot 482 CALL iom_put( "ppo4tot", po4budget ) 469 483 ENDIF 470 484 ! 471 485 IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 472 silbudget = glob_sum( ( trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) &473 & + trn(:,:,:,jpdsi) ) * cvol(:,:,:) )474 !486 zwork(:,:,:) = trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi) 487 ! 488 silbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) 475 489 silbudget = silbudget / areatot 476 490 CALL iom_put( "psiltot", silbudget ) … … 478 492 ! 479 493 IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 480 alkbudget = glob_sum( ( trn(:,:,:,jpno3) * rno3 & 481 & + trn(:,:,:,jptal) & 482 & + trn(:,:,:,jpcal) * 2. ) * cvol(:,:,:) ) 483 ! 494 zwork(:,:,:) = trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2. 495 ! 496 alkbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) ! 484 497 alkbudget = alkbudget / areatot 485 498 CALL iom_put( "palktot", alkbudget ) … … 487 500 ! 488 501 IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 489 ferbudget = glob_sum( ( trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) & 490 & + trn(:,:,:,jpdfe) & 491 & + trn(:,:,:,jpbfe) & 492 & + trn(:,:,:,jpsfe) & 493 & + trn(:,:,:,jpzoo) * ferat3 & 494 & + trn(:,:,:,jpmes) * ferat3 ) * cvol(:,:,:) ) 495 ! 502 zwork(:,:,:) = trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe) & 503 & + trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe) & 504 & + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * ferat3 505 IF( ln_ligand) zwork(:,:,:) = zwork(:,:,:) + trn(:,:,:,jpfep) 506 ! 507 ferbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) 496 508 ferbudget = ferbudget / areatot 497 509 CALL iom_put( "pfertot", ferbudget ) 498 510 ENDIF 499 511 ! 500 512 CALL wrk_dealloc( jpi, jpj, jpk, zwork ) 513 ! 501 514 ! Global budget of N SMS : denitrification in the water column and in the sediment 502 515 ! nitrogen fixation by the diazotrophs
Note: See TracChangeset
for help on using the changeset viewer.
