New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12524 – NEMO

Changeset 12524


Ignore:
Timestamp:
2020-03-09T14:42:03+01:00 (4 years ago)
Author:
aumont
Message:

DVM of mesozooplankton + slight changes on prognostic ligands

Location:
NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p4zligand.F90

    r11536 r12524  
    2525   REAL(wp), PUBLIC ::  rlig     !: Remin ligand production 
    2626   REAL(wp), PUBLIC ::  prlgw    !: Photochemical of weak ligand 
     27   REAL(wp), PUBLIC ::  xklig    !: 1/2 saturation constant of photolysis 
    2728 
    2829   !!---------------------------------------------------------------------- 
    … …  
    6566               zlgwr = 1. / zlgwr * tgfunc(ji,jj,jk) * ( xstep / nyear_len(1) ) * blim(ji,jj,jk) * trb(ji,jj,jk,jplgw) 
    6667               ! photochem loss of weak ligand 
    67                zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw) * (1. - fr_i(ji,jj)) 
     68               zlgwpr = prlgw * xstep * etot(ji,jj,jk) * trb(ji,jj,jk,jplgw)**3 * (1. - fr_i(ji,jj))   & 
     69               &        / ( trb(ji,jj,jk,jplgw)**2 + (xklig)**2) 
    6870               tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zlgwp - zlgwr - zlgwpr 
    6971               zligrem(ji,jj,jk)   = zlgwr 
    … …  
    117119      INTEGER ::   ios   ! Local integer  
    118120      ! 
    119       NAMELIST/nampislig/ rlgw, prlgw, rlgs, rlig 
     121      NAMELIST/nampislig/ rlgw, prlgw, rlgs, rlig, xklig 
    120122      !!---------------------------------------------------------------------- 
    121123      ! 
    … …  
    139141         WRITE(numout,*) '      Photolysis of weak ligand                    prlgw =', prlgw 
    140142         WRITE(numout,*) '      Lifetime (years) of strong ligands           rlgs  =', rlgs 
     143         WRITE(numout,*) '      1/2 saturation for photolysis                xklig =', xklig 
    141144      ENDIF 
    142145      ! 

  • NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p4zmeso.F90

    r12360 r12524  
    2323   PUBLIC   p4z_meso              ! called in p4zbio.F90 
    2424   PUBLIC   p4z_meso_init         ! called in trcsms_pisces.F90 
     25   PUBLIC   p4z_meso_alloc 
    2526 
    2627   REAL(wp), PUBLIC ::  part2        !: part of calcite not dissolved in mesozoo guts 
    … …  
    4344   REAL(wp), PUBLIC ::  epsher2min   !: minimum growth efficiency at high food for grazing 2 
    4445   REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate 
     46   REAL(wp), PUBLIC ::  xfracmig     !: Fractional biomass of meso that performs DVM 
     47   LOGICAL , PUBLIC ::  ln_dvm_meso  !: Boolean to activate DVM of mesozooplankton 
     48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: depmig 
     49   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: kmig  
    4550 
    4651   !!---------------------------------------------------------------------- 
    … …  
    6166      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
    6267      ! 
    63       INTEGER  :: ji, jj, jk 
     68      INTEGER  :: ji, jj, jk, jkt 
    6469      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
    6570      REAL(wp) :: zgraze2 , zdenom, zdenom2 
    … …  
    6772      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 
    6873      REAL(wp) :: zepsherf, zepshert, zepsherq, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 
    69       REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz, zgrasrat, zgrasratn 
     74      REAL(wp) :: zmigreltime, zprcaca, zmortz, zgrasrat, zgrasratn 
    7075      REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof 
    7176      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 
    7277      REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg 
     78      REAL(wp) :: zrum, zcodel, zargu, zval 
    7379      CHARACTER (len=25) :: charout 
    7480      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarem, zgraref, zgrapoc, zgrapof 
     82      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zgramigrem, zgramigref, zgramigpoc, zgramigpof, zstrn 
    7583      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d, zz2ligprod 
    7684      !!--------------------------------------------------------------------- 
    … …  
    8593         zz2ligprod(:,:,:) = 0._wp 
    8694      ENDIF 
     95      ! 
     96      ! Diurnal vertical migration of mesozooplankton 
     97      ! --------------------------------------------- 
     98      IF (ln_dvm_meso) CALL p4z_meso_depmig 
    8799      ! 
    88100      DO jk = 1, jpkm1 
    … …  
    111123                  &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
    112124 
    113                !   Mesozooplankton grazing 
    114                !   ------------------------ 
     125               ! Mesozooplankton grazing 
     126               ! ------------------------ 
    115127               zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc  
    116128               zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
    … …  
    173185               zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 ) 
    174186               zepsherv  = zepsherf * zepshert * zepsherq 
    175                zgrarem2  = zgraztotc * ( 1. - zepsherv - unass2 ) & 
    176                &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 
    177                zgrafer2  = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    & 
    178                &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
    179                zgrapoc2  = zgraztotc * unass2 
    180  
    181                !   Update the arrays TRA which contain the biological sources and sinks 
    182                zgrarsig  = zgrarem2 * sigma2 
    183                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
    184                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    185                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
    186                ! 
    187                IF( ln_ligand ) THEN  
    188                   tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz 
    189                   zz2ligprod(ji,jj,jk) = (zgrarem2 - zgrarsig) * ldocz 
    190                ENDIF 
    191                ! 
    192                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    193                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    194                zfezoo2(ji,jj,jk)   = zgrafer2 
    195                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    196                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
    197  
     187               !  
     188               ! Impact of grazing on the prognostic variables 
     189               ! --------------------------------------------- 
    198190               zmortz = ztortz + zrespz 
    199191               zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
    200                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc  
     192               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc 
    201193               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
    202194               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    … …  
    208200               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    209201               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    210  
    211202               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac 
    212203               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
    213204               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    214                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
    215                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
     205               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg - zfrac 
    216206               consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
    217207               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    218                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     & 
    219                  &                + zgraztotf * unass2 - zfracfe 
     208               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg - zfracfe 
     209               ! Calcite remineralization due to zooplankton activity 
    220210               zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 
    221211               zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
    222                ! calcite production 
     212               ! calcite production by zooplankton activity 
    223213               zprcaca = xfracal(ji,jj,jk) * zgrazn 
    224214               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    … …  
    228218               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 
    229219               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
     220                 
     221               ! Correct the fluxes for the effect of DVM 
     222               ! A fixed fraction of mesozooplankton is assumed to migrate 
     223               ! --------------------------------------------------------- 
     224               zgrarem(ji,jj,jk) = zgraztotc * ( 1. - zepsherv - unass2 ) & 
     225               &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz 
     226               zgraref(ji,jj,jk) = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    & 
     227               &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz ) 
     228               zgrapoc(ji,jj,jk) = zgraztotc * unass2 + zmortzgoc 
     229               zgrapof(ji,jj,jk) = zgraztotf * unass2 + ferat3 * zmortzgoc 
     230            END DO  
     231         END DO 
     232      END DO 
     233 
     234      IF (ln_dvm_meso) THEN 
     235         ALLOCATE( zgramigrem(jpi,jpj), zgramigref(jpi,jpj), zgramigpoc(jpi,jpj), zgramigpof(jpi,jpj) ) 
     236         ALLOCATE( zstrn(jpi,jpj) ) 
     237         zgramigrem(:,:) = 0.0    ;   zgramigref(:,:) = 0.0 
     238         zgramigpoc(:,:)  = 0.0   ;   zgramigpof(:,:) = 0.0 
     239 
     240         ! compute the day length depending on latitude and the day 
     241         zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
     242         zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
     243 
     244         ! day length in hours 
     245         zstrn(:,:) = 0. 
     246         DO jj = 1, jpj 
     247            DO ji = 1, jpi 
     248               zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     249               zargu = MAX( -1., MIN(  1., zargu ) ) 
     250               zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     251               zstrn(ji,jj) = MIN(0.75, MAX( 0.25, zstrn(ji,jj) / 24.) ) 
     252            END DO 
     253         END DO 
     254 
     255 
     256         DO jk = 1, jpk 
     257            DO jj = 1, jpj 
     258               DO ji = 1, jpi 
     259 
     260                  !   Compute the amount of materials that will go into vertical migration 
     261                  zmigreltime = (1. - zstrn(ji,jj)) 
     262                  IF ( gdept_n(ji,jj,jk) <= heup(ji,jj) ) THEN 
     263                     zgramigrem(ji,jj) = zgramigrem(ji,jj) + xfracmig * zgrarem(ji,jj,jk) * (1. - zmigreltime )    & 
     264                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     265                     zgramigref(ji,jj) = zgramigref(ji,jj) + xfracmig * zgraref(ji,jj,jk) * (1. - zmigreltime )   & 
     266                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     267                     zgramigpoc(ji,jj) = zgramigpoc(ji,jj) + xfracmig * zgrapoc(ji,jj,jk) * (1. - zmigreltime )   & 
     268                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     269                     zgramigpof(ji,jj) = zgramigpof(ji,jj) + xfracmig * zgrapof(ji,jj,jk) * (1. - zmigreltime )   & 
     270                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     271 
     272                     zgrarem(ji,jj,jk) = zgrarem(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     273                     zgraref(ji,jj,jk) = zgraref(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     274                     zgrapoc(ji,jj,jk) = zgrapoc(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     275                     zgrapof(ji,jj,jk) = zgrapof(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     276                  ENDIF 
     277               END DO 
     278            END DO 
     279         END DO 
     280       
     281         DO jj = 1, jpj 
     282            DO ji = 1, jpi 
     283               IF (tmask(ji,jj,1) == 1.) THEN 
     284                  jkt = kmig(ji,jj) 
     285                  zgrarem(ji,jj,jkt) = zgrarem(ji,jj,jkt) + zgramigrem(ji,jj) / e3t_n(ji,jj,jkt)  
     286                  zgraref(ji,jj,jkt) = zgraref(ji,jj,jkt) + zgramigref(ji,jj) / e3t_n(ji,jj,jkt) 
     287                  zgrapoc(ji,jj,jkt) = zgrapoc(ji,jj,jkt) + zgramigpoc(ji,jj) / e3t_n(ji,jj,jkt) 
     288                  zgrapof(ji,jj,jkt) = zgrapof(ji,jj,jkt) + zgramigpof(ji,jj) / e3t_n(ji,jj,jkt) 
     289               ENDIF 
     290            END DO 
     291         END DO 
     292         ! 
     293         ! Deallocate temporary variables 
     294         ! ------------------------------ 
     295         DEALLOCATE( zgramigrem, zgramigref, zgramigpoc, zgramigpof ) 
     296         DEALLOCATE( zstrn ) 
     297 
     298      ENDIF 
     299 
     300      DO jk = 1, jpk 
     301         DO jj = 1, jpj 
     302            DO ji = 1, jpi 
     303               !   Update the arrays TRA which contain the biological sources and sinks 
     304               zgrarsig  = zgrarem(ji,jj,jk) * sigma2 
     305               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     306               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     307               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem(ji,jj,jk) - zgrarsig 
     308               ! 
     309               IF( ln_ligand ) THEN  
     310                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem(ji,jj,jk) - zgrarsig) * ldocz 
     311                  zz2ligprod(ji,jj,jk) = (zgrarem(ji,jj,jk) - zgrarsig) * ldocz 
     312               ENDIF 
     313               ! 
     314               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
     315               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref(ji,jj,jk) 
     316               zfezoo2(ji,jj,jk)   = zgraref(ji,jj,jk) 
     317               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     318               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
     319               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc(ji,jj,jk) 
     320               prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk)   + zgrapoc(ji,jj,jk) 
     321               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgrapof(ji,jj,jk) 
    230322            END DO 
    231323         END DO 
    … …  
    281373      NAMELIST/namp4zmes/ part2, grazrat2, resrat2, mzrat2, xpref2n, xpref2d, xpref2z,   & 
    282374         &                xpref2c, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 
    283          &                xthresh2, xkgraz2, epsher2, epsher2min, sigma2, unass2, grazflux 
     375         &                xthresh2, xkgraz2, epsher2, epsher2min, sigma2, unass2, grazflux, ln_dvm_meso,  & 
     376         &                xfracmig 
    284377      !!---------------------------------------------------------------------- 
    285378      ! 
    … …  
    316409         WRITE(numout,*) '      non assimilated fraction of P by mesozoo       unass2       =', unass2 
    317410         WRITE(numout,*) '      Efficiency of Mesozoo growth                   epsher2      =', epsher2 
    318          WRITE(numout,*) '      Minimum Efficiency of Mesozoo growth           epsher2min  =', epsher2min 
     411         WRITE(numout,*) '      Minimum Efficiency of Mesozoo growth           epsher2min   =', epsher2min 
    319412         WRITE(numout,*) '      Fraction of mesozoo excretion as DOM           sigma2       =', sigma2 
    320413         WRITE(numout,*) '      half sturation constant for grazing 2          xkgraz2      =', xkgraz2 
     414         WRITE(numout,*) '      Diurnal vertical migration of mesozoo.         ln_dvm_meso  =', ln_dvm_meso 
     415         WRITE(numout,*) '      Fractional biomass of meso  that performs DVM  xfracmig     =', xfracmig 
    321416      ENDIF 
    322417      ! 
    323418   END SUBROUTINE p4z_meso_init 
     419 
     420   SUBROUTINE p4z_meso_depmig  
     421      !!---------------------------------------------------------------------- 
     422      !!                  ***  ROUTINE p4z_meso_depmig  *** 
     423      !! 
     424      !! ** Purpose :   Computation the migration depth of mesozooplankton 
     425      !! 
     426      !! ** Method  :   Computes the DVM depth of mesozooplankton from oxygen 
     427      !!      temperature and chlorophylle following the parameterization  
     428      !!      proposed by Bianchi et al. (2013) 
     429      !! 
     430      !! ** input   :    
     431      !!---------------------------------------------------------------------- 
     432      INTEGER  :: ji, jj, jk 
     433      ! 
     434      REAL(wp) :: totchl 
     435      REAL(wp), DIMENSION(jpi,jpj) :: oxymoy, tempmoy, zdepmoy 
     436 
     437      !!--------------------------------------------------------------------- 
     438      ! 
     439      IF( ln_timing == 1 )  CALL timing_start('p4z_meso_zdepmig') 
     440      ! 
     441      oxymoy(:,:)  = 0. 
     442      tempmoy(:,:) = 0. 
     443      zdepmoy(:,:) = 0. 
     444      depmig (:,:) = 5. 
     445      kmig   (:,:) = 1 
     446      ! 
     447      ! Compute the averaged values of oxygen, temperature over the domain  
     448      ! 150m to 500 m depth. 
     449      ! 
     450      DO jk =1, jpk 
     451         DO jj = 1, jpj 
     452            DO ji = 1, jpi 
     453               IF (tmask(ji,jj,jk) == 1.) THEN 
     454                  IF (gdept_n(ji,jj,jk) >= 150. .AND. gdept_n(ji,jj,jk) <= 500.) THEN 
     455                     oxymoy(ji,jj) = oxymoy(ji,jj) + trb(ji,jj,jk,jpoxy)*e3t_n(ji,jj,jk)*1E6 
     456                     tempmoy(ji,jj) = tempmoy(ji,jj) + tsn(ji,jj,jk,jp_tem)*e3t_n(ji,jj,jk) 
     457                     zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t_n(ji,jj,jk) 
     458                  ENDIF 
     459               ENDIF 
     460            END DO 
     461         END DO 
     462      END DO 
     463 
     464      DO jj = 1, jpj 
     465         DO ji = 1, jpi 
     466            oxymoy(ji,jj) = trb(ji,jj,1,jpoxy)*1E6 - oxymoy(ji,jj) / (zdepmoy(ji,jj) + rtrn) 
     467            tempmoy(ji,jj) = tsn(ji,jj,1,jp_tem)-tempmoy(ji,jj) / (zdepmoy(ji,jj) + rtrn) 
     468         END DO 
     469      END DO 
     470      ! 
     471      ! Computation of the migration depth based on the parameterization of  
     472      ! Bianchi et al. (2013) 
     473      ! ------------------------------------------------------------------- 
     474      ! 
     475      DO jj = 1, jpj 
     476         DO ji = 1, jpi 
     477            IF (tmask(ji,jj,1) == 1.) THEN 
     478               totchl = (trb(ji,jj,1,jpnch)+trb(ji,jj,1,jpdch))*1E6 
     479               depmig(ji,jj) = 398. - 0.56 * oxymoy(ji,jj) -115. * log10(totchl) + 0.36 * hmld(ji,jj) -2.4 * tempmoy(ji,jj) 
     480            ENDIF 
     481         END DO 
     482      END DO 
     483      !  
     484      ! Computation of the corresponding jk indice  
     485      ! ------------------------------------------ 
     486      !  
     487      DO jk = 1, jpk-1 
     488         DO jj = 1, jpj 
     489            DO ji = 1, jpi 
     490               IF (depmig(ji,jj) .GE. gdepw_n(ji,jj,jk) .AND. depmig(ji,jj) .LT. gdepw_n(ji,jj,jk+1) ) THEN 
     491                  kmig(ji,jj) = jk 
     492               ENDIF 
     493            END DO 
     494         END DO 
     495      END DO 
     496      ! 
     497      ! Correction of the migration depth and indice based on O2 levels 
     498      ! If O2 is too low, imposing a migration depth at this low O2 levels 
     499      ! would lead to negative O2 concentrations (respiration while O2 is close 
     500      ! to 0. Thus, to avoid that problem, the migration depth is adjusted so 
     501      ! that it falls above the OMZ 
     502      ! ----------------------------------------------------------------------- 
     503      ! 
     504      DO ji =1, jpi 
     505         DO jj = 1, jpj 
     506            IF (trb(ji,jj,kmig(ji,jj),jpoxy) < 5E-6) THEN 
     507               DO jk = kmig(ji,jj),1,-1 
     508                  IF (trb(ji,jj,jk,jpoxy) >= 5E-6 .AND. trb(ji,jj,jk+1,jpoxy)  < 5E-6) THEN 
     509                     kmig(ji,jj) = jk 
     510                     depmig(ji,jj) = gdept_n(ji,jj,jk) 
     511                  ENDIF 
     512               END DO 
     513            ENDIF 
     514         END DO 
     515      END DO 
     516      ! 
     517      IF( ln_timing )   CALL timing_stop('p4z_meso_depmig') 
     518      ! 
     519   END SUBROUTINE p4z_meso_depmig 
     520 
     521   INTEGER FUNCTION p4z_meso_alloc() 
     522      !!---------------------------------------------------------------------- 
     523      !!                     ***  ROUTINE p4z_meso_alloc  *** 
     524      !!---------------------------------------------------------------------- 
     525      ! 
     526      ALLOCATE( depmig(jpi,jpj), kmig(jpi,jpj), STAT= p4z_meso_alloc  ) 
     527      ! 
     528      IF( p4z_meso_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_meso_alloc : failed to allocate arrays.' ) 
     529      ! 
     530   END FUNCTION p4z_meso_alloc 
     531 
    324532 
    325533   !!====================================================================== 

  • NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p4zrem.F90

    r11536 r12524  
    223223               zbactfer = feratb *  rfact2 * 0.6_wp / rday * tgfunc(ji,jj,jk) * xlimbacl(ji,jj,jk)     & 
    224224                  &              * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) )    & 
    225                   &              * zdepprod(ji,jj,jk) * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
     225                  &              * zdepeff(ji,jj,jk) * zdepbac(ji,jj,jk) 
    226226               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.33 
    227227               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.25 
    228228               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.08 
    229229               zfebact(ji,jj,jk)   = zbactfer * 0.33 
    230                blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 * zdepprod(ji,jj,jk) 
     230               blim(ji,jj,jk)      = xlimbacl(ji,jj,jk)  * zdepbac(ji,jj,jk) / 1.e-6 
    231231            END DO 
    232232         END DO 

  • NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p5zmeso.F90

    r12349 r12524  
    2323   PUBLIC   p5z_meso              ! called in p5zbio.F90 
    2424   PUBLIC   p5z_meso_init         ! called in trcsms_pisces.F90 
     25   PUBLIC   p5z_meso_alloc 
    2526 
    2627   !! * Shared module variables 
    … …  
    4950   REAL(wp), PUBLIC ::  srespir2     !: Active respiration 
    5051   REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate 
     52   REAL(wp), PUBLIC ::  xfracmig     !: Fractional biomass of meso that performs DVM 
    5153   LOGICAL,  PUBLIC ::  bmetexc2     !: Use of excess carbon for respiration 
     54   LOGICAL , PUBLIC ::  ln_dvm_meso  !: Boolean to activate DVM of mesozooplankton 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: depmig 
     56   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: kmig 
     57 
    5258 
    5359   !!---------------------------------------------------------------------- 
    … …  
    6874      !!--------------------------------------------------------------------- 
    6975      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    70       INTEGER  :: ji, jj, jk 
     76      INTEGER  :: ji, jj, jk, jkt 
    7177      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam, zcompames 
    7278      REAL(wp) :: zgraze2, zdenom, zfact, zfood, zfoodlim, zproport 
    … …  
    7480      REAL(wp) :: zepsherf, zepshert, zepsherq, zepsherv, zrespirc, zrespirn, zrespirp, zbasresb, zbasresi 
    7581      REAL(wp) :: zgraztotc, zgraztotn, zgraztotp, zgraztotf, zbasresn, zbasresp, zbasresf 
    76       REAL(wp) :: zgradoc, zgradon, zgradop, zgratmp, zgradoct, zgradont, zgrareft, zgradopt 
    77       REAL(wp) :: zgrapoc, zgrapon, zgrapop, zgrapof, zprcaca, zmortz 
    78       REAL(wp) :: zexcess, zgrarem, zgraren, zgrarep, zgraref 
     82      REAL(wp) :: zgratmp, zgradoct, zgradont, zgrareft, zgradopt 
     83      REAL(wp) :: zprcaca, zmortz, zexcess 
    7984      REAL(wp) :: zbeta, zrespz, ztortz, zgrasratp, zgrasratn, zgrasratf 
    8085      REAL(wp) :: ztmp1, ztmp2, ztmp3, ztmp4, ztmp5, ztmptot 
    … …  
    8489      REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg 
    8590      REAL(wp) :: zgrazffnp, zgrazffng, zgrazffpp, zgrazffpg 
     91      REAL(wp) :: zmigreltime, zrum, zcodel, zargu, zval 
    8692      CHARACTER (len=25) :: charout 
    8793      REAL(wp) :: zrfact2, zmetexcess, zsigma, zdiffdn 
    8894      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2 
    89       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zw3d, zz2ligprod 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarem, zgraref, zgrapoc, zgrapof 
     96      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarep, zgraren, zgrapon, zgrapop 
     97      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgradoc, zgradon, zgradop 
     98      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zgramigrem, zgramigref, zgramigpoc, zgramigpof, zstrn 
     99      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zgramigrep, zgramigren, zgramigpop, zgramigpon 
     100      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zgramigdoc, zgramigdop, zgramigdon 
     101      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d, zz2ligprod 
    90102 
    91103      !!--------------------------------------------------------------------- 
    … …  
    93105      IF( ln_timing )   CALL timing_start('p5z_meso') 
    94106      ! 
    95  
    96107      zgrazing(:,:,:) = 0._wp 
    97108      zfezoo2 (:,:,:) = 0._wp 
    … …  
    101112         zz2ligprod(:,:,:) = 0._wp 
    102113      ENDIF 
     114 
     115      ! 
     116      ! Diurnal vertical migration of mesozooplankton 
     117      ! --------------------------------------------- 
     118      IF (ln_dvm_meso) CALL p5z_meso_depmig 
    103119 
    104120      zmetexcess = 0.0 
    … …  
    268284               zgrareft = (1. - unass2c) * zgraztotf - zepsherv * ferat3 * zgraztotc - zbasresf 
    269285               ztmp1   = ( 1. - epsher2 - unass2c ) /( 1. - 0.8 * epsher2 ) * ztortz 
    270                zgradoc = (zgradoct + ztmp1) * ssigma2 
    271                zgradon = (zgradont + no3rat3 * ztmp1) * ssigma2 
    272                zgradop = (zgradopt + po4rat3 * ztmp1) * ssigma2 
     286               zgradoc(ji,jj,jk) = (zgradoct + ztmp1) * ssigma2 
     287               zgradon(ji,jj,jk) = (zgradont + no3rat3 * ztmp1) * ssigma2 
     288               zgradop(ji,jj,jk) = (zgradopt + po4rat3 * ztmp1) * ssigma2 
    273289               zgratmp = 0.2 * epsher2 /( 1. - 0.8 * epsher2 ) * ztortz 
    274290 
    … …  
    277293               !  as dissolved inorganic compounds (ssigma2) 
    278294               !  -------------------------------------------------- 
    279                zgrarem = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 
    280                zgraren = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 
    281                zgrarep = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 
    282                zgraref = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 
     295               zgrarem(ji,jj,jk) = zgratmp + ( zgradoct + ztmp1 ) * (1.0 - ssigma2) 
     296               zgraren(ji,jj,jk) = no3rat3 * zgratmp + ( zgradont + no3rat3 * ztmp1 ) * (1.0 - ssigma2) 
     297               zgrarep(ji,jj,jk) = po4rat3 * zgratmp + ( zgradopt + po4rat3 * ztmp1 ) * (1.0 - ssigma2) 
     298               zgraref(ji,jj,jk) = zgrareft + ferat3 * ( ztmp1 + zgratmp ) 
    283299 
    284300               !   Defecation as a result of non assimilated products 
    285301               !   -------------------------------------------------- 
    286                zgrapoc  = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
    287                zgrapon  = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 
    288                zgrapop  = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 
    289                zgrapof  = zgraztotf * unass2c + ferat3  * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
     302               zgrapoc(ji,jj,jk)  = zgraztotc * unass2c + unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
     303               zgrapon(ji,jj,jk)  = zgraztotn * unass2n + no3rat3 * unass2n / ( 1. - 0.8 * epsher2 ) * ztortz 
     304               zgrapop(ji,jj,jk)  = zgraztotp * unass2p + po4rat3 * unass2p / ( 1. - 0.8 * epsher2 ) * ztortz 
     305               zgrapof(ji,jj,jk)  = zgraztotf * unass2c + ferat3  * unass2c / ( 1. - 0.8 * epsher2 ) * ztortz 
    290306 
    291307               !  Addition of respiration to the release of inorganic nutrients 
    292308               !  ------------------------------------------------------------- 
    293                zgrarem = zgrarem + zbasresi + zrespirc 
    294                zgraren = zgraren + zbasresn + zrespirc * no3rat3 
    295                zgrarep = zgrarep + zbasresp + zrespirc * po4rat3 
    296                zgraref = zgraref + zbasresf + zrespirc * ferat3 
     309               zgrarem(ji,jj,jk) = zgrarem(ji,jj,jk) + zbasresi + zrespirc 
     310               zgraren(ji,jj,jk) = zgraren(ji,jj,jk) + zbasresn + zrespirc * no3rat3 
     311               zgrarep(ji,jj,jk) = zgrarep(ji,jj,jk) + zbasresp + zrespirc * po4rat3 
     312               zgraref(ji,jj,jk) = zgraref(ji,jj,jk) + zbasresf + zrespirc * ferat3 
    297313 
    298314               !   Update the arrays TRA which contain the biological sources and 
    299315               !   sinks 
    300316               !   -------------------------------------------------------------- 
    301                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep  
    302                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren 
    303                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc 
    304                ! 
    305                IF( ln_ligand ) THEN 
    306                   tra(ji,jj,jk,jplgw)  = tra(ji,jj,jk,jplgw) + zgradoc * ldocz 
    307                   zz2ligprod(ji,jj,jk) = zgradoc * ldocz 
    308                ENDIF 
    309                ! 
    310                tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon 
    311                tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop 
    312                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem 
    313                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref 
    314                zfezoo2(ji,jj,jk)   = zgraref 
    315                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem 
    316                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren 
    317317               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) + zepsherv * zgraztotc - zrespirc   & 
    318318               &                     - ztortz - zgrazm 
    … …  
    332332 
    333333               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfracc 
    334                prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfracc 
    335                conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
     334               prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zfracc 
     335               conspoc(ji,jj,jk)   = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    336336               tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zgrazpon - zgrazffnp + zfracn 
    337337               tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zgrazpop - zgrazffpp + zfracp 
    338                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg + zgrapoc - zfracc 
    339                prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zgrapoc 
    340                consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfracc 
    341                tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng + zgrapon - zfracn 
    342                tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg + zgrapop - zfracp 
     338               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg - zfracc 
     339               consgoc(ji,jj,jk)   = consgoc(ji,jj,jk) - zgrazffeg - zfracc 
     340               tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zgrazffng - zfracn 
     341               tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zgrazffpg - zfracp 
    343342               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    344                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg + zgrapof - zfracfe 
     343               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg - zfracfe 
    345344               zfracal = trb(ji,jj,jk,jpcal) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    346345               zgrazcal = zgrazffeg * (1. - part2) * zfracal 
    347  
    348346               !  calcite production 
    349347               !  ------------------ 
    … …  
    354352               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * ( zgrazcal - zprcaca ) 
    355353               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
     354            END DO 
     355         END DO 
     356      END DO 
     357 
     358      IF (ln_dvm_meso) THEN 
     359         ALLOCATE( zgramigrem(jpi,jpj), zgramigref(jpi,jpj), zgramigpoc(jpi,jpj), zgramigpof(jpi,jpj) ) 
     360         ALLOCATE( zgramigrep(jpi,jpj), zgramigren(jpi,jpj), zgramigpop(jpi,jpj), zgramigpon(jpi,jpj) ) 
     361         ALLOCATE( zgramigdoc(jpi,jpj), zgramigdon(jpi,jpj), zgramigdop(jpi,jpj) ) 
     362 
     363         ALLOCATE( zstrn(jpi,jpj) ) 
     364         zgramigrem(:,:)  = 0.0   ;   zgramigref(:,:) = 0.0 
     365         zgramigrep(:,:)  = 0.0   ;   zgramigren(:,:) = 0.0 
     366         zgramigpoc(:,:)  = 0.0   ;   zgramigpof(:,:) = 0.0 
     367         zgramigpop(:,:)  = 0.0   ;   zgramigpon(:,:) = 0.0 
     368         zgramigdoc(:,:)  = 0.0   ;   zgramigdon(:,:) = 0.0 
     369         zgramigdop(:,:)  = 0.0    
     370 
     371         ! compute the day length depending on latitude and the day 
     372         zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
     373         zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
     374 
     375         ! day length in hours 
     376         zstrn(:,:) = 0. 
     377         DO jj = 1, jpj 
     378            DO ji = 1, jpi 
     379               zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     380               zargu = MAX( -1., MIN(  1., zargu ) ) 
     381               zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     382               zstrn(ji,jj) = MIN(0.75, MAX( 0.25, zstrn(ji,jj) / 24.) ) 
     383            END DO 
     384         END DO 
     385 
     386 
     387         DO jk = 1, jpk 
     388            DO jj = 1, jpj 
     389               DO ji = 1, jpi 
     390 
     391                  !   Compute the amount of materials that will go into vertical migration 
     392                  zmigreltime = (1. - zstrn(ji,jj)) 
     393                  IF ( gdept_n(ji,jj,jk) <= heup(ji,jj) ) THEN 
     394                     zgramigrem(ji,jj) = zgramigrem(ji,jj) + xfracmig * zgrarem(ji,jj,jk) * (1. - zmigreltime )    & 
     395                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     396                     zgramigrep(ji,jj) = zgramigrep(ji,jj) + xfracmig * zgrarep(ji,jj,jk) * (1. - zmigreltime )    & 
     397                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     398                     zgramigrep(ji,jj) = zgramigren(ji,jj) + xfracmig * zgrarep(ji,jj,jk) * (1. - zmigreltime )    & 
     399                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     400                     zgramigref(ji,jj) = zgramigref(ji,jj) + xfracmig * zgraref(ji,jj,jk) * (1. - zmigreltime )   & 
     401                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     402                     zgramigpoc(ji,jj) = zgramigpoc(ji,jj) + xfracmig * zgrapoc(ji,jj,jk) * (1. - zmigreltime )   & 
     403                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     404                     zgramigpop(ji,jj) = zgramigpop(ji,jj) + xfracmig * zgrapop(ji,jj,jk) * (1. - zmigreltime )   & 
     405                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     406                     zgramigpon(ji,jj) = zgramigpon(ji,jj) + xfracmig * zgrapon(ji,jj,jk) * (1. - zmigreltime )   & 
     407                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     408                     zgramigpof(ji,jj) = zgramigpof(ji,jj) + xfracmig * zgrapof(ji,jj,jk) * (1. - zmigreltime )   & 
     409                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     410                     zgramigdoc(ji,jj) = zgramigdoc(ji,jj) + xfracmig * zgradoc(ji,jj,jk) * (1. - zmigreltime )   & 
     411                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     412                     zgramigdop(ji,jj) = zgramigdop(ji,jj) + xfracmig * zgradop(ji,jj,jk) * (1. - zmigreltime )   & 
     413                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     414                     zgramigdon(ji,jj) = zgramigdon(ji,jj) + xfracmig * zgradon(ji,jj,jk) * (1. - zmigreltime )   & 
     415                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     416 
     417                     zgrarem(ji,jj,jk) = zgrarem(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     418                     zgrarep(ji,jj,jk) = zgrarep(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     419                     zgraren(ji,jj,jk) = zgraren(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     420                     zgraref(ji,jj,jk) = zgraref(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     421                     zgrapoc(ji,jj,jk) = zgrapoc(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     422                     zgrapop(ji,jj,jk) = zgrapop(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     423                     zgrapon(ji,jj,jk) = zgrapon(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     424                     zgrapof(ji,jj,jk) = zgrapof(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     425                     zgradoc(ji,jj,jk) = zgradoc(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     426                     zgradop(ji,jj,jk) = zgradop(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     427                     zgradon(ji,jj,jk) = zgradon(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime ) 
     428                  ENDIF 
     429               END DO 
     430            END DO 
     431         END DO 
     432 
     433         DO jj = 1, jpj 
     434            DO ji = 1, jpi 
     435               IF (tmask(ji,jj,1) == 1.) THEN 
     436                  jkt = kmig(ji,jj) 
     437                  zgrarem(ji,jj,jkt) = zgrarem(ji,jj,jkt) + zgramigrem(ji,jj) / e3t_n(ji,jj,jkt) 
     438                  zgrarep(ji,jj,jkt) = zgrarep(ji,jj,jkt) + zgramigrep(ji,jj) / e3t_n(ji,jj,jkt) 
     439                  zgraren(ji,jj,jkt) = zgraren(ji,jj,jkt) + zgramigren(ji,jj) / e3t_n(ji,jj,jkt) 
     440                  zgraref(ji,jj,jkt) = zgraref(ji,jj,jkt) + zgramigref(ji,jj) / e3t_n(ji,jj,jkt) 
     441                  zgrapoc(ji,jj,jkt) = zgrapoc(ji,jj,jkt) + zgramigpoc(ji,jj) / e3t_n(ji,jj,jkt) 
     442                  zgrapop(ji,jj,jkt) = zgrapop(ji,jj,jkt) + zgramigpop(ji,jj) / e3t_n(ji,jj,jkt) 
     443                  zgrapon(ji,jj,jkt) = zgrapon(ji,jj,jkt) + zgramigpon(ji,jj) / e3t_n(ji,jj,jkt) 
     444                  zgrapof(ji,jj,jkt) = zgrapof(ji,jj,jkt) + zgramigpof(ji,jj) / e3t_n(ji,jj,jkt) 
     445                  zgradoc(ji,jj,jkt) = zgradoc(ji,jj,jkt) + zgramigdoc(ji,jj) / e3t_n(ji,jj,jkt) 
     446                  zgradop(ji,jj,jkt) = zgradop(ji,jj,jkt) + zgramigdop(ji,jj) / e3t_n(ji,jj,jkt) 
     447                  zgradon(ji,jj,jkt) = zgradon(ji,jj,jkt) + zgramigdon(ji,jj) / e3t_n(ji,jj,jkt) 
     448               ENDIF 
     449            END DO 
     450         END DO 
     451         ! 
     452         ! Deallocate temporary variables 
     453         ! ------------------------------ 
     454         DEALLOCATE( zgramigrem, zgramigref, zgramigpoc, zgramigpof ) 
     455         DEALLOCATE( zgramigrep, zgramigren, zgramigpop, zgramigpon ) 
     456         DEALLOCATE( zgramigdoc, zgramigdon, zgramigdop ) 
     457         DEALLOCATE( zstrn ) 
     458 
     459      ENDIF 
     460 
     461      DO jk = 1, jpk 
     462         DO jj = 1, jpj 
     463            DO ji = 1, jpi 
     464               !   Update the arrays TRA which contain the biological sources and sinks 
     465               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarep(ji,jj,jk)  
     466               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgraren(ji,jj,jk) 
     467               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgradoc(ji,jj,jk) 
     468               ! 
     469               IF( ln_ligand ) THEN 
     470                  tra(ji,jj,jk,jplgw)  = tra(ji,jj,jk,jplgw) + zgradoc(ji,jj,jk) * ldocz 
     471                  zz2ligprod(ji,jj,jk) = zgradoc(ji,jj,jk) * ldocz 
     472               ENDIF 
     473               ! 
     474               tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zgradon(ji,jj,jk) 
     475               tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zgradop(ji,jj,jk) 
     476               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem(ji,jj,jk) 
     477               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref(ji,jj,jk) 
     478               zfezoo2(ji,jj,jk)   = zgraref(ji,jj,jk) 
     479               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem(ji,jj,jk) 
     480               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgraren(ji,jj,jk) 
     481               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc(ji,jj,jk) 
     482               prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk) + zgrapoc(ji,jj,jk) 
     483               tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zgrapon(ji,jj,jk) 
     484               tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zgrapop(ji,jj,jk) 
     485               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgrapof(ji,jj,jk) 
    356486            END DO 
    357487         END DO 
    … …  
    407537         &                xpref2m, xpref2d, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 
    408538         &                xthresh2mes, xthresh2, xkgraz2, epsher2, epsher2min, ssigma2, unass2c, & 
    409          &                unass2n, unass2p, srespir2, grazflux 
     539         &                unass2n, unass2p, srespir2, grazflux, ln_dvm_meso, xfracmig 
    410540      !!---------------------------------------------------------------------- 
    411541      ! 
    … …  
    448578         WRITE(numout,*) '    half sturation constant for grazing 2          xkgraz2     = ', xkgraz2 
    449579         WRITE(numout,*) '    Use excess carbon for respiration              bmetexc2    = ', bmetexc2 
     580         WRITE(numout,*) '      Diurnal vertical migration of mesozoo.         ln_dvm_meso  =', ln_dvm_meso 
     581         WRITE(numout,*) '      Fractional biomass of meso  that performs DVM  xfracmig     =', xfracmig 
    450582      ENDIF 
    451583      ! 
    452584   END SUBROUTINE p5z_meso_init 
     585 
     586   SUBROUTINE p5z_meso_depmig 
     587      !!---------------------------------------------------------------------- 
     588      !!                  ***  ROUTINE p5z_meso_depmig  *** 
     589      !! 
     590      !! ** Purpose :   Computation the migration depth of mesozooplankton 
     591      !! 
     592      !! ** Method  :   Computes the DVM depth of mesozooplankton from oxygen 
     593      !!      temperature and chlorophylle following the parameterization  
     594      !!      proposed by Bianchi et al. (2013) 
     595      !! 
     596      !! ** input   :    
     597      !!---------------------------------------------------------------------- 
     598      INTEGER  :: ji, jj, jk 
     599      ! 
     600      REAL(wp) :: totchl 
     601      REAL(wp), DIMENSION(jpi,jpj) :: oxymoy, tempmoy, zdepmoy 
     602 
     603      !!--------------------------------------------------------------------- 
     604      ! 
     605      IF( ln_timing == 1 )  CALL timing_start('p5z_meso_zdepmig') 
     606      ! 
     607      oxymoy(:,:)  = 0. 
     608      tempmoy(:,:) = 0. 
     609      zdepmoy(:,:) = 0. 
     610      depmig (:,:) = 5. 
     611      kmig   (:,:) = 1 
     612      ! 
     613      ! Compute the averaged values of oxygen, temperature over the domain  
     614      ! 150m to 500 m depth. 
     615      ! 
     616      DO jk =1, jpk 
     617         DO jj = 1, jpj 
     618            DO ji = 1, jpi 
     619               IF (tmask(ji,jj,jk) == 1.) THEN 
     620                  IF (gdept_n(ji,jj,jk) >= 150. .AND. gdept_n(ji,jj,jk) <= 500.) THEN 
     621                     oxymoy(ji,jj)  = oxymoy(ji,jj)  + trb(ji,jj,jk,jpoxy)*e3t_n(ji,jj,jk)*1E6 
     622                     tempmoy(ji,jj) = tempmoy(ji,jj) + tsn(ji,jj,jk,jp_tem)*e3t_n(ji,jj,jk) 
     623                     zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t_n(ji,jj,jk) 
     624                  ENDIF 
     625               ENDIF 
     626            END DO 
     627         END DO 
     628      END DO 
     629 
     630      DO jj = 1, jpj 
     631         DO ji = 1, jpi 
     632            oxymoy(ji,jj) = trb(ji,jj,1,jpoxy)*1E6 - oxymoy(ji,jj) / (zdepmoy(ji,jj) + rtrn) 
     633            tempmoy(ji,jj) = tsn(ji,jj,1,jp_tem)-tempmoy(ji,jj) / (zdepmoy(ji,jj) + rtrn) 
     634         END DO 
     635      END DO 
     636      ! 
     637      ! Computation of the migration depth based on the parameterization of  
     638      ! 
     639      DO jj = 1, jpj 
     640         DO ji = 1, jpi 
     641            IF (tmask(ji,jj,1) == 1.) THEN 
     642               totchl = (trb(ji,jj,1,jppch)+trb(ji,jj,1,jpnch)+trb(ji,jj,1,jpdch))*1E6 
     643               depmig(ji,jj) = 398. - 0.56 * oxymoy(ji,jj) -115. * log10(totchl) + 0.36 * hmld(ji,jj) -2.4 * tempmoy(ji,jj) 
     644            ENDIF 
     645         END DO 
     646      END DO 
     647      !  
     648      ! Computation of the corresponding jk indice  
     649      ! ------------------------------------------ 
     650      !  
     651      DO jk = 1, jpk-1 
     652         DO jj = 1, jpj 
     653            DO ji = 1, jpi 
     654               IF (depmig(ji,jj) .GE. gdepw_n(ji,jj,jk) .AND. depmig(ji,jj) .LT. gdepw_n(ji,jj,jk+1) ) THEN 
     655                  kmig(ji,jj) = jk 
     656               ENDIF 
     657            END DO 
     658         END DO 
     659      END DO 
     660      ! 
     661      ! Correction of the migration depth and indice based on O2 levels 
     662      ! If O2 is too low, imposing a migration depth at this low O2 levels 
     663      ! would lead to negative O2 concentrations (respiration while O2 is close 
     664      ! to 0. Thus, to avoid that problem, the migration depth is adjusted so 
     665      ! that it falls above the OMZ 
     666      ! ----------------------------------------------------------------------- 
     667      ! 
     668      DO ji =1, jpi 
     669         DO jj = 1, jpj 
     670            IF (trb(ji,jj,kmig(ji,jj),jpoxy) < 5E-6) THEN 
     671               DO jk = kmig(ji,jj),1,-1 
     672                  IF (trb(ji,jj,jk,jpoxy) >= 5E-6 .AND. trb(ji,jj,jk+1,jpoxy)  < 5E-6) THEN 
     673                     kmig(ji,jj) = jk 
     674                     depmig(ji,jj) = gdept_n(ji,jj,jk) 
     675                  ENDIF 
     676               END DO 
     677            ENDIF 
     678         END DO 
     679      END DO 
     680      ! 
     681      IF( ln_timing )   CALL timing_stop('p5z_meso_depmig') 
     682      ! 
     683   END SUBROUTINE p5z_meso_depmig 
     684 
     685   INTEGER FUNCTION p5z_meso_alloc() 
     686      !!---------------------------------------------------------------------- 
     687      !!                     ***  ROUTINE p4z_meso_alloc  *** 
     688      !!---------------------------------------------------------------------- 
     689      ! 
     690      ALLOCATE( depmig(jpi,jpj), kmig(jpi,jpj), STAT= p5z_meso_alloc  ) 
     691      ! 
     692      IF( p5z_meso_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_meso_alloc : failed to allocate arrays.' ) 
     693      ! 
     694   END FUNCTION p5z_meso_alloc 
    453695 
    454696   !!====================================================================== 

  • NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/trcini_pisces.F90

    r10817 r12524  
    112112      IF( ln_p4z ) THEN 
    113113         ierr = ierr +  p4z_prod_alloc() 
     114         ierr = ierr +  p4z_meso_alloc() 
    114115      ELSE 
    115116         ierr = ierr +  p5z_lim_alloc() 
    116117         ierr = ierr +  p5z_prod_alloc() 
     118         ierr = ierr +  p5z_meso_alloc() 
    117119      ENDIF 
    118120      ierr = ierr +  p4z_rem_alloc() 
Note: See TracChangeset for help on using the changeset viewer.