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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zpoc.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zpoc.F90

    r11114 r13463  
    1515   USE trc             !  passive tracers common variables  
    1616   USE sms_pisces      !  PISCES Source Minus Sink variables 
    17    USE prtctl_trc      !  print control for debugging 
     17   USE prtctl          !  print control for debugging 
    1818   USE iom             !  I/O manager 
    1919 
     
    3737 
    3838 
     39   !! * Substitutions 
     40#  include "do_loop_substitute.h90" 
     41#  include "domzgr_substitute.h90" 
    3942   !!---------------------------------------------------------------------- 
    4043   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    4447CONTAINS 
    4548 
    46    SUBROUTINE p4z_poc( kt, knt ) 
     49   SUBROUTINE p4z_poc( kt, knt, Kbb, Kmm, Krhs ) 
    4750      !!--------------------------------------------------------------------- 
    4851      !!                     ***  ROUTINE p4z_poc  *** 
     
    5255      !! ** Method  : - ??? 
    5356      !!--------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ??? 
     57      INTEGER, INTENT(in) ::   kt, knt         ! ocean time step and ??? 
     58      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level indices 
    5559      ! 
    5660      INTEGER  ::   ji, jj, jk, jn 
     
    103107     ! ----------------------------------------------------------------------- 
    104108     ztremint(:,:,:) = zremigoc(:,:,:) 
    105      DO jk = 2, jpkm1 
    106         DO jj = 1, jpj 
    107            DO ji = 1, jpi 
    108               IF (tmask(ji,jj,jk) == 1.) THEN 
    109                 zdep = hmld(ji,jj) 
    110                 ! 
    111                 ! In the case of GOC, lability is constant in the mixed layer  
    112                 ! It is computed only below the mixed layer depth 
    113                 ! ------------------------------------------------------------ 
    114                 ! 
    115                 IF( gdept_n(ji,jj,jk) > zdep ) THEN 
    116                   alphat = 0. 
    117                   remint = 0. 
    118                   ! 
    119                   zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    120                   zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    121                   ! 
    122                   IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN 
    123                     !  
    124                     ! The first level just below the mixed layer needs a  
    125                     ! specific treatment because lability is supposed constant 
    126                     ! everywhere within the mixed layer. This means that  
    127                     ! change in lability in the bottom part of the previous cell 
    128                     ! should not be computed 
    129                     ! ---------------------------------------------------------- 
    130                     ! 
    131                     ! POC concentration is computed using the lagrangian  
    132                     ! framework. It is only used for the lability param 
    133                     zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk) * rday / rfact2               & 
    134                     &   * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
    135                     zpoc = MAX(0., zpoc) 
    136                     ! 
    137                     DO jn = 1, jcpoc 
    138                        ! 
    139                        ! Lagrangian based algorithm. The fraction of each  
    140                        ! lability class is computed starting from the previous 
    141                        ! level 
    142                        ! ----------------------------------------------------- 
    143                        ! 
    144                        ! the concentration of each lability class is calculated 
    145                        ! as the sum of the different sources and sinks 
    146                        ! Please note that production of new GOC experiences 
    147                        ! degradation  
    148                        alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 
    149                        &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             & 
    150                        &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2  
    151                        alphat = alphat + alphag(ji,jj,jk,jn) 
    152                        remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
    153                     END DO 
    154                   ELSE 
    155                     ! 
    156                     ! standard algorithm in the rest of the water column 
    157                     ! See the comments in the previous block. 
    158                     ! --------------------------------------------------- 
    159                     ! 
    160                     zpoc = trb(ji,jj,jk-1,jpgoc) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
    161                     &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
    162                     &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
    163                     zpoc = max(0., zpoc) 
    164                     ! 
    165                     DO jn = 1, jcpoc 
    166                        alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              & 
    167                        &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           & 
    168                        &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 
    169                        &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn)  
    170                        alphat = alphat + alphag(ji,jj,jk,jn) 
    171                        remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
    172                     END DO 
    173                   ENDIF 
    174                   ! 
    175                   DO jn = 1, jcpoc 
    176                      ! The contribution of each lability class at the current 
    177                      ! level is computed 
    178                      alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 
    179                   END DO 
    180                   ! Computation of the mean remineralisation rate 
    181                   ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) ) 
    182                   ! 
    183                 ENDIF 
    184               ENDIF 
     109     DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     110        IF (tmask(ji,jj,jk) == 1.) THEN 
     111          zdep = hmld(ji,jj) 
     112          ! 
     113          ! In the case of GOC, lability is constant in the mixed layer  
     114          ! It is computed only below the mixed layer depth 
     115          ! ------------------------------------------------------------ 
     116          ! 
     117          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     118            alphat = 0. 
     119            remint = 0. 
     120            ! 
     121            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     122            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     123            ! 
     124            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
     125              !  
     126              ! The first level just below the mixed layer needs a  
     127              ! specific treatment because lability is supposed constant 
     128              ! everywhere within the mixed layer. This means that  
     129              ! change in lability in the bottom part of the previous cell 
     130              ! should not be computed 
     131              ! ---------------------------------------------------------- 
     132              ! 
     133              ! POC concentration is computed using the lagrangian  
     134              ! framework. It is only used for the lability param 
     135              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk) * rday / rfact2               & 
     136              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     137              zpoc = MAX(0., zpoc) 
     138              ! 
     139              DO jn = 1, jcpoc 
     140                 ! 
     141                 ! Lagrangian based algorithm. The fraction of each  
     142                 ! lability class is computed starting from the previous 
     143                 ! level 
     144                 ! ----------------------------------------------------- 
     145                 ! 
     146                 ! the concentration of each lability class is calculated 
     147                 ! as the sum of the different sources and sinks 
     148                 ! Please note that production of new GOC experiences 
     149                 ! degradation  
     150                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc & 
     151                 &   + prodgoc(ji,jj,jk) * alphan(jn) / tgfunc(ji,jj,jk) / reminp(jn)             & 
     152                 &   * ( 1. - exp( -reminp(jn) * zsizek ) ) * rday / rfact2  
     153                 alphat = alphat + alphag(ji,jj,jk,jn) 
     154                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     155              END DO 
     156            ELSE 
     157              ! 
     158              ! standard algorithm in the rest of the water column 
     159              ! See the comments in the previous block. 
     160              ! --------------------------------------------------- 
     161              ! 
     162              zpoc = tr(ji,jj,jk-1,jpgoc,Kbb) + consgoc(ji,jj,jk-1) * rday / rfact2               & 
     163              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio4(ji,jj,jk-1) + rtrn) + consgoc(ji,jj,jk)   & 
     164              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio4(ji,jj,jk) + rtrn) 
     165              zpoc = max(0., zpoc) 
     166              ! 
     167              DO jn = 1, jcpoc 
     168                 alphag(ji,jj,jk,jn) = alphag(ji,jj,jk-1,jn) * exp( -reminp(jn) * ( zsizek              & 
     169                 &   + zsizek1 ) ) * zpoc + ( prodgoc(ji,jj,jk-1) / tgfunc(ji,jj,jk-1) * ( 1.           & 
     170                 &   - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn) * zsizek ) + prodgoc(ji,jj,jk) & 
     171                 &   / tgfunc(ji,jj,jk) * ( 1. - exp( -reminp(jn) * zsizek ) ) ) * rday / rfact2 / reminp(jn) * alphan(jn)  
     172                 alphat = alphat + alphag(ji,jj,jk,jn) 
     173                 remint = remint + alphag(ji,jj,jk,jn) * reminp(jn) 
     174              END DO 
     175            ENDIF 
     176            ! 
     177            DO jn = 1, jcpoc 
     178               ! The contribution of each lability class at the current 
     179               ! level is computed 
     180               alphag(ji,jj,jk,jn) = alphag(ji,jj,jk,jn) / ( alphat + rtrn) 
    185181            END DO 
    186          END DO 
    187       END DO 
     182            ! Computation of the mean remineralisation rate 
     183            ztremint(ji,jj,jk) =  MAX(0., remint / ( alphat + rtrn) ) 
     184            ! 
     185          ENDIF 
     186        ENDIF 
     187     END_3D 
    188188 
    189189      IF( ln_p4z ) THEN   ;   zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
     
    192192 
    193193      IF( ln_p4z ) THEN 
    194          DO jk = 1, jpkm1 
    195             DO jj = 1, jpj 
    196                DO ji = 1, jpi 
    197                   ! POC disaggregation by turbulence and bacterial activity.  
    198                   ! -------------------------------------------------------- 
    199                   zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    200                   zorem2  = zremig * trb(ji,jj,jk,jpgoc) 
    201                   orem(ji,jj,jk)      = zorem2 
    202                   zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 
    203                   zofer2 = zremig * trb(ji,jj,jk,jpbfe) 
    204                   zofer3 = zremig * solgoc * trb(ji,jj,jk,jpbfe) 
    205  
    206                   ! ------------------------------------- 
    207                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk) 
    208                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 - zorem3(ji,jj,jk) 
    209                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer3 
    210                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 - zofer3 
    211                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem2 
    212                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 
    213                   zfolimi(ji,jj,jk)   = zofer2 
    214                END DO 
    215             END DO 
    216          END DO 
     194         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     195            ! POC disaggregation by turbulence and bacterial activity.  
     196            ! -------------------------------------------------------- 
     197            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     198            zorem2  = zremig * tr(ji,jj,jk,jpgoc,Kbb) 
     199            orem(ji,jj,jk)      = zorem2 
     200            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     201            zofer2 = zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     202            zofer3 = zremig * solgoc * tr(ji,jj,jk,jpbfe,Kbb) 
     203 
     204            ! ------------------------------------- 
     205            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     206            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zorem2 - zorem3(ji,jj,jk) 
     207            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zofer3 
     208            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 - zofer3 
     209            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem2 
     210            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     211            zfolimi(ji,jj,jk)   = zofer2 
     212         END_3D 
    217213      ELSE 
    218          DO jk = 1, jpkm1 
    219             DO jj = 1, jpj 
    220                DO ji = 1, jpi 
    221                    ! POC disaggregation by turbulence and bacterial activity.  
    222                   ! -------------------------------------------------------- 
    223                   zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    224                   zopoc2 = zremig  * trb(ji,jj,jk,jpgoc) 
    225                   orem(ji,jj,jk) = zopoc2 
    226                   zorem3(ji,jj,jk) = zremig * solgoc * trb(ji,jj,jk,jpgoc) 
    227                   zopon2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpgon) 
    228                   zopop2 = xremipp / xremipc * zremig * trb(ji,jj,jk,jpgop) 
    229                   zofer2 = xremipn / xremipc * zremig * trb(ji,jj,jk,jpbfe) 
    230  
    231                   ! ------------------------------------- 
    232                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem3(ji,jj,jk) 
    233                   tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + solgoc * zopon2  
    234                   tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + solgoc * zopop2 
    235                   tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + solgoc * zofer2 
    236                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc2 
    237                   tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon2 
    238                   tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop2 
    239                   tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer2 
    240                   tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zopoc2 - zorem3(ji,jj,jk) 
    241                   tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) - zopon2 * (1. + solgoc) 
    242                   tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) - zopop2 * (1. + solgoc) 
    243                   tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 * (1. + solgoc) 
    244                   zfolimi(ji,jj,jk)   = zofer2 
    245                END DO 
    246             END DO 
    247          END DO 
     214         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     215             ! POC disaggregation by turbulence and bacterial activity.  
     216            ! -------------------------------------------------------- 
     217            zremig = zremigoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     218            zopoc2 = zremig  * tr(ji,jj,jk,jpgoc,Kbb) 
     219            orem(ji,jj,jk) = zopoc2 
     220            zorem3(ji,jj,jk) = zremig * solgoc * tr(ji,jj,jk,jpgoc,Kbb) 
     221            zopon2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpgon,Kbb) 
     222            zopop2 = xremipp / xremipc * zremig * tr(ji,jj,jk,jpgop,Kbb) 
     223            zofer2 = xremipn / xremipc * zremig * tr(ji,jj,jk,jpbfe,Kbb) 
     224 
     225            ! ------------------------------------- 
     226            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zorem3(ji,jj,jk) 
     227            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) + solgoc * zopon2  
     228            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) + solgoc * zopop2 
     229            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + solgoc * zofer2 
     230            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc2 
     231            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon2 
     232            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop2 
     233            tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer2 
     234            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) - zopoc2 - zorem3(ji,jj,jk) 
     235            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) - zopon2 * (1. + solgoc) 
     236            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) - zopop2 * (1. + solgoc) 
     237            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) - zofer2 * (1. + solgoc) 
     238            zfolimi(ji,jj,jk)   = zofer2 
     239         END_3D 
    248240      ENDIF 
    249241 
    250      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     242     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    251243        WRITE(charout, FMT="('poc1')") 
    252         CALL prt_ctl_trc_info(charout) 
    253         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     244        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     245        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    254246     ENDIF 
    255247 
     
    268260     ! ---------------------------------------------------------------- 
    269261     !  
    270      DO jk = 1, jpkm1 
    271         DO jj = 1, jpj 
    272            DO ji = 1, jpi 
    273               zdep = hmld(ji,jj) 
    274               IF (tmask(ji,jj,jk) == 1. .AND. gdept_n(ji,jj,jk) <= zdep ) THEN 
    275                 totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2 
    276                 ! The temperature effect is included here 
    277                 totthick(ji,jj) = totthick(ji,jj) + e3t_n(ji,jj,jk)* tgfunc(ji,jj,jk) 
    278                 totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t_n(ji,jj,jk) * rday/ rfact2    & 
    279                 &                / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    280               ENDIF 
    281            END DO 
    282         END DO 
    283      END DO 
     262     DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     263        zdep = hmld(ji,jj) 
     264        IF (tmask(ji,jj,jk) == 1. .AND. gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     265          totprod(ji,jj) = totprod(ji,jj) + prodpoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2 
     266          ! The temperature effect is included here 
     267          totthick(ji,jj) = totthick(ji,jj) + e3t(ji,jj,jk,Kmm)* tgfunc(ji,jj,jk) 
     268          totcons(ji,jj) = totcons(ji,jj) - conspoc(ji,jj,jk) * e3t(ji,jj,jk,Kmm) * rday/ rfact2    & 
     269          &                / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn ) 
     270        ENDIF 
     271     END_3D 
    284272 
    285273     ! Computation of the lability spectrum in the mixed layer. In the mixed  
     
    287275     ! --------------------------------------------------------------------- 
    288276     ztremint(:,:,:) = zremipoc(:,:,:) 
    289      DO jk = 1, jpkm1 
    290         DO jj = 1, jpj 
    291            DO ji = 1, jpi 
    292               IF (tmask(ji,jj,jk) == 1.) THEN 
    293                 zdep = hmld(ji,jj) 
    294                 alphat = 0.0 
    295                 remint = 0.0 
    296                 IF( gdept_n(ji,jj,jk) <= zdep ) THEN 
    297                    DO jn = 1, jcpoc 
    298                       ! For each lability class, the system is supposed to be  
    299                       ! at equilibrium: Prod - Sink - w alphap = 0. 
    300                       alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    & 
    301                       &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 
    302                       alphat = alphat + alphap(ji,jj,jk,jn) 
    303                    END DO 
    304                    DO jn = 1, jcpoc 
    305                       alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
    306                       remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    307                    END DO 
    308                    ! Mean remineralization rate in the mixed layer 
    309                    ztremint(ji,jj,jk) =  MAX( 0., remint ) 
    310                 ENDIF 
    311               ENDIF 
    312            END DO 
    313         END DO 
    314      END DO 
     277     DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     278        IF (tmask(ji,jj,jk) == 1.) THEN 
     279          zdep = hmld(ji,jj) 
     280          alphat = 0.0 
     281          remint = 0.0 
     282          IF( gdept(ji,jj,jk,Kmm) <= zdep ) THEN 
     283             DO jn = 1, jcpoc 
     284                ! For each lability class, the system is supposed to be  
     285                ! at equilibrium: Prod - Sink - w alphap = 0. 
     286                alphap(ji,jj,jk,jn) = totprod(ji,jj) * alphan(jn) / ( reminp(jn)    & 
     287                &                     * totthick(ji,jj) + totcons(ji,jj) + wsbio + rtrn ) 
     288                alphat = alphat + alphap(ji,jj,jk,jn) 
     289             END DO 
     290             DO jn = 1, jcpoc 
     291                alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
     292                remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
     293             END DO 
     294             ! Mean remineralization rate in the mixed layer 
     295             ztremint(ji,jj,jk) =  MAX( 0., remint ) 
     296          ENDIF 
     297        ENDIF 
     298     END_3D 
    315299     ! 
    316300     IF( ln_p4z ) THEN   ;  zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
     
    326310     ! ----------------------------------------------------------------------- 
    327311     ! 
    328      DO jk = 2, jpkm1 
    329         DO jj = 1, jpj 
    330            DO ji = 1, jpi 
    331               IF (tmask(ji,jj,jk) == 1.) THEN 
    332                 zdep = hmld(ji,jj) 
    333                 IF( gdept_n(ji,jj,jk) > zdep ) THEN 
    334                   alphat = 0. 
    335                   remint = 0. 
    336                   ! 
    337                   ! the scale factors are corrected with temperature 
    338                   zsizek1  = e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
    339                   zsizek = e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
    340                   ! 
    341                   ! Special treatment of the level just below the MXL 
    342                   ! See the comments in the GOC section 
    343                   ! --------------------------------------------------- 
    344                   ! 
    345                   IF ( gdept_n(ji,jj,jk-1) <= zdep ) THEN 
    346                     ! 
    347                     ! Computation of the POC concentration using the  
    348                     ! lagrangian algorithm 
    349                     zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk) * rday / rfact2               & 
    350                     &   * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
    351                     zpoc = max(0., zpoc) 
    352                     !  
    353                     DO jn = 1, jcpoc 
    354                        ! computation of the lability spectrum applying the  
    355                        ! different sources and sinks 
    356                        alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  & 
    357                        &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 
    358                        &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     & 
    359                        &   * zsizek ) ) 
    360                        alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 
    361                        alphat = alphat + alphap(ji,jj,jk,jn) 
    362                     END DO 
    363                   ELSE 
    364                     ! 
    365                     ! Lability parameterization for the interior of the ocean 
    366                     ! This is very similar to what is done in the previous  
    367                     ! block 
    368                     ! -------------------------------------------------------- 
    369                     ! 
    370                     zpoc = trb(ji,jj,jk-1,jppoc) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
    371                     &   * e3t_n(ji,jj,jk-1) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
    372                     &   * rday / rfact2 * e3t_n(ji,jj,jk) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
    373                     zpoc = max(0., zpoc) 
    374                     ! 
    375                     DO jn = 1, jcpoc 
    376                        alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       & 
    377                        &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             &  
    378                        &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      & 
    379                        &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  & 
    380                        &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 & 
    381                        &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   & 
    382                        &   - exp( -reminp(jn) * zsizek ) ) 
    383                        alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 
    384                        alphat = alphat + alphap(ji,jj,jk,jn) 
    385                     END DO 
    386                   ENDIF 
    387                   ! Normalization of the lability spectrum so that the  
    388                   ! integral is equal to 1 
    389                   DO jn = 1, jcpoc 
    390                      alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
    391                      remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    392                   END DO 
    393                   ! Mean remineralization rate in the water column 
    394                   ztremint(ji,jj,jk) =  MAX( 0., remint ) 
    395                 ENDIF 
    396               ENDIF 
     312     DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 
     313        IF (tmask(ji,jj,jk) == 1.) THEN 
     314          zdep = hmld(ji,jj) 
     315          IF( gdept(ji,jj,jk,Kmm) > zdep ) THEN 
     316            alphat = 0. 
     317            remint = 0. 
     318            ! 
     319            ! the scale factors are corrected with temperature 
     320            zsizek1  = e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) * tgfunc(ji,jj,jk-1) 
     321            zsizek = e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) * tgfunc(ji,jj,jk) 
     322            ! 
     323            ! Special treatment of the level just below the MXL 
     324            ! See the comments in the GOC section 
     325            ! --------------------------------------------------- 
     326            ! 
     327            IF ( gdept(ji,jj,jk-1,Kmm) <= zdep ) THEN 
     328              ! 
     329              ! Computation of the POC concentration using the  
     330              ! lagrangian algorithm 
     331              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk) * rday / rfact2               & 
     332              &   * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     333              zpoc = max(0., zpoc) 
     334              !  
     335              DO jn = 1, jcpoc 
     336                 ! computation of the lability spectrum applying the  
     337                 ! different sources and sinks 
     338                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn) * zsizek ) * zpoc  & 
     339                 &   + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk) * alphag(ji,jj,jk,jn) ) & 
     340                 &   / tgfunc(ji,jj,jk) / reminp(jn) * rday / rfact2 * ( 1. - exp( -reminp(jn)     & 
     341                 &   * zsizek ) ) 
     342                 alphap(ji,jj,jk,jn) = MAX( 0., alphap(ji,jj,jk,jn) ) 
     343                 alphat = alphat + alphap(ji,jj,jk,jn) 
     344              END DO 
     345            ELSE 
     346              ! 
     347              ! Lability parameterization for the interior of the ocean 
     348              ! This is very similar to what is done in the previous  
     349              ! block 
     350              ! -------------------------------------------------------- 
     351              ! 
     352              zpoc = tr(ji,jj,jk-1,jppoc,Kbb) + conspoc(ji,jj,jk-1) * rday / rfact2               & 
     353              &   * e3t(ji,jj,jk-1,Kmm) / 2. / (wsbio3(ji,jj,jk-1) + rtrn) + conspoc(ji,jj,jk)   & 
     354              &   * rday / rfact2 * e3t(ji,jj,jk,Kmm) / 2. / (wsbio3(ji,jj,jk) + rtrn) 
     355              zpoc = max(0., zpoc) 
     356              ! 
     357              DO jn = 1, jcpoc 
     358                 alphap(ji,jj,jk,jn) = alphap(ji,jj,jk-1,jn) * exp( -reminp(jn)                       & 
     359                 &   * ( zsizek + zsizek1 ) ) * zpoc + ( prodpoc(ji,jj,jk-1) * alphan(jn)             &  
     360                 &   + zorem3(ji,jj,jk-1) * alphag(ji,jj,jk-1,jn) ) * rday / rfact2 / reminp(jn)      & 
     361                 &   / tgfunc(ji,jj,jk-1) * ( 1. - exp( -reminp(jn) * zsizek1 ) ) * exp( -reminp(jn)  & 
     362                 &   * zsizek ) + ( prodpoc(ji,jj,jk) * alphan(jn) + zorem3(ji,jj,jk)                 & 
     363                 &   * alphag(ji,jj,jk,jn) ) * rday / rfact2 / reminp(jn) / tgfunc(ji,jj,jk) * ( 1.   & 
     364                 &   - exp( -reminp(jn) * zsizek ) ) 
     365                 alphap(ji,jj,jk,jn) = max(0., alphap(ji,jj,jk,jn) ) 
     366                 alphat = alphat + alphap(ji,jj,jk,jn) 
     367              END DO 
     368            ENDIF 
     369            ! Normalization of the lability spectrum so that the  
     370            ! integral is equal to 1 
     371            DO jn = 1, jcpoc 
     372               alphap(ji,jj,jk,jn) = alphap(ji,jj,jk,jn) / ( alphat + rtrn) 
     373               remint = remint + alphap(ji,jj,jk,jn) * reminp(jn) 
    397374            END DO 
    398          END DO 
    399       END DO 
     375            ! Mean remineralization rate in the water column 
     376            ztremint(ji,jj,jk) =  MAX( 0., remint ) 
     377          ENDIF 
     378        ENDIF 
     379     END_3D 
    400380 
    401381     IF( ln_p4z ) THEN   ;   zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 
     
    404384 
    405385     IF( ln_p4z ) THEN 
    406          DO jk = 1, jpkm1 
    407             DO jj = 1, jpj 
    408                DO ji = 1, jpi 
    409                   IF (tmask(ji,jj,jk) == 1.) THEN 
    410                     ! POC disaggregation by turbulence and bacterial activity.  
    411                     ! -------------------------------------------------------- 
    412                     zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    413                     zorem           = zremip * trb(ji,jj,jk,jppoc) 
    414                     zofer           = zremip * trb(ji,jj,jk,jpsfe) 
    415  
    416                     tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
    417                     orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem 
    418                     tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 
    419                     tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 
    420                     tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 
    421                     zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
    422                   ENDIF 
    423                END DO 
    424             END DO 
    425          END DO 
     386         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     387            IF (tmask(ji,jj,jk) == 1.) THEN 
     388              ! POC disaggregation by turbulence and bacterial activity.  
     389              ! -------------------------------------------------------- 
     390              zremip          = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     391              zorem           = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     392              zofer           = zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     393 
     394              tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zorem 
     395              orem(ji,jj,jk)      = orem(ji,jj,jk) + zorem 
     396              tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer 
     397              tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zorem 
     398              tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     399              zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
     400            ENDIF 
     401         END_3D 
    426402     ELSE 
    427        DO jk = 1, jpkm1 
    428           DO jj = 1, jpj 
    429              DO ji = 1, jpi 
    430                 ! POC disaggregation by turbulence and bacterial activity.  
    431                 ! -------------------------------------------------------- 
    432                 zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
    433                 zopoc  = zremip * trb(ji,jj,jk,jppoc) 
    434                 orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc 
    435                 zopon  = xremipn / xremipc * zremip * trb(ji,jj,jk,jppon) 
    436                 zopop  = xremipp / xremipc * zremip * trb(ji,jj,jk,jppop) 
    437                 zofer  = xremipn / xremipc * zremip * trb(ji,jj,jk,jpsfe) 
    438  
    439                 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zopoc 
    440                 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zopon 
    441                 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zopop 
    442                 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 
    443                 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zopoc 
    444                 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zopon  
    445                 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + zopop  
    446                 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer  
    447                 zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
    448              END DO 
    449            END DO 
    450         END DO 
     403       DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     404          ! POC disaggregation by turbulence and bacterial activity.  
     405          ! -------------------------------------------------------- 
     406          zremip = zremipoc(ji,jj,jk) * xstep * tgfunc(ji,jj,jk) 
     407          zopoc  = zremip * tr(ji,jj,jk,jppoc,Kbb) 
     408          orem(ji,jj,jk)  = orem(ji,jj,jk) + zopoc 
     409          zopon  = xremipn / xremipc * zremip * tr(ji,jj,jk,jppon,Kbb) 
     410          zopop  = xremipp / xremipc * zremip * tr(ji,jj,jk,jppop,Kbb) 
     411          zofer  = xremipn / xremipc * zremip * tr(ji,jj,jk,jpsfe,Kbb) 
     412 
     413          tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zopoc 
     414          tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zopon 
     415          tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zopop 
     416          tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zofer 
     417          tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zopoc 
     418          tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) + zopon  
     419          tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) + zopop  
     420          tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zofer  
     421          zfolimi(ji,jj,jk)   = zfolimi(ji,jj,jk) + zofer 
     422       END_3D 
    451423     ENDIF 
    452424 
     
    460432     ENDIF 
    461433 
    462       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     434      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    463435         WRITE(charout, FMT="('poc2')") 
    464          CALL prt_ctl_trc_info(charout) 
    465          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     436         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     437         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    466438      ENDIF 
    467439      ! 
     
    497469      ENDIF 
    498470      ! 
    499       REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization 
    500471      READ  ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901) 
    501 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp ) 
    502       REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization 
     472901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampispoc in reference namelist' ) 
    503473      READ  ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 ) 
    504 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp ) 
     474902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampispoc in configuration namelist' ) 
    505475      IF(lwm) WRITE( numonp, nampispoc ) 
    506476 
Note: See TracChangeset for help on using the changeset viewer.