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

Ignore:
Timestamp:
2021-01-07T23:09:56+01:00 (3 years ago)
Author:
aumont
Message:

numerous updates to PISCES, PISCES-QUOTA and the sediment module

File:
1 edited

Legend:

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

    r13233 r14276  
    7272      INTEGER  ::   ji, jj, jk 
    7373      REAL(wp) ::   zsilfac, znanotot, zpicotot, zdiattot, zconctemp, zconctemp2 
    74       REAL(wp) ::   zration, zratiop, zratiof, zmax, zsilim, ztn, zadap 
    75       REAL(wp) ::   zpronmax, zpropmax, zprofmax, zrat 
     74      REAL(wp) ::   zration, zratiop, zratiof, zmax, ztn, zadap 
     75      REAL(wp) ::   zpronmax, zpropmax, zprofmax, zratio 
    7676      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zprontot, zproptot, zprodtot 
    7777      REAL(wp) ::   zprnutmax, zdocprod, zprochln, zprochld, zprochlp 
    7878      REAL(wp) ::   zpislopen, zpislopep, zpisloped 
    7979      REAL(wp) ::   zrum, zcodel, zargu, zval, zfeup 
    80       REAL(wp) ::   zfact, zrfact2, zmaxsi, zratiosi, zsizetmp, zlimfac 
     80      REAL(wp) ::   zqfpmax, zqfnmax, zqfdmax 
     81      REAL(wp) ::   zfact, zrfact2, zmaxsi, zratiosi, zsizetmp, zlimfac, zsilim 
    8182      CHARACTER (len=25) :: charout 
    82       REAL(wp), DIMENSION(jpi,jpj    ) :: zmixnano, zmixpico, zmixdiat, zstrn 
     83      REAL(wp), DIMENSION(jpi,jpj    ) :: zmixnano, zmixpico, zmixdiat 
    8384      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpislopeadn, zpislopeadp, zpislopeadd 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprnut, zprnutp, zprmaxp, zprmaxn, zprmaxd 
     85      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprnut, zprmaxp, zprmaxn, zprmaxd 
    8586      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprbio, zprpic, zprdia, zysopt 
    8687      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprchln, zprchlp, zprchld 
     
    111112      zysopt  (:,:,:) = 0._wp 
    112113      zrespn  (:,:,:) = 0._wp ; zrespp  (:,:,:) = 0._wp ; zrespd  (:,:,:) = 0._wp  
     114      zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp 
     115      consfe3 (:,:,:) = 0._wp 
    113116 
    114117      ! Computation of the optimal production rates and nutrient uptake 
    115118      ! rates. Based on a Q10 description of the thermal dependency. 
    116       zprnut (:,:,:) = 0.6_wp * (1.0 + zpsino3 * qnnmax ) * r1_rday * tgfunc(:,:,:) 
    117       zprnutp(:,:,:) =  0.6_wp * (1. + zpsino3 * qnpmax ) * r1_rday * tgfunc3(:,:,:) 
    118       zprmaxn(:,:,:) = ( 0.6_wp * (1. + zpsino3 * qnnmax ) ) * r1_rday * tgfunc(:,:,:) 
    119       zprmaxd(:,:,:) = ( 0.6_wp * (1. + zpsino3 * qndmax ) ) * r1_rday * tgfunc(:,:,:) 
    120       zprmaxp(:,:,:) = ( 0.4_wp * (1. + zpsino3 * qnpmax ) ) * r1_rday * tgfunc3(:,:,:) 
    121  
    122       ! compute the day length depending on latitude and the day 
    123       ! Astronomical parameterization taken from HAMOCC3 
    124       zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
    125       zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
    126  
    127       ! day length in hours 
    128       zstrn(:,:) = 0. 
    129       DO jj = 1, jpj 
    130          DO ji = 1, jpi 
    131             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    132             zargu = MAX( -1., MIN(  1., zargu ) ) 
    133             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    134          END DO 
    135       END DO 
     119      zprnut (:,:,:) =  0.8_wp * r1_rday * tgfunc(:,:,:) 
     120      zprmaxn(:,:,:) =  0.8_wp * (1. + zpsino3 * qnnmax ) * r1_rday * tgfunc(:,:,:) 
     121      zprmaxd(:,:,:) =  0.8_wp * (1. + zpsino3 * qndmax ) * r1_rday * tgfunc(:,:,:) 
     122      zprmaxp(:,:,:) =  0.6_wp * (1. + zpsino3 * qnpmax ) * r1_rday * tgfunc(:,:,:) 
    136123 
    137124      ! Impact of the day duration and light intermittency on phytoplankton growth 
     
    146133            DO ji = 1, jpi 
    147134               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    148                   zval = MAX( 1., zstrn(ji,jj) ) 
     135                  zval = MAX( 1., strn(ji,jj) ) 
    149136                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    150137                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
     
    161148      zprpic(:,:,:) = zprmaxp(:,:,:) * zmxl_fac(:,:,:) 
    162149 
    163  
    164150      ! Maximum light intensity 
    165       zdaylen(:,:) = MAX(1., zstrn(:,:)) / 24. 
     151      zdaylen(:,:) = MAX(1., strn(:,:)) / 24. 
    166152 
    167153      ! Computation of the P-I slope for nanos, picos and diatoms 
     
    192178                  ! Actual light levels are used here  
    193179                  !  --------------------------------------------- 
    194                   zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) / zmxl_chl(ji,jj,jk) )  ) 
    195                   zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) / zmxl_chl(ji,jj,jk))  ) 
    196                   zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) / zmxl_chl(ji,jj,jk))  ) 
     180                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) / zmxl_fac(ji,jj,jk) )  ) 
     181                  zprpic(ji,jj,jk) = zprpic(ji,jj,jk) * ( 1.- EXP( -zpislopep * epico(ji,jj,jk) / zmxl_fac(ji,jj,jk) )  ) 
     182                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) / zmxl_fac(ji,jj,jk) )  ) 
    197183 
    198184                  !  Computation of production function for Chlorophyll 
     
    227213                  ! ----------------------------------------------------------------------- 
    228214                  zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 
    229                   zsilim = MIN( zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     215                  zsilim = xlimdia(ji,jj,jk) * zprdia(ji,jj,jk) / ( zprmaxd(ji,jj,jk) + rtrn ) 
    230216                  zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 
    231217                  IF (gphit(ji,jj) < -30 ) THEN 
     
    240226                     zysopt(ji,jj,jk) = zlim * zsilfac2 * grosip * 1.0 * zmaxsi 
    241227                  ELSE 
    242                      zysopt(ji,jj,jk) = zlim * zsilfac2 * grosip * 1.0 * zsilim**0.75 * zmaxsi 
     228                     zysopt(ji,jj,jk) = zlim * zsilfac2 * grosip * 1.0 * zsilim**0.7 * zmaxsi 
    243229                  ENDIF 
    244230               ENDIF 
     
    257243               zprdia(ji,jj,jk)  = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) )  
    258244               zprnut(ji,jj,jk)  = zprnut(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    259                zprnutp(ji,jj,jk) = zprnutp(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    260245            END DO 
    261246         END DO 
     
    284269                  zlimfac = xlimphys(ji,jj,jk) * zprchln(ji,jj,jk) / ( zprmaxn(ji,jj,jk) + rtrn ) 
    285270                  zsizetmp = 1.0 + 1.3 * ( xsizern - 1.0 ) * zlimfac**3/(0.3 + zlimfac**3) 
    286                   sizena(ji,jj,jk) = min(xsizern, max( sizena(ji,jj,jk), zsizetmp ) ) 
     271                  sizena(ji,jj,jk) = MIN(xsizern, MAX( sizena(ji,jj,jk), zsizetmp ) ) 
    287272                  ! Maximum potential uptake rate 
    288273                  zration = trb(ji,jj,jk,jpnph) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
     
    291276                  zprnutmax = zprnut(ji,jj,jk) * fvnuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpphy) * rfact2 
    292277                  ! Uptake of nitrogen 
    293                   zrat = 1.0 - MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 
    294                   zmax = MAX(0., MIN(1., zrat**2 / (0.05**2 + zrat**2) ) ) 
     278                  zratio = 1.0 - MIN( 1., zration / (xqnnmax(ji,jj,jk) + rtrn) ) 
     279                  zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) ) 
    295280                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpnmin(ji,jj,jk) )   & 
    296281                  &          / ( xqpnmax(ji,jj,jk) - xqpnmin(ji,jj,jk) + rtrn ), xlimnfe(ji,jj,jk) ) ) 
     282                  zpronmax = zpronmax * xqnnmin(ji,jj,jk) / qnnmin 
    297283                  zpronewn(ji,jj,jk) = zpronmax * xnanono3(ji,jj,jk) 
    298284                  zproregn(ji,jj,jk) = zpronmax * xnanonh4(ji,jj,jk) 
    299285                  ! Uptake of phosphorus and DOP 
    300                   zrat = 1.0 - MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 
    301                   zmax = MAX(0., MIN(1., zrat**2 / (0.05**2 + zrat**2) ) ) 
    302                   zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) * 16. / 10. 
     286                  zratio = 1.0 - MIN( 1., zratiop / (xqpnmax(ji,jj,jk) + rtrn) ) 
     287                  zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) ) 
     288                  zpropmax = zprnutmax * zmax * xlimnfe(ji,jj,jk) 
    303289                  zpropo4n(ji,jj,jk) = zpropmax * xnanopo4(ji,jj,jk) 
    304290                  zprodopn(ji,jj,jk) = zpropmax * xnanodop(ji,jj,jk) 
    305291                  ! Uptake of iron 
    306                   zrat = 1.0 - MIN( 1., zratiof / qfnmax ) 
    307                   zmax = MAX(0., MIN(1., zrat**2/ (0.05**2 + zrat**2) ) ) 
    308                   zprofmax = zprnutmax * qfnmax * zmax  
     292                  zqfnmax = xqfuncfecn(ji,jj,jk) + ( qfnmax - xqfuncfecn(ji,jj,jk) ) * xlimnpn(ji,jj,jk) 
     293                  zratio = 1.0 - MIN( 1., zratiof / zqfnmax ) 
     294                  zmax = MAX(0., MIN(1., zratio**2/ (0.05**2 + zratio**2) ) ) 
     295                  zprofmax = zprnutmax * zqfnmax * zmax  
    309296                  zprofen(ji,jj,jk) = zprofmax * xnanofer(ji,jj,jk)    & 
    310297                  &          * (1. + 0.8 * xnanono3(ji,jj,jk) / ( rtrn  & 
     
    341328                  zratiop = trb(ji,jj,jk,jpppi) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    342329                  zratiof = trb(ji,jj,jk,jppfe) / ( trb(ji,jj,jk,jppic) + rtrn ) 
    343                   zprnutmax = zprnutp(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jppic) * rfact2 
     330                  zprnutmax = zprnut(ji,jj,jk) * fvpuptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jppic) * rfact2 
    344331                  ! Uptake of nitrogen 
    345                   zrat = 1.0 - MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 
    346                   zmax = MAX(0., MIN(1., zrat**2/ (0.05**2 + zrat**2) ) ) 
     332                  zratio = 1.0 - MIN( 1., zration / (xqnpmax(ji,jj,jk) + rtrn) ) 
     333                  zmax = MAX(0., MIN(1., zratio**2/ (0.05**2 + zratio**2) ) ) 
    347334                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqppmin(ji,jj,jk) )   & 
    348335                  &          / ( xqppmax(ji,jj,jk) - xqppmin(ji,jj,jk) + rtrn ), xlimpfe(ji,jj,jk) ) ) 
     336                  zpronmax = zpronmax * xqnpmin(ji,jj,jk) / qnnmin 
    349337                  zpronewp(ji,jj,jk) = zpronmax * xpicono3(ji,jj,jk)  
    350338                  zproregp(ji,jj,jk) = zpronmax * xpiconh4(ji,jj,jk) 
    351339                  ! Uptake of phosphorus 
    352                   zrat = 1.0 - MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 
    353                   zmax = MAX(0., MIN(1., zrat**2 / (0.05**2 + zrat**2) ) ) 
    354                   zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk) * 16./10. 
     340                  zratio = 1.0 - MIN( 1., zratiop / (xqppmax(ji,jj,jk) + rtrn) ) 
     341                  zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) ) 
     342                  zpropmax = zprnutmax * zmax * xlimpfe(ji,jj,jk)  
    355343                  zpropo4p(ji,jj,jk) = zpropmax * xpicopo4(ji,jj,jk) 
    356344                  zprodopp(ji,jj,jk) = zpropmax * xpicodop(ji,jj,jk) 
    357345                  ! Uptake of iron 
    358                   zrat = 1.0 - MIN( 1., zratiof / qfpmax ) 
    359                   zmax = MAX(0., MIN(1., zrat**2 / (0.05**2 + zrat**2) ) ) 
    360                   zprofmax = zprnutmax * qfpmax * zmax 
     346                  zqfpmax = xqfuncfecp(ji,jj,jk) + ( qfpmax - xqfuncfecp(ji,jj,jk) ) * xlimnpp(ji,jj,jk) 
     347                  zratio = 1.0 - MIN( 1., zratiof / zqfpmax ) 
     348                  zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) ) 
     349                  zprofmax = zprnutmax * zqfpmax * zmax 
    361350                  zprofep(ji,jj,jk) = zprofmax * xpicofer(ji,jj,jk)  & 
    362351                  &          * (1. + 0.8 * xpicono3(ji,jj,jk) / ( rtrn   & 
     
    395384                  zprnutmax = zprnut(ji,jj,jk) * fvduptk(ji,jj,jk) / rno3 * trb(ji,jj,jk,jpdia) * rfact2 
    396385                  ! Uptake of nitrogen 
    397                   zrat = 1.0 - MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 
    398                   zmax = MAX(0., MIN(1., zrat**2 / (0.05**2 + zrat**2) ) ) 
     386                  zratio = 1.0 - MIN( 1., zration / (xqndmax(ji,jj,jk) + rtrn) ) 
     387                  zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) ) 
    399388                  zpronmax = zprnutmax * zmax * MAX(0., MIN(1., ( zratiop - xqpdmin(ji,jj,jk) )   & 
    400389                  &          / ( xqpdmax(ji,jj,jk) - xqpdmin(ji,jj,jk) + rtrn ), xlimdfe(ji,jj,jk) ) ) 
     390                  zpronmax = zpronmax * xqndmin(ji,jj,jk) / qnnmin 
    401391                  zpronewd(ji,jj,jk) = zpronmax * xdiatno3(ji,jj,jk) 
    402392                  zproregd(ji,jj,jk) = zpronmax * xdiatnh4(ji,jj,jk) 
    403393                  ! Uptake of phosphorus 
    404                   zrat = 1.0 - MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 
    405                   zmax = MAX(0., MIN(1., zrat**2/ (0.05**2 + zrat**2) ) ) 
    406                   zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) * 16./10. 
     394                  zratio = 1.0 - MIN( 1., zratiop / (xqpdmax(ji,jj,jk) + rtrn) ) 
     395                  zmax = MAX(0., MIN(1., zratio**2/ (0.05**2 + zratio**2) ) ) 
     396                  zpropmax = zprnutmax * zmax * xlimdfe(ji,jj,jk) 
    407397                  zpropo4d(ji,jj,jk) = zpropmax * xdiatpo4(ji,jj,jk) 
    408398                  zprodopd(ji,jj,jk) = zpropmax * xdiatdop(ji,jj,jk) 
    409399                  ! Uptake of iron 
    410                   zrat = 1.0 - MIN( 1., zratiof / qfdmax ) 
    411                   zmax = MAX(0., MIN(1., zrat**2 / (0.05**2 + zrat**2) ) ) 
    412                   zprofmax = zprnutmax * qfdmax * zmax 
     400                  zqfdmax = xqfuncfecd(ji,jj,jk) + ( qfdmax - xqfuncfecd(ji,jj,jk) ) * xlimnpd(ji,jj,jk) 
     401                  zratio = 1.0 - MIN( 1., zratiof / zqfdmax ) 
     402                  zmax = MAX(0., MIN(1., zratio**2 / (0.05**2 + zratio**2) ) ) 
     403                  zprofmax = zprnutmax * zqfdmax * zmax 
    413404                  zprofed(ji,jj,jk) = zprofmax * xdiatfer(ji,jj,jk)    & 
    414405                  &          * (1. + 0.8 * xdiatno3(ji,jj,jk) / ( rtrn   & 
     
    503494              zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
    504495              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 
     496              consfe3(ji,jj,jk)   = zfeup * 75.0 / ( rtrn + ( plig(ji,jj,jk) + 75.0 * (1.0 - plig(ji,jj,jk) ) )   & 
     497              &                     * trb(ji,jj,jk,jpfer) ) / rfact2 
    505498              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - zprmaxd(ji,jj,jk) * zysopt(ji,jj,jk) * rfact2 * trb(ji,jj,jk,jpdia) 
    506499              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) - zprorcap(ji,jj,jk)  & 
     
    529522                 zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) + texcretp * zprofep(ji,jj,jk) 
    530523                 tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp    & 
    531                  &       - zfeup * plig(ji,jj,jk) / ( rtrn + plig(ji,jj,jk) + 2.E3 * (1.0 - plig(ji,jj,jk) ) ) * lthet 
     524                 &       - zfeup * plig(ji,jj,jk) / ( rtrn + plig(ji,jj,jk) + 75.0 * (1.0 - plig(ji,jj,jk) ) ) * lthet 
    532525                 zpligprod1(ji,jj,jk) = zdocprod * ldocp 
    533526                 zpligprod2(ji,jj,jk) = zfeup * plig(ji,jj,jk) / ( rtrn + plig(ji,jj,jk) & 
    534                  &                      + 2.E3 * (1.0 - plig(ji,jj,jk) ) ) * lthet 
     527                 &                      + 75.0 * (1.0 - plig(ji,jj,jk) ) ) * lthet 
    535528              END DO 
    536529           END DO 
Note: See TracChangeset for help on using the changeset viewer.