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 12537 for NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p4zmeso.F90 – NEMO

Ignore:
Timestamp:
2020-03-11T16:02:54+01:00 (4 years ago)
Author:
aumont
Message:

Comments in routines have been revised and significantly augmented

File:
1 edited

Legend:

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

    r12524 r12537  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10    !!   p4z_meso       : Compute the sources/sinks for mesozooplankton 
    11    !!   p4z_meso_init  : Initialization of the parameters for mesozooplankton 
     10   !!   p4z_meso        : Compute the sources/sinks for mesozooplankton 
     11   !!   p4z_meso_init   : Initialization of the parameters for mesozooplankton 
     12   !!   p4z_meso_alloc  : Allocate variables for mesozooplankton  
    1213   !!---------------------------------------------------------------------- 
    1314   USE oce_trc         ! shared variables between ocean and passive tracers 
     
    2324   PUBLIC   p4z_meso              ! called in p4zbio.F90 
    2425   PUBLIC   p4z_meso_init         ! called in trcsms_pisces.F90 
    25    PUBLIC   p4z_meso_alloc 
    26  
     26   PUBLIC   p4z_meso_alloc        ! called in trcini_pisces.F90 
     27 
     28   !! * Shared module variables 
    2729   REAL(wp), PUBLIC ::  part2        !: part of calcite not dissolved in mesozoo guts 
    2830   REAL(wp), PUBLIC ::  xpref2d      !: mesozoo preference for diatoms 
     
    4648   REAL(wp), PUBLIC ::  xfracmig     !: Fractional biomass of meso that performs DVM 
    4749   LOGICAL , PUBLIC ::  ln_dvm_meso  !: Boolean to activate DVM of mesozooplankton 
    48    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: depmig 
    49    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: kmig  
     50   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: depmig  !: DVM of mesozooplankton : migration depth 
     51   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: kmig    !: Vertical indice of the the migration depth 
    5052 
    5153   !!---------------------------------------------------------------------- 
     
    6163      !! 
    6264      !! ** Purpose :   Compute the sources/sinks for mesozooplankton 
     65      !!                This includes ingestion and assimilation, flux feeding 
     66      !!                and mortality. We use a passive prey switching   
     67      !!                parameterization. 
     68      !!                All living compartments smaller than mesozooplankton 
     69      !!                are potential preys of mesozooplankton as well as small 
     70      !!                sinking particles  
    6371      !! 
    6472      !! ** Method  : - ??? 
     
    6876      INTEGER  :: ji, jj, jk, jkt 
    6977      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
    70       REAL(wp) :: zgraze2 , zdenom, zdenom2 
    71       REAL(wp) :: zfact   , zfood, zfoodlim, zproport, zbeta 
     78      REAL(wp) :: zgraze2 , zdenom, zdenom2, zfact   , zfood, zfoodlim, zproport, zbeta 
    7279      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 
    7380      REAL(wp) :: zepsherf, zepshert, zepsherq, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf 
    7481      REAL(wp) :: zmigreltime, zprcaca, zmortz, zgrasrat, zgrasratn 
    75       REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof 
    76       REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 
    77       REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg 
    78       REAL(wp) :: zrum, zcodel, zargu, zval 
     82      REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof, zgrazn, zgrazpoc, zgraznf, zgrazf 
     83      REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg, zrum, zcodel, zargu, zval 
    7984      CHARACTER (len=25) :: charout 
    8085      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2 
     
    95100      ! 
    96101      ! Diurnal vertical migration of mesozooplankton 
     102      ! Computation of the migration depth 
    97103      ! --------------------------------------------- 
    98104      IF (ln_dvm_meso) CALL p4z_meso_depmig 
     
    104110               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    105111 
    106                !  Respiration rates of both zooplankton 
    107                !  ------------------------------------- 
     112               !  linear mortality of mesozooplankton 
     113               !  A michaelis menten modulation term is used to avoid extinction of  
     114               !  mesozooplankton at very low food concentration. Mortality is 
     115  
     116               !  enhanced in low O2 waters 
     117               !  ----------------------------------------------------------------- 
    108118               zrespz    = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  & 
    109119               &           + 3. * nitrfac(ji,jj,jk) ) 
    110120 
    111                !  Zooplankton mortality. A square function has been selected with 
    112                !  no real reason except that it seems to be more stable and may mimic predation 
    113                !  --------------------------------------------------------------- 
     121               !  Zooplankton quadratic mortality. A square function has been selected with 
     122               !  to mimic predation and disease (density dependent mortality). It also tends 
     123               !  to stabilise the model 
     124               !  ------------------------------------------------------------------------- 
    114125               ztortz    = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)  * (1. - nitrfac(ji,jj,jk) ) 
    115                ! 
     126 
     127               !   Computation of the abundance of the preys 
     128               !   A threshold can be specified in the namelist 
     129               !   -------------------------------------------- 
    116130               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
    117131               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
    118132               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
    119133               ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
    120                ! it is to predation by mesozooplankton 
     134               ! it is to predation by mesozooplankton. We use a quota dependant parameterization 
     135               ! as a low quota indicates oligotrophic conditions which are charatcerized by 
     136               ! small cells 
    121137               ! ------------------------------------------------------------------------------- 
    122138               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) & 
     
    124140 
    125141               ! Mesozooplankton grazing 
    126                ! ------------------------ 
     142               ! The total amount of food is the sum of all preys accessible to mesozooplankton  
     143               ! multiplied by their food preference 
     144               ! A threshold can be specified in the namelist (xthresh2). However, when food  
     145               ! concentration is close to this threshold, it is decreased to avoid the  
     146               ! accumulation of food in the mesozoopelagic domain 
     147               ! ------------------------------------------------------------------------------- 
    127148               zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc  
    128149               zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) ) 
     
    131152               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk))  
    132153 
     154               ! The grazing pressure on each prey is computed assuming passive switching. This  
     155               ! is equivalent to assuming that mesozooplankton have an opportunistic feeding 
     156               ! behaviour. 
     157               ! ----------------------------------------------------------------------------- 
    133158               zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2  
    134159               zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2  
     
    140165               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    141166 
    142                !  Mesozooplankton flux feeding on GOC 
    143                !  ---------------------------------- 
     167               !  Mesozooplankton flux feeding on GOC and POC. The feeding pressure 
     168               ! is proportional to the flux 
     169               !  ------------------------------------------------------------------ 
    144170               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    145171               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) & 
     
    150176               &           * (1. - nitrfac(ji,jj,jk)) 
    151177               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    152                ! 
     178                
    153179               zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    154                ! Compute the proportion of filter feeders 
     180               ! Compute the proportion of filter feeders. It is assumed steady state. 
     181               ! ---------------------------------------------------------------------   
    155182               zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc) 
     183 
    156184               ! Compute fractionation of aggregates. It is assumed that  
    157185               ! diatoms based aggregates are more prone to fractionation 
    158186               ! since they are more porous (marine snow instead of fecal pellets) 
     187               ! ----------------------------------------------------------------- 
    159188               zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    160189               zratio2   = zratio * zratio 
     
    164193               zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    165194 
     195               ! Flux feeding is multiplied by the fractional biomass of flux feeders 
    166196               zgrazffep = zproport * zgrazffep 
    167197               zgrazffeg = zproport * zgrazffeg 
     
    176206               zgrazing(ji,jj,jk) = zgraztotc 
    177207 
    178                !    Mesozooplankton efficiency 
    179                !    -------------------------- 
     208               ! Mesozooplankton efficiency.  
     209               ! We adopt a formulation proposed by Mitra et al. (2007) 
     210               ! The gross growth efficiency is controled by the most limiting nutrient. 
     211               ! Growth is also further decreased when the food quality is poor. This is currently 
     212               ! hard coded : it can be decreased by up to 50% (zepsherq) 
     213               ! GGE can also be decreased when food quantity is high, zepsherf (Montagnes and  
     214               ! Fulton, 2012) 
     215               ! ----------------------------------------------------------------------------------- 
    180216               zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn ) 
    181217               zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn ) 
     
    189225               ! --------------------------------------------- 
    190226               zmortz = ztortz + zrespz 
     227               ! Mortality induced by the upper trophic levels, ztortz, is allocated  
     228               ! according to a infinite chain of predators (ANderson et al., 2013) 
    191229               zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz 
    192230               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc 
     
    208246               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg - zfracfe 
    209247               ! Calcite remineralization due to zooplankton activity 
     248               ! part2 of the ingested calcite is dissolving in the acidic gut 
    210249               zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 
    211250               zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
     
    218257               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 
    219258               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 
     259  
     260               ! Computation of total excretion and egestion by mesozoo.  
    223261               ! --------------------------------------------------------- 
    224262               zgrarem(ji,jj,jk) = zgraztotc * ( 1. - zepsherv - unass2 ) & 
     
    232270      END DO 
    233271 
     272      ! Computation of the effect of DVM by mesozooplankton 
     273      ! This part is only activated if ln_dvm_meso is set to true 
     274      ! The parameterization has been published in Gorgues et al. (2019). 
     275      ! ----------------------------------------------------------------- 
    234276      IF (ln_dvm_meso) THEN 
    235277         ALLOCATE( zgramigrem(jpi,jpj), zgramigref(jpi,jpj), zgramigpoc(jpi,jpj), zgramigpof(jpi,jpj) ) 
     
    253295         END DO 
    254296 
    255  
     297        ! Compute the amount of materials that will go into vertical migration 
     298        ! This fraction is sumed over the euphotic zone and is removed from  
     299        ! the fluxes driven by mesozooplankton in the euphotic zone. 
     300        ! -------------------------------------------------------------------- 
    256301         DO jk = 1, jpk 
    257302            DO jj = 1, jpj 
    258303               DO ji = 1, jpi 
    259  
    260                   !   Compute the amount of materials that will go into vertical migration 
    261304                  zmigreltime = (1. - zstrn(ji,jj)) 
    262305                  IF ( gdept_n(ji,jj,jk) <= heup(ji,jj) ) THEN 
     
    279322         END DO 
    280323       
     324         ! The inorganic and organic fluxes induced by migrating organisms are added at the  
     325         ! the migration depth (corresponding indice is set by kmig) 
     326         ! -------------------------------------------------------------------------------- 
    281327         DO jj = 1, jpj 
    282328            DO ji = 1, jpi 
     
    296342         DEALLOCATE( zstrn ) 
    297343 
     344      ! End of the ln_dvm_meso part 
    298345      ENDIF 
    299346 
     
    302349            DO ji = 1, jpi 
    303350               !   Update the arrays TRA which contain the biological sources and sinks 
     351               !   This only concerns the variables which are affected by DVM (inorganic  
     352               !   nutrients, DOC agands, and particulate organic carbon).  
    304353               zgrarsig  = zgrarem(ji,jj,jk) * sigma2 
    305354               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     
    324373      END DO 
    325374      ! 
     375      ! Write the output 
    326376      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    327377         ALLOCATE( zw3d(jpi,jpj,jpk) ) 
     
    364414      !! ** Purpose :   Initialization of mesozooplankton parameters 
    365415      !! 
    366       !! ** Method  :   Read the nampismes namelist and check the parameters 
     416      !! ** Method  :   Read the namp4zmes namelist and check the parameters 
    367417      !!      called at the first timestep (nittrc000) 
    368418      !! 
     
    383433      ENDIF 
    384434      ! 
    385       REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton 
     435      REWIND( numnatp_ref )              ! Namelist namp4zmes in reference namelist : Pisces mesozooplankton 
    386436      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 
    387437901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmes in reference namelist' ) 
    388       REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton 
     438      REWIND( numnatp_cfg )              ! Namelist namp4zmes in configuration namelist : Pisces mesozooplankton 
    389439      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 
    390440902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmes in configuration namelist' ) 
     
    427477      !!      temperature and chlorophylle following the parameterization  
    428478      !!      proposed by Bianchi et al. (2013) 
    429       !! 
    430       !! ** input   :    
    431479      !!---------------------------------------------------------------------- 
    432480      INTEGER  :: ji, jj, jk 
     
    447495      ! Compute the averaged values of oxygen, temperature over the domain  
    448496      ! 150m to 500 m depth. 
    449       ! 
     497      ! ------------------------------------------------------------------ 
    450498      DO jk =1, jpk 
    451499         DO jj = 1, jpj 
     
    462510      END DO 
    463511 
     512      ! Compute the difference between surface values and the mean values in the mesopelagic 
     513      ! domain 
     514      ! ------------------------------------------------------------------------------------ 
    464515      DO jj = 1, jpj 
    465516         DO ji = 1, jpi 
     
    472523      ! Bianchi et al. (2013) 
    473524      ! ------------------------------------------------------------------- 
    474       ! 
    475525      DO jj = 1, jpj 
    476526         DO ji = 1, jpi 
     
    484534      ! Computation of the corresponding jk indice  
    485535      ! ------------------------------------------ 
    486       !  
    487536      DO jk = 1, jpk-1 
    488537         DO jj = 1, jpj 
     
    501550      ! that it falls above the OMZ 
    502551      ! ----------------------------------------------------------------------- 
    503       ! 
    504552      DO ji =1, jpi 
    505553         DO jj = 1, jpj 
     
    530578   END FUNCTION p4z_meso_alloc 
    531579 
    532  
    533580   !!====================================================================== 
    534581END MODULE p4zmeso 
Note: See TracChangeset for help on using the changeset viewer.