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 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES – NEMO

Ignore:
Timestamp:
2015-12-03T09:10:32+01:00 (8 years ago)
Author:
deazer
Message:

Merging TMB and 25h diagnostics to head of trunk
added brief documentation

Location:
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES
Files:
26 edited
1 copied

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r5260 r5989  
    5959   REAL(wp) ::   fdbod      ! zooplankton mortality fraction that goes to detritus 
    6060 
    61    !!* Substitution 
    62 #  include "top_substitute.h90" 
     61   !! * Substitutions 
     62#  include "domzgr_substitute.h90" 
     63#  include "vectopt_loop_substitute.h90" 
    6364   !!---------------------------------------------------------------------- 
    6465   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    599600 
    600601   !!====================================================================== 
    601 END MODULE  p2zbio 
     602END MODULE p2zbio 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r5260 r5989  
    4141   REAL(wp)                                ::   areacot   !: surface coastal area 
    4242 
    43    !!* Substitution 
    44 #  include "top_substitute.h90" 
     43   !! * Substitutions 
     44#  include "domzgr_substitute.h90" 
     45#  include "vectopt_loop_substitute.h90" 
    4546   !!---------------------------------------------------------------------- 
    4647   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    r5260 r5989  
    4040   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM 
    4141 
    42    !!* Substitution 
    43 #  include "top_substitute.h90" 
     42   !! * Substitutions 
     43#  include "domzgr_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    8989 
    9090      !                                          ! surface irradiance 
    91       zpar0m (:,:)   = qsr   (:,:) * 0.43        ! ------------------ 
     91      !                                          ! ------------------ 
     92      IF( ln_dm2dc ) THEN   ;   zpar0m(:,:) = qsr_mean(:,:) * 0.43 
     93      ELSE                  ;   zpar0m(:,:) = qsr     (:,:) * 0.43 
     94      ENDIF 
    9295      zpar100(:,:)   = zpar0m(:,:) * 0.01 
    9396      zparr  (:,:,1) = zpar0m(:,:) * 0.5 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r5260 r5989  
    3434   REAL(wp), PUBLIC ::   xhr         ! coeff for martin''s remineralisation profile 
    3535 
    36    !!* Substitution 
    37 #  include "top_substitute.h90" 
     36   !! * Substitutions 
     37#  include "domzgr_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90

    r5260 r5989  
    8484 
    8585   !!====================================================================== 
    86 END MODULE  p2zsms 
     86END MODULE p2zsms 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r4529 r5989  
    3434   PUBLIC  p4z_bio     
    3535 
    36    !!* Substitution 
    37 #  include "top_substitute.h90" 
     36   !! * Substitutions 
     37#  include "domzgr_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4444CONTAINS 
    4545 
    46    SUBROUTINE p4z_bio ( kt, jnt ) 
     46   SUBROUTINE p4z_bio ( kt, knt ) 
    4747      !!--------------------------------------------------------------------- 
    4848      !!                     ***  ROUTINE p4z_bio  *** 
    … …  
    5454      !! ** Method  : - ??? 
    5555      !!--------------------------------------------------------------------- 
    56       INTEGER, INTENT(in) :: kt, jnt 
    57       INTEGER  ::  ji, jj, jk, jn 
    58       REAL(wp) ::  ztra 
    59 #if defined key_kriest 
    60       REAL(wp) ::  zcoef1, zcoef2 
    61 #endif 
     56      INTEGER, INTENT(in) :: kt, knt 
     57      INTEGER             :: ji, jj, jk, jn 
    6258      CHARACTER (len=25) :: charout 
    6359 
    … …  
    8076 
    8177           
    82       CALL p4z_opt  ( kt, jnt )     ! Optic: PAR in the water column 
    83       CALL p4z_sink ( kt, jnt )     ! vertical flux of particulate organic matter 
    84       CALL p4z_fechem(kt, jnt )     ! Iron chemistry/scavenging 
    85       CALL p4z_lim  ( kt, jnt )     ! co-limitations by the various nutrients 
    86       CALL p4z_prod ( kt, jnt )     ! phytoplankton growth rate over the global ocean.  
     78      CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column 
     79      CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter 
     80      CALL p4z_fechem(kt, knt )     ! Iron chemistry/scavenging 
     81      CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
     82      CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
    8783      !                             ! (for each element : C, Si, Fe, Chl ) 
    8884      CALL p4z_mort ( kt      )     ! phytoplankton mortality 
    89       !                             ! zooplankton sources/sinks routines  
    90       CALL p4z_micro( kt, jnt )           ! microzooplankton 
    91       CALL p4z_meso ( kt, jnt )           ! mesozooplankton 
    92       CALL p4z_rem  ( kt, jnt )     ! remineralization terms of organic matter+scavenging of Fe 
     85     !                             ! zooplankton sources/sinks routines  
     86      CALL p4z_micro( kt, knt )           ! microzooplankton 
     87      CALL p4z_meso ( kt, knt )           ! mesozooplankton 
     88      CALL p4z_rem  ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe 
    9389      !                             ! test if tracers concentrations fall below 0. 
    94       xnegtr(:,:,:) = 1.e0 
    95       DO jn = jp_pcs0, jp_pcs1 
    96          DO jk = 1, jpk 
    97             DO jj = 1, jpj 
    98                DO ji = 1, jpi 
    99                   IF( ( trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 
    100                      ztra             = ABS( trn(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 
    101  
    102                      xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
    103                   ENDIF 
    104               END DO 
    105             END DO 
    106          END DO 
    107       END DO 
    108       !                                ! where at least 1 tracer concentration becomes negative 
    109       !                                !  
    110       DO jn = jp_pcs0, jp_pcs1 
    111          trn(:,:,:,jn) = trn(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 
    112       END DO 
    113  
    114  
    115       tra(:,:,:,:) = 0.e0 
    116  
    117 #if defined key_kriest 
    118       !  
    119       zcoef1 = 1.e0 / xkr_massp  
    120       zcoef2 = 1.e0 / xkr_massp / 1.1 
    121       DO jk = 1,jpkm1 
    122          trn(:,:,jk,jpnum) = MAX(  trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  ) 
    123          trn(:,:,jk,jpnum) = MIN(  trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef2              ) 
    124       END DO 
    125 #endif 
    126  
    127       ! 
     90      !                                                             ! 
    12891      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    12992         WRITE(charout, FMT="('bio ')") 
    13093         CALL prt_ctl_trc_info(charout) 
    131          CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 
     94         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    13295      ENDIF 
    13396      ! 
    … …  
    146109 
    147110   !!====================================================================== 
    148 END MODULE  p4zbio 
    149  
     111END MODULE p4zbio 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r5260 r5989  
    164164   REAL(wp) :: devk55  = 0.3692E-3       
    165165 
    166    !!* Substitution 
    167 #include "top_substitute.h90" 
     166   !! * Substitutions 
     167#  include "domzgr_substitute.h90" 
    168168   !!---------------------------------------------------------------------- 
    169169   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    195195      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    196196      ! ---------------------------------- 
    197 !CDIR NOVERRCHK 
    198197      DO jj = 1, jpj 
    199 !CDIR NOVERRCHK 
    200198         DO ji = 1, jpi 
    201199            !                             ! SET ABSOLUTE TEMPERATURE 
    … …  
    227225      ! OXYGEN SOLUBILITY - DEEP OCEAN 
    228226      ! ------------------------------- 
    229 !CDIR NOVERRCHK 
    230227      DO jk = 1, jpk 
    231 !CDIR NOVERRCHK 
    232228         DO jj = 1, jpj 
    233 !CDIR NOVERRCHK 
    234229            DO ji = 1, jpi 
    235230              ztkel = tsn(ji,jj,jk,jp_tem) + 273.16 
    … …  
    252247      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    253248      ! ------------------------------- 
    254 !CDIR NOVERRCHK 
    255249      DO jk = 1, jpk 
    256 !CDIR NOVERRCHK 
    257250         DO jj = 1, jpj 
    258 !CDIR NOVERRCHK 
    259251            DO ji = 1, jpi 
    260252 
    … …  
    396388 
    397389   !!====================================================================== 
    398 END MODULE  p4zche 
     390END MODULE p4zche 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r5260 r5989  
    3939   REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 
    4040 
    41    !!* Substitution 
    42 #  include "top_substitute.h90" 
     41   !! * Substitutions 
     42#  include "domzgr_substitute.h90" 
    4343   !!---------------------------------------------------------------------- 
    4444   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4848CONTAINS 
    4949 
    50    SUBROUTINE p4z_fechem( kt, jnt ) 
     50   SUBROUTINE p4z_fechem( kt, knt ) 
    5151      !!--------------------------------------------------------------------- 
    5252      !!                     ***  ROUTINE p4z_fechem  *** 
    … …  
    6262      !!--------------------------------------------------------------------- 
    6363      ! 
    64       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     64      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    6565      ! 
    6666      INTEGER  ::   ji, jj, jk, jic 
    … …  
    101101      ! ------------------------------------------------- 
    102102      IF( ln_ligvar ) THEN 
    103          ztotlig(:,:,:) =  0.09 * trn(:,:,:,jpdoc) * 1E6 + ligand * 1E9 
     103         ztotlig(:,:,:) =  0.09 * trb(:,:,:,jpdoc) * 1E6 + ligand * 1E9 
    104104         ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. ) 
    105105      ELSE 
    … …  
    113113         ! Chemistry is supposed to be fast enough to be at equilibrium 
    114114         ! ------------------------------------------------------------ 
    115 !CDIR NOVERRCHK 
    116115         DO jk = 1, jpkm1 
    117 !CDIR NOVERRCHK 
    118116            DO jj = 1, jpj 
    119 !CDIR NOVERRCHK 
    120117               DO ji = 1, jpi 
    121118                  ! Calculate ligand concentrations : assume 2/3rd of excess goes to 
    … …  
    127124                  zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn ) 
    128125                  zph    = -LOG10( MAX( hi(ji,jj,jk), rtrn) ) 
    129                   zoxy   = trn(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 ) 
     126                  zoxy   = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 ) 
    130127                  ! Fe2+ oxydation rate from Santana-Casiano et al. (2005) 
    131128                  zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tsn(ji,jj,jk,jp_tem) + 273.15 )  & 
    … …  
    137134                  zkph1 = zkph2 / 5. 
    138135                  ! pass the dfe concentration from PISCES 
    139                   ztfe = trn(ji,jj,jk,jpfer) * 1e9 
     136                  ztfe = trb(ji,jj,jk,jpfer) * 1e9 
    140137                  ! ---------------------------------------------------------- 
    141138                  ! ANALYTICAL SOLUTION OF ROOTS OF THE FE3+ EQUATION 
    … …  
    195192         ! Chemistry is supposed to be fast enough to be at equilibrium 
    196193         ! ------------------------------------------------------------ 
    197 !CDIR NOVERRCHK 
    198194         DO jk = 1, jpkm1 
    199 !CDIR NOVERRCHK 
    200195            DO jj = 1, jpj 
    201 !CDIR NOVERRCHK 
    202196               DO ji = 1, jpi 
    203197                  zTL1(ji,jj,jk) = ztotlig(ji,jj,jk) 
    204198                  zkeq           = fekeq(ji,jj,jk) 
    205199                  zfesatur       = zTL1(ji,jj,jk) * 1E-9 
    206                   ztfe           = trn(ji,jj,jk,jpfer)  
     200                  ztfe           = trb(ji,jj,jk,jpfer)  
    207201                  ! Fe' is the root of a 2nd order polynom 
    208202                  zFe3 (ji,jj,jk) = ( -( 1. + zfesatur * zkeq - zkeq * ztfe )               & 
    … …  
    210204                     &               + 4. * ztfe * zkeq) ) / ( 2. * zkeq ) 
    211205                  zFe3 (ji,jj,jk) = zFe3(ji,jj,jk) * 1E9 
    212                   zFeL1(ji,jj,jk) = MAX( 0., trn(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 
     206                  zFeL1(ji,jj,jk) = MAX( 0., trb(ji,jj,jk,jpfer) * 1E9 - zFe3(ji,jj,jk) ) 
    213207              END DO 
    214208            END DO 
    … …  
    216210         ! 
    217211      ENDIF 
    218  
     212      ! 
    219213      zdust = 0.         ! if no dust available 
    220 !CDIR NOVERRCHK 
     214      ! 
    221215      DO jk = 1, jpkm1 
    222 !CDIR NOVERRCHK 
    223216         DO jj = 1, jpj 
    224 !CDIR NOVERRCHK 
    225217            DO ji = 1, jpi 
    226218               zstep = xstep 
    … …  
    240232               ENDIF 
    241233#if defined key_kriest 
    242                ztrc   = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6  
     234               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    243235#else 
    244                ztrc   = ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi) ) * 1.e6  
     236               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    245237#endif 
    246238               IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s 
    … …  
    251243               ! to later allocate scavenged iron to the different organic pools 
    252244               ! --------------------------------------------------------- 
    253                zdenom1 = xlam1 * trn(ji,jj,jk,jppoc) / zlam1b 
     245               zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b 
    254246#if ! defined key_kriest 
    255                zdenom2 = xlam1 * trn(ji,jj,jk,jpgoc) / zlam1b 
     247               zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b 
    256248#endif 
    257249 
    … …  
    262254               zlamfac = MIN( 1.  , zlamfac ) 
    263255               zdep    = MIN( 1., 1000. / fsdept(ji,jj,jk) ) 
    264                zlam1b  = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 
    265                zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trn(ji,jj,jk,jpfer) 
     256               zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 
     257               zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer) 
    266258 
    267259               !  Compute the coagulation of colloidal iron. This parameterization  
    … …  
    269261               !  It requires certainly some more work as it is very poorly constrained. 
    270262               !  ---------------------------------------------------------------- 
    271                zlam1a  = ( 0.369  * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4  * trn(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    272                    &   + ( 114.   * 0.3 * trn(ji,jj,jk,jpdoc) + 5.09E3 * trn(ji,jj,jk,jppoc) ) 
     263               zlam1a  = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
     264                   &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) ) 
    273265               zaggdfea = zlam1a * zstep * zfecoll 
    274266#if defined key_kriest 
    … …  
    278270               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb 
    279271#else 
    280                zlam1b = 3.53E3 *   trn(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
     272               zlam1b = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    281273               zaggdfeb = zlam1b * zstep * zfecoll 
    282274               ! 
    … …  
    292284      !  ---------------------------------------- 
    293285      IF( ln_fechem ) THEN 
    294           biron(:,:,:) = MAX( 0., trn(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 
     286          biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 
    295287      ELSE 
    296           biron(:,:,:) = trn(:,:,:,jpfer)  
     288          biron(:,:,:) = trb(:,:,:,jpfer)  
    297289      ENDIF 
    298290 
    299291      !  Output of some diagnostics variables 
    300292      !     --------------------------------- 
    301       IF( lk_iomput .AND. jnt == nrdttrc ) THEN 
     293      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    302294         IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+ 
    303295         IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r5260 r5989  
    5959   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    6060 
    61    !!* Substitution 
    62 #  include "top_substitute.h90" 
     61   !! * Substitutions 
     62#  include "domzgr_substitute.h90" 
    6363   !!---------------------------------------------------------------------- 
    6464   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    6868CONTAINS 
    6969 
    70    SUBROUTINE p4z_flx ( kt ) 
     70   SUBROUTINE p4z_flx ( kt, knt ) 
    7171      !!--------------------------------------------------------------------- 
    7272      !!                     ***  ROUTINE p4z_flx  *** 
    … …  
    8181      !!--------------------------------------------------------------------- 
    8282      ! 
    83       INTEGER, INTENT(in) ::   kt   ! 
     83      INTEGER, INTENT(in) ::   kt, knt   ! 
    8484      ! 
    8585      INTEGER  ::   ji, jj, jm, iind, iindm1 
    … …  
    101101      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    102102 
    103       IF( kt /= nit000 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
     103      IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
    104104 
    105105      IF( ln_co2int ) THEN  
    … …  
    122122 
    123123      DO jm = 1, 10 
    124 !CDIR NOVERRCHK 
    125124         DO jj = 1, jpj 
    126 !CDIR NOVERRCHK 
    127125            DO ji = 1, jpi 
    128126 
    … …  
    130128               zbot  = borat(ji,jj,1) 
    131129               zfact = rhop(ji,jj,1) / 1000. + rtrn 
    132                zdic  = trn(ji,jj,1,jpdic) / zfact 
     130               zdic  = trb(ji,jj,1,jpdic) / zfact 
    133131               zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
    134                zalka = trn(ji,jj,1,jptal) / zfact 
     132               zalka = trb(ji,jj,1,jptal) / zfact 
    135133 
    136134               ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    … …  
    155153      ! ------------------------------------------- 
    156154 
    157 !CDIR NOVERRCHK 
    158155      DO jj = 1, jpj 
    159 !CDIR NOVERRCHK 
    160156         DO ji = 1, jpi 
    161157            ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) ) 
    … …  
    184180            zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s) 
    185181            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
    186             oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
     182            oce_co2(ji,jj) = ( zfld - zflu ) * rfact2 * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    187183            ! compute the trend 
    188             tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 
     184            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) * rfact2 / fse3t(ji,jj,1) 
    189185 
    190186            ! Compute O2 flux  
    191187            zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
    192             zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 
     188            zflu16 = trb(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 
    193189            zoflx(ji,jj) = zfld16 - zflu16 
    194             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1) 
     190            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) * rfact2 / fse3t(ji,jj,1) 
    195191         END DO 
    196192      END DO 
    … …  
    207203      ENDIF 
    208204 
    209       IF( lk_iomput ) THEN 
     205      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    210206         CALL wrk_alloc( jpi, jpj, zw2d )   
    211207         IF( iom_use( "Cflx"  ) )  THEN 
    212             zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) / rfact 
     208            zw2d(:,:) = oce_co2(:,:) / e1e2t(:,:) * rfact2r 
    213209            CALL iom_put( "Cflx"     , zw2d )  
    214210         ENDIF 
    … …  
    226222         ENDIF 
    227223         IF( iom_use( "Dpo2" ) )  THEN 
    228            zw2d(:,:) = ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1) 
     224           zw2d(:,:) = ( atcox * patm(:,:) - trb(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1) 
    229225           CALL iom_put( "Dpo2"  , zw2d ) 
    230226         ENDIF 
    … …  
    235231      ELSE 
    236232         IF( ln_diatrc ) THEN 
    237             trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) / rfact  
     233            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r  
    238234            trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1)  
    239235            trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1)  
    … …  
    400396 
    401397   !!====================================================================== 
    402 END MODULE  p4zflx 
     398END MODULE p4zflx 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90

    r5260 r5989  
    5656      DO ji = 1, jpi 
    5757         DO jj = 1, jpj 
    58             zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 
     58            zvar = trb(ji,jj,1,jpsil) * trb(ji,jj,1,jpsil) 
    5959            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
    6060         END DO 
    … …  
    8181 
    8282   !!====================================================================== 
    83 END MODULE  p4zint 
     83END MODULE p4zint 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

    r5260 r5989  
    5252   REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 
    5353   REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5  
    54    !!* Substitution 
    55 #  include "top_substitute.h90" 
     54 
    5655   !!---------------------------------------------------------------------- 
    5756   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    6261CONTAINS 
    6362 
    64    SUBROUTINE p4z_lim( kt, jnt ) 
     63   SUBROUTINE p4z_lim( kt, knt ) 
    6564      !!--------------------------------------------------------------------- 
    6665      !!                     ***  ROUTINE p4z_lim  *** 
    … …  
    7271      !!--------------------------------------------------------------------- 
    7372      ! 
    74       INTEGER, INTENT(in)  :: kt, jnt 
     73      INTEGER, INTENT(in)  :: kt, knt 
    7574      ! 
    7675      INTEGER  ::   ji, jj, jk 
    7776      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim 
    7877      REAL(wp) ::   zconcd, zconcd2, zconcn, zconcn2 
    79       REAL(wp) ::   z1_trndia, z1_trnphy, ztem1, ztem2, zetot1, zetot2 
     78      REAL(wp) ::   z1_trbdia, z1_trbphy, ztem1, ztem2, zetot1, zetot2 
    8079      REAL(wp) ::   zdenom, zratio, zironmin 
    8180      REAL(wp) ::   zconc1d, zconc1dnh4, zconc0n, zconc0nnh4    
    … …  
    9089               ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
    9190               !------------------------------------- 
    92                zno3    = trn(ji,jj,jk,jpno3) / 40.e-6 
     91               zno3    = trb(ji,jj,jk,jpno3) / 40.e-6 
    9392               zferlim = MAX( 3e-11 * zno3 * zno3, 5e-12 ) 
    9493               zferlim = MIN( zferlim, 7e-11 ) 
    95                trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim ) 
     94               trb(ji,jj,jk,jpfer) = MAX( trb(ji,jj,jk,jpfer), zferlim ) 
    9695 
    9796               ! Computation of a variable Ks for iron on diatoms taking into account 
    9897               ! that increasing biomass is made of generally bigger cells 
    9998               !------------------------------------------------ 
    100                zconcd   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 
    101                zconcd2  = trn(ji,jj,jk,jpdia) - zconcd 
    102                zconcn   = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy ) 
    103                zconcn2  = trn(ji,jj,jk,jpphy) - zconcn 
    104                z1_trnphy   = 1. / ( trn(ji,jj,jk,jpphy) + rtrn ) 
    105                z1_trndia   = 1. / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    106  
    107                concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trndia ) 
    108                zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trndia ) 
    109                zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trndia ) 
    110  
    111                concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trnphy ) 
    112                zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trnphy ) 
    113                zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trnphy ) 
     99               zconcd   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
     100               zconcd2  = trb(ji,jj,jk,jpdia) - zconcd 
     101               zconcn   = MAX( 0.e0 , trb(ji,jj,jk,jpphy) - xsizephy ) 
     102               zconcn2  = trb(ji,jj,jk,jpphy) - zconcn 
     103               z1_trbphy   = 1. / ( trb(ji,jj,jk,jpphy) + rtrn ) 
     104               z1_trbdia   = 1. / ( trb(ji,jj,jk,jpdia) + rtrn ) 
     105 
     106               concdfe(ji,jj,jk) = MAX( concdfer, ( zconcd2 * concdfer + concdfer * xsizerd * zconcd ) * z1_trbdia ) 
     107               zconc1d           = MAX( concdno3, ( zconcd2 * concdno3 + concdno3 * xsizerd * zconcd ) * z1_trbdia ) 
     108               zconc1dnh4        = MAX( concdnh4, ( zconcd2 * concdnh4 + concdnh4 * xsizerd * zconcd ) * z1_trbdia ) 
     109 
     110               concnfe(ji,jj,jk) = MAX( concnfer, ( zconcn2 * concnfer + concnfer * xsizern * zconcn ) * z1_trbphy ) 
     111               zconc0n           = MAX( concnno3, ( zconcn2 * concnno3 + concnno3 * xsizern * zconcn ) * z1_trbphy ) 
     112               zconc0nnh4        = MAX( concnnh4, ( zconcn2 * concnnh4 + concnnh4 * xsizern * zconcn ) * z1_trbphy ) 
    114113 
    115114               ! Michaelis-Menten Limitation term for nutrients Small bacteria 
    116115               ! ------------------------------------------------------------- 
    117                zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trn(ji,jj,jk,jpno3) + concbno3 * trn(ji,jj,jk,jpnh4) ) 
    118                xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concbnh4 * zdenom 
    119                xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * concbno3 * zdenom 
     116               zdenom = 1. /  ( concbno3 * concbnh4 + concbnh4 * trb(ji,jj,jk,jpno3) + concbno3 * trb(ji,jj,jk,jpnh4) ) 
     117               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * concbnh4 * zdenom 
     118               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * concbno3 * zdenom 
    120119               ! 
    121120               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    122                zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concbnh4 ) 
    123                zlim3    = trn(ji,jj,jk,jpfer) / ( concbfe + trn(ji,jj,jk,jpfer) ) 
    124                zlim4    = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) ) 
     121               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concbnh4 ) 
     122               zlim3    = trb(ji,jj,jk,jpfer) / ( concbfe + trb(ji,jj,jk,jpfer) ) 
     123               zlim4    = trb(ji,jj,jk,jpdoc) / ( xkdoc   + trb(ji,jj,jk,jpdoc) ) 
    125124               xlimbacl(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    126125               xlimbac (ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
    … …  
    128127               ! Michaelis-Menten Limitation term for nutrients Small flagellates 
    129128               ! ----------------------------------------------- 
    130                zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) ) 
    131                xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 
    132                xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n    * zdenom 
     129               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trb(ji,jj,jk,jpno3) + zconc0n * trb(ji,jj,jk,jpnh4) ) 
     130               xnanono3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 
     131               xnanonh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc0n    * zdenom 
    133132               ! 
    134133               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    135                zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 ) 
    136                zratio   = trn(ji,jj,jk,jpnfe) * z1_trnphy  
    137                zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
     134               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc0nnh4 ) 
     135               zratio   = trb(ji,jj,jk,jpnfe) * z1_trbphy  
     136               zironmin = xcoef1 * trb(ji,jj,jk,jpnch) * z1_trbphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
    138137               zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
    139138               xnanopo4(ji,jj,jk) = zlim2 
    … …  
    143142               !   Michaelis-Menten Limitation term for nutrients Diatoms 
    144143               !   ---------------------------------------------- 
    145                zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) ) 
    146                xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 
    147                xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d    * zdenom 
     144               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trb(ji,jj,jk,jpno3) + zconc1d * trb(ji,jj,jk,jpnh4) ) 
     145               xdiatno3(ji,jj,jk) = trb(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 
     146               xdiatnh4(ji,jj,jk) = trb(ji,jj,jk,jpnh4) * zconc1d    * zdenom 
    148147               ! 
    149148               zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    150                zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4  ) 
    151                zlim3    = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
    152                zratio   = trn(ji,jj,jk,jpdfe) * z1_trndia 
    153                zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
     149               zlim2    = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + zconc1dnh4  ) 
     150               zlim3    = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
     151               zratio   = trb(ji,jj,jk,jpdfe) * z1_trbdia 
     152               zironmin = xcoef1 * trb(ji,jj,jk,jpdch) * z1_trbdia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
    154153               zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
    155154               xdiatpo4(ji,jj,jk) = zlim2 
    … …  
    166165         DO jj = 1, jpj 
    167166            DO ji = 1, jpi 
    168                zlim1 =  ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * concnno3 )    & 
    169                   &   / ( concnno3 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + concnno3 * trn(ji,jj,jk,jpnh4) )  
    170                zlim2  = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 ) 
    171                zlim3  = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) +  5.E-11   ) 
     167               zlim1 =  ( trb(ji,jj,jk,jpno3) * concnnh4 + trb(ji,jj,jk,jpnh4) * concnno3 )    & 
     168                  &   / ( concnno3 * concnnh4 + concnnh4 * trb(ji,jj,jk,jpno3) + concnno3 * trb(ji,jj,jk,jpnh4) )  
     169               zlim2  = trb(ji,jj,jk,jppo4) / ( trb(ji,jj,jk,jppo4) + concnnh4 ) 
     170               zlim3  = trb(ji,jj,jk,jpfer) / ( trb(ji,jj,jk,jpfer) +  5.E-11   ) 
    172171               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    173172               ztem2  = tsn(ji,jj,jk,jp_tem) - 10. 
    174                zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) )  
    175                zetot2 = 30. / ( 30. + etot(ji,jj,jk) )  
     173               zetot1 = MAX( 0., etot_ndcy(ji,jj,jk) - 1.) / ( 4. + etot_ndcy(ji,jj,jk) )  
     174               zetot2 = 30. / ( 30. + etot_ndcy(ji,jj,jk) )  
    176175 
    177176               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
    178177                  &                       * ztem1 / ( 0.1 + ztem1 )                     & 
    179                   &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. )  & 
     178                  &                       * MAX( 1., trb(ji,jj,jk,jpphy) * 1.e6 / 2. )  & 
    180179                  &                       * zetot1 * zetot2               & 
    181180                  &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
    … …  
    188187      ! 
    189188      ! 
    190       IF( lk_iomput .AND. jnt == nrdttrc ) THEN        ! save output diagnostics 
     189      IF( lk_iomput .AND. knt == nrdttrc ) THEN        ! save output diagnostics 
    191190        IF( iom_use( "xfracal" ) ) CALL iom_put( "xfracal", xfracal(:,:,:) * tmask(:,:,:) )  ! euphotic layer deptht 
    192191        IF( iom_use( "LNnut"   ) ) CALL iom_put( "LNnut"  , xlimphy(:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term 
    … …  
    265264 
    266265   !!====================================================================== 
    267 END MODULE  p4zlim 
     266END MODULE p4zlim 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

    r5260 r5989  
    4848CONTAINS 
    4949 
    50    SUBROUTINE p4z_lys( kt ) 
     50   SUBROUTINE p4z_lys( kt, knt ) 
    5151      !!--------------------------------------------------------------------- 
    5252      !!                     ***  ROUTINE p4z_lys  *** 
    … …  
    5959      !!--------------------------------------------------------------------- 
    6060      ! 
    61       INTEGER, INTENT(in) ::   kt ! ocean time step 
     61      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    6262      INTEGER  ::   ji, jj, jk, jn 
    6363      REAL(wp) ::   zalk, zdic, zph, zah2 
    6464      REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi 
    6565      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    66       REAL(wp) ::   zrfact2 
    6766      CHARACTER (len=25) :: charout 
    6867      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss    
    … …  
    8180      DO jn = 1, 5                               !  BEGIN OF ITERATION 
    8281         ! 
    83 !CDIR NOVERRCHK 
    8482         DO jk = 1, jpkm1 
    85 !CDIR NOVERRCHK 
    8683            DO jj = 1, jpj 
    87 !CDIR NOVERRCHK 
    8884               DO ji = 1, jpi 
    8985                  zfact = rhop(ji,jj,jk) / 1000. + rtrn 
    9086                  zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 
    91                   zdic  = trn(ji,jj,jk,jpdic) / zfact 
    92                   zalka = trn(ji,jj,jk,jptal) / zfact 
     87                  zdic  = trb(ji,jj,jk,jpdic) / zfact 
     88                  zalka = trb(ji,jj,jk,jptal) / zfact 
    9389                  ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    9490                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 
    … …  
    130126               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    131127               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    132                zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 
     128               zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 
    133129# if defined key_degrad 
    134130               zdispot = zdispot * facvol(ji,jj,jk) 
    … …  
    136132              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    137133              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    138               zcaldiss(ji,jj,jk)  = zdispot / rmtss ! calcite dissolution 
    139               zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact 
     134              zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution 
     135              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) 
    140136              ! 
    141137              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
    … …  
    147143      ! 
    148144 
    149       IF( lk_iomput ) THEN 
     145      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    150146         IF( iom_use( "PH"     ) ) CALL iom_put( "PH"    , -1. * LOG10( hi(:,:,:) )          * tmask(:,:,:) ) 
    151147         IF( iom_use( "CO3"    ) ) CALL iom_put( "CO3"   , zco3(:,:,:) * 1.e+3               * tmask(:,:,:) ) 
    152148         IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", aksp(:,:,:) * 1.e+3 / calcon      * tmask(:,:,:) ) 
    153          IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 
     149         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r   * tmask(:,:,:) ) 
    154150      ELSE 
    155151         trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 
    … …  
    224220#endif  
    225221   !!====================================================================== 
    226 END MODULE  p4zlys 
     222END MODULE p4zlys 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r5260 r5989  
    5050   REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate 
    5151 
    52    !!* Substitution 
    53 #  include "top_substitute.h90" 
    5452   !!---------------------------------------------------------------------- 
    5553   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    6058CONTAINS 
    6159 
    62    SUBROUTINE p4z_meso( kt, jnt ) 
     60   SUBROUTINE p4z_meso( kt, knt ) 
    6361      !!--------------------------------------------------------------------- 
    6462      !!                     ***  ROUTINE p4z_meso  *** 
    … …  
    6866      !! ** Method  : - ??? 
    6967      !!--------------------------------------------------------------------- 
    70       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     68      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    7169      INTEGER  :: ji, jj, jk 
    7270      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
    … …  
    9795         DO jj = 1, jpj 
    9896            DO ji = 1, jpi 
    99                zcompam   = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
     97               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    10098# if defined key_degrad 
    10199               zstep     = xstep * facvol(ji,jj,jk) 
    … …  
    107105               !  Respiration rates of both zooplankton 
    108106               !  ------------------------------------- 
    109                zrespz2   = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) )  & 
     107               zrespz2   = resrat2 * zfact * trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  & 
    110108                  &      + resrat2 * zfact * 3. * nitrfac(ji,jj,jk) 
    111109 
    … …  
    113111               !  no real reason except that it seems to be more stable and may mimic predation 
    114112               !  --------------------------------------------------------------- 
    115                ztortz2   = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
     113               ztortz2   = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes) 
    116114               ! 
    117                zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
    118                zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
     115               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
     116               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
    119117               ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone 
    120118               ! it is to predation by mesozooplankton 
    121119               ! ------------------------------------------------------------------------------- 
    122                zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) & 
     120               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) & 
    123121                  &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) ) 
    124                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
     122               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
    125123 
    126124               zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc  
    … …  
    128126               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    129127               zdenom2   = zdenom / ( zfood + rtrn ) 
    130                zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes)  
     128               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes)  
    131129 
    132130               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2  
    … …  
    135133               zgrazpoc  = zgraze2  * xprefpoc * zcompapoc * zdenom2  
    136134 
    137                zgraznf   = zgrazn   * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn) 
    138                zgrazf    = zgrazd   * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn) 
    139                zgrazpof  = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn) 
     135               zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn) 
     136               zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn) 
     137               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn) 
    140138 
    141139               !  Mesozooplankton flux feeding on GOC 
    … …  
    144142# if ! defined key_kriest 
    145143               zgrazffeg = grazflux  * zstep * wsbio4(ji,jj,jk)      & 
    146                &           * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    147                zgrazfffg = zgrazffeg * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
     144               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) 
     145               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    148146# endif 
    149147               zgrazffep = grazflux  * zstep *  wsbio3(ji,jj,jk)     & 
    150                &           * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    151                zgrazfffp = zgrazffep * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     148               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) 
     149               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    152150              ! 
    153151# if ! defined key_kriest 
    … …  
    158156              ! diatoms based aggregates are more prone to fractionation 
    159157              ! since they are more porous (marine snow instead of fecal pellets) 
    160               zratio    = trn(ji,jj,jk,jpgsi) / ( trn(ji,jj,jk,jpgoc) + rtrn ) 
     158              zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    161159              zratio2   = zratio * zratio 
    162160              zfrac     = zproport * grazflux  * zstep * wsbio4(ji,jj,jk)      & 
    163                &          * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)          & 
     161               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
    164162               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    165               zfracfe   = zfrac * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
     163              zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    166164 
    167165              zgrazffep = zproport * zgrazffep 
    … …  
    215213               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    216214               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 
    217                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trn(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn ) 
    218                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    219                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    220                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     215               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
     216               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
     217               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
     218               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    221219               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
    222220               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    … …  
    231229               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    232230#if defined key_kriest 
    233               znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
     231              znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    234232              tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2 
    235233              tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso      & 
    … …  
    248246      END DO 
    249247      ! 
    250       IF( lk_iomput .AND. jnt == nrdttrc ) THEN 
     248      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    251249         CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    252250         IF( iom_use( "GRAZ2" ) ) THEN 
    … …  
    340338 
    341339   !!====================================================================== 
    342 END MODULE  p4zmeso 
     340END MODULE p4zmeso 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r5260 r5989  
    4949 
    5050 
    51    !!* Substitution 
    52 #  include "top_substitute.h90" 
    5351   !!---------------------------------------------------------------------- 
    5452   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    5957CONTAINS 
    6058 
    61    SUBROUTINE p4z_micro( kt, jnt ) 
     59   SUBROUTINE p4z_micro( kt, knt ) 
    6260      !!--------------------------------------------------------------------- 
    6361      !!                     ***  ROUTINE p4z_micro  *** 
    … …  
    6866      !!--------------------------------------------------------------------- 
    6967      INTEGER, INTENT(in) ::  kt  ! ocean time step 
    70       INTEGER, INTENT(in) ::  jnt  
     68      INTEGER, INTENT(in) ::  knt  
    7169      ! 
    7270      INTEGER  :: ji, jj, jk 
    … …  
    9088         DO jj = 1, jpj 
    9189            DO ji = 1, jpi 
    92                zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
     90               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    9391               zstep   = xstep 
    9492# if defined key_degrad 
    … …  
    9997               !  Respiration rates of both zooplankton 
    10098               !  ------------------------------------- 
    101                zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) )  & 
     99               zrespz = resrat * zfact * trb(ji,jj,jk,jpzoo) / ( xkmort + trb(ji,jj,jk,jpzoo) )  & 
    102100                  &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    103101 
    … …  
    105103               !  no real reason except that it seems to be more stable and may mimic predation. 
    106104               !  --------------------------------------------------------------- 
    107                ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
    108  
    109                zcompadi  = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
    110                zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
    111                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
     105               ztortz = mzrat * 1.e6 * zfact * trb(ji,jj,jk,jpzoo) 
     106 
     107               zcompadi  = MIN( MAX( ( trb(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
     108               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
     109               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    112110                
    113111               !     Microzooplankton grazing 
    … …  
    117115               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    118116               zdenom2   = zdenom / ( zfood + rtrn ) 
    119                zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo)  
     117               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo)  
    120118 
    121119               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2  
    … …  
    123121               zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2  
    124122 
    125                zgrazpf   = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    126                zgrazmf   = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    127                zgrazsf   = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     123               zgrazpf   = zgrazp  * trb(ji,jj,jk,jpnfe) / (trb(ji,jj,jk,jpphy) + rtrn) 
     124               zgrazmf   = zgrazm  * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
     125               zgrazsf   = zgrazsd * trb(ji,jj,jk,jpdfe) / (trb(ji,jj,jk,jpdia) + rtrn) 
    128126               ! 
    129127               zgraztot  = zgrazp  + zgrazm  + zgrazsd  
    … …  
    165163               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
    166164               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
    167                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 
    168                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 
    169                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
    170                tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
     165               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
     166               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trb(ji,jj,jk,jpdch)/(trb(ji,jj,jk,jpdia)+rtrn) 
     167               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
     168               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trb(ji,jj,jk,jpdsi)/(trb(ji,jj,jk,jpdia)+rtrn) 
    171169               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 
    172170               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    … …  
    184182#if defined key_kriest 
    185183               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro & 
    186                                                          - zgrazm * trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
     184                                                         - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    187185#endif 
    188186            END DO 
    … …  
    190188      END DO 
    191189      ! 
    192       IF( lk_iomput .AND. jnt == nrdttrc ) THEN 
     190      IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    193191         CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    194192         IF( iom_use( "GRAZ1" ) ) THEN 
    … …  
    273271 
    274272   !!====================================================================== 
    275 END MODULE  p4zmicro 
     273END MODULE p4zmicro 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    r5260 r5989  
    3535 
    3636 
    37    !!* Substitution 
    38 #  include "top_substitute.h90" 
    3937   !!---------------------------------------------------------------------- 
    4038   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    8583         DO jj = 1, jpj 
    8684            DO ji = 1, jpi 
    87                zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
     85               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    8886               zstep    = xstep 
    8987# if defined key_degrad 
    … …  
    9492               !     due to turbulence is negligible. Mortality is also set 
    9593               !     to 0 
    96                zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trn(ji,jj,jk,jpphy) 
     94               zsizerat = MIN(1., MAX( 0., (quotan(ji,jj,jk) - 0.2) / 0.3) ) * trb(ji,jj,jk,jpphy) 
    9795               !     Squared mortality of Phyto similar to a sedimentation term during 
    9896               !     blooms (Doney et al. 1996) 
    … …  
    102100               !     increased when nutrients are limiting phytoplankton growth 
    103101               !     as observed for instance in case of iron limitation. 
    104                ztortp = mprat * xstep * zcompaph / ( xkmort + trn(ji,jj,jk,jpphy) ) * zsizerat 
     102               ztortp = mprat * xstep * zcompaph / ( xkmort + trb(ji,jj,jk,jpphy) ) * zsizerat 
    105103 
    106104               zmortp = zrespp + ztortp 
    … …  
    108106               !   Update the arrays TRA which contains the biological sources and sinks 
    109107 
    110                zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn) 
    111                zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 
     108               zfactfe = trb(ji,jj,jk,jpnfe)/(trb(ji,jj,jk,jpphy)+rtrn) 
     109               zfactch = trb(ji,jj,jk,jpnch)/(trb(ji,jj,jk,jpphy)+rtrn) 
    112110               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zmortp 
    113111               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zmortp * zfactch 
    … …  
    172170            DO ji = 1, jpi 
    173171 
    174                zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-9), 0. ) 
     172               zcompadi = MAX( ( trb(ji,jj,jk,jpdia) - 1e-9), 0. ) 
    175173 
    176174               !    Aggregation term for diatoms is increased in case of nutrient 
    … …  
    186184               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    187185               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    188                zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 
     186               zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
    189187 
    190188               !     Phytoplankton mortality.  
    191189               !     ------------------------ 
    192                ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi  
     190               ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi  
    193191 
    194192               zmortp2 = zrespp2 + ztortp2 
    … …  
    196194               !   Update the arrays tra which contains the biological sources and sinks 
    197195               !   --------------------------------------------------------------------- 
    198                zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    199                zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    200                zfactsi = trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     196               zfactch = trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
     197               zfactfe = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
     198               zfactsi = trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    201199               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zmortp2  
    202200               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zmortp2 * zfactch 
    … …  
    277275 
    278276   !!====================================================================== 
    279 END MODULE  p4zmort 
     277END MODULE p4zmort 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r5260 r5989  
    3535   REAL(wp) :: parlux      !: Fraction of shortwave as PAR 
    3636   REAL(wp) :: xparsw                 !: parlux/3 
     37   REAL(wp) :: xsi0r                 !:  1. /rn_si0 
    3738 
    3839   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_par      ! structure of input par 
    … …  
    4243 
    4344   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for phyto, nano and diat  
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy      !: PAR over 24h in case of diurnal cycle 
    4446   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy           !: averaged PAR in the mixed layer 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue) 
    4548 
    4649   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    … …  
    4851   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
    4952    
    50    !!* Substitution 
    51 #  include "top_substitute.h90" 
     53   !! * Substitutions 
     54#  include "domzgr_substitute.h90" 
    5255   !!---------------------------------------------------------------------- 
    5356   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    5760CONTAINS 
    5861 
    59    SUBROUTINE p4z_opt( kt, jnt ) 
     62   SUBROUTINE p4z_opt( kt, knt ) 
    6063      !!--------------------------------------------------------------------- 
    6164      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    6770      !!--------------------------------------------------------------------- 
    6871      ! 
    69       INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step 
     72      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
    7073      ! 
    7174      INTEGER  ::   ji, jj, jk 
    7275      INTEGER  ::   irgb 
    73       REAL(wp) ::   zchl, zxsi0r 
     76      REAL(wp) ::   zchl 
    7477      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
    75       REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp, zetmp1, zetmp2 
    76       REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3 
     78      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4, zqsr100 
     79      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 
    7780      !!--------------------------------------------------------------------- 
    7881      ! 
    … …  
    8083      ! 
    8184      ! Allocate temporary workspace 
    82       CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 )  
    83       CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 
    84  
    85       IF( jnt == 1 .AND. ln_varpar ) CALL p4z_optsbc( kt ) 
     85      CALL wrk_alloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     86      CALL wrk_alloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 
     87 
     88      IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 
    8689 
    8790      !     Initialisation of variables used to compute PAR 
    8891      !     ----------------------------------------------- 
    89       ze1(:,:,jpk) = 0._wp 
    90       ze2(:,:,jpk) = 0._wp 
    91       ze3(:,:,jpk) = 0._wp 
    92  
     92      ze1(:,:,:) = 0._wp 
     93      ze2(:,:,:) = 0._wp 
     94      ze3(:,:,:) = 0._wp 
    9395      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    9496      DO jk = 1, jpkm1                         !  -------------------------------------------------------- 
    95 !CDIR NOVERRCHK 
    9697         DO jj = 1, jpj 
    97 !CDIR NOVERRCHK 
    9898            DO ji = 1, jpi 
    99                zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
     99               zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
    100100               zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    101101               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    102102               !                                                          
    103                zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk) 
    104                zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk) 
    105                zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk) 
     103               ekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk) 
     104               ekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk) 
     105               ekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk) 
    106106            END DO 
    107107         END DO 
    108108      END DO 
    109  
    110  
    111109      !                                        !* Photosynthetically Available Radiation (PAR) 
    112110      !                                        !  -------------------------------------- 
    113  
    114       IF( ln_varpar ) THEN 
    115          ze1(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) ) 
    116          ze2(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) ) 
    117          ze3(:,:,1) = par_varsw(:,:) * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) ) 
     111      IF( l_trcdm2dc ) THEN                     !  diurnal cycle 
     112         ! 1% of qsr to compute euphotic layer 
     113         zqsr100(:,:) = 0.01 * qsr_mean(:,:)     !  daily mean qsr 
     114         ! 
     115         CALL p4z_opt_par( kt, qsr_mean, ze1, ze2, ze3 )  
     116         ! 
     117         DO jk = 1, nksrp       
     118            etot_ndcy(:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
     119            enano    (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
     120            ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 
     121         END DO 
     122         ! 
     123         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 )  
     124         ! 
     125         DO jk = 1, nksrp       
     126            etot(:,:,jk) =  ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) 
     127         END DO 
     128         ! 
    118129      ELSE 
    119          ze1(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekb(:,:,1) ) 
    120          ze2(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekg(:,:,1) ) 
    121          ze3(:,:,1) = xparsw         * qsr(:,:) * EXP( -0.5 * zekr(:,:,1) ) 
    122       ENDIF 
    123  
    124 !CDIR NOVERRCHK 
    125       DO jj = 1, jpj 
    126 !CDIR NOVERRCHK 
    127          DO ji = 1, jpi 
    128             zc1 = ze1(ji,jj,1) 
    129             zc2 = ze2(ji,jj,1)  
    130             zc3 = ze3(ji,jj,1) 
    131             etot (ji,jj,1) = (       zc1 +        zc2 +       zc3 ) 
    132             enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 
    133             ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 
    134          END DO 
    135       END DO 
    136  
    137      
    138       DO jk = 2, nksrp       
    139 !CDIR NOVERRCHK 
    140          DO jj = 1, jpj 
    141 !CDIR NOVERRCHK 
    142             DO ji = 1, jpi 
    143                zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) ) 
    144                zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) ) 
    145                zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) ) 
    146                ze1  (ji,jj,jk) = zc1 
    147                ze2  (ji,jj,jk) = zc2 
    148                ze3  (ji,jj,jk) = zc3 
    149                etot (ji,jj,jk) = (       zc1 +        zc2 +       zc3 ) 
    150                enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 ) 
    151                ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 ) 
    152             END DO 
    153          END DO 
    154       END DO 
     130         ! 1% of qsr to compute euphotic layer 
     131         zqsr100(:,:) = 0.01 * qsr(:,:) 
     132         ! 
     133         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3 )  
     134         ! 
     135         DO jk = 1, nksrp       
     136            etot (:,:,jk) =        ze1(:,:,jk) +        ze2(:,:,jk) +       ze3(:,:,jk) 
     137            enano(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
     138            ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 
     139         END DO 
     140         etot_ndcy(:,:,:) =  etot(:,:,:)  
     141      ENDIF 
     142 
    155143 
    156144      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics) 
    157145         !                                     !  ------------------------ 
    158          zxsi0r = 1.e0 / rn_si0 
    159          ! 
    160          ze0(:,:,1) = rn_abs * qsr(:,:) 
    161          !                                                    ! surface value : separation in R-G-B + near surface 
    162          IF( ln_varpar ) THEN 
    163             ze0(:,:,1) = ( 1. - 3. * par_varsw(:,:) ) * qsr(:,:) 
    164             ze1(:,:,1) = par_varsw(:,:)               * qsr(:,:)          
    165             ze2(:,:,1) = par_varsw(:,:)               * qsr(:,:) 
    166             ze3(:,:,1) = par_varsw(:,:)               * qsr(:,:) 
    167          ELSE 
    168             ze0(:,:,1) = ( 1. - 3. * xparsw )  * qsr(:,:) 
    169             ze1(:,:,1) = xparsw                * qsr(:,:)          
    170             ze2(:,:,1) = xparsw                * qsr(:,:) 
    171             ze3(:,:,1) = xparsw                * qsr(:,:) 
    172          ENDIF 
     146         CALL p4z_opt_par( kt, qsr, ze1, ze2, ze3, pe0=ze0 ) 
     147         ! 
    173148         etot3(:,:,1) =  qsr(:,:) * tmask(:,:,1) 
    174          ! 
    175          ! 
    176149         DO jk = 2, nksrp + 1 
    177 !CDIR NOVERRCHK 
    178             DO jj = 1, jpj 
    179 !CDIR NOVERRCHK 
    180                DO ji = 1, jpi 
    181                   zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r ) 
    182                   zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) ) 
    183                   zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) ) 
    184                   zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) ) 
    185                   ze0(ji,jj,jk) = zc0 
    186                   ze1(ji,jj,jk) = zc1 
    187                   ze2(ji,jj,jk) = zc2 
    188                   ze3(ji,jj,jk) = zc3 
    189                   etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk) 
    190               END DO 
    191               ! 
    192             END DO 
    193             ! 
    194         END DO 
    195         ! 
    196       ENDIF 
    197  
     150            etot3(:,:,jk) =  ( ze0(:,:,jk) + ze1(:,:,jk) + ze2(:,:,jk) + ze3(:,:,jk) ) * tmask(:,:,jk) 
     151         END DO 
     152         !                                     !  ------------------------ 
     153      ENDIF 
    198154      !                                        !* Euphotic depth and level 
    199155      neln(:,:) = 1                            !  ------------------------ 
    … …  
    203159         DO jj = 1, jpj 
    204160           DO ji = 1, jpi 
    205               IF( etot(ji,jj,jk) * tmask(ji,jj,jk) >= 0.0043 * qsr(ji,jj) )  THEN 
     161              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.43 * zqsr100(ji,jj) )  THEN 
    206162                 neln(ji,jj) = jk+1                    ! Euphotic level : 1rst T-level strictly below Euphotic layer 
    207                  !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mxl_trc_zint 
     163                 !                                     ! nb: ensure the compatibility with nmld_trc definition in trd_mld_trc_zint 
    208164                 heup(ji,jj) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth 
    209165              ENDIF 
    … …  
    211167        END DO 
    212168      END DO 
    213   
     169      ! 
    214170      heup(:,:) = MIN( 300., heup(:,:) ) 
    215  
    216171      !                                        !* mean light over the mixed layer 
    217172      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    218       zetmp  (:,:)   = 0.e0 
    219173      zetmp1 (:,:)   = 0.e0 
    220174      zetmp2 (:,:)   = 0.e0 
     175      zetmp3 (:,:)   = 0.e0 
     176      zetmp4 (:,:)   = 0.e0 
    221177 
    222178      DO jk = 1, nksrp 
    223 !CDIR NOVERRCHK 
    224179         DO jj = 1, jpj 
    225 !CDIR NOVERRCHK 
    226180            DO ji = 1, jpi 
    227181               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    228                   zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 
    229                   zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 
    230                   zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 
     182                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + etot     (ji,jj,jk) * fse3t(ji,jj,jk) ! remineralisation 
     183                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + etot_ndcy(ji,jj,jk) * fse3t(ji,jj,jk) ! production 
     184                  zetmp3 (ji,jj) = zetmp3 (ji,jj) + enano    (ji,jj,jk) * fse3t(ji,jj,jk) ! production 
     185                  zetmp4 (ji,jj) = zetmp4 (ji,jj) + ediat    (ji,jj,jk) * fse3t(ji,jj,jk) ! production 
    231186                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 
    232187               ENDIF 
    … …  
    235190      END DO 
    236191      ! 
    237       emoy(:,:,:) = etot(:,:,:) 
     192      emoy(:,:,:) = etot(:,:,:)       ! remineralisation 
     193      zpar(:,:,:) = etot_ndcy(:,:,:)  ! diagnostic : PAR with no diurnal cycle  
    238194      ! 
    239195      DO jk = 1, nksrp 
    240 !CDIR NOVERRCHK 
    241196         DO jj = 1, jpj 
    242 !CDIR NOVERRCHK 
    243197            DO ji = 1, jpi 
    244198               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    245199                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
    246                   emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 
    247                   enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
    248                   ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     200                  emoy (ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     201                  zpar (ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     202                  enano(ji,jj,jk) = zetmp3(ji,jj) * z1_dep 
     203                  ediat(ji,jj,jk) = zetmp4(ji,jj) * z1_dep 
    249204               ENDIF 
    250205            END DO 
    251206         END DO 
    252207      END DO 
    253  
     208      ! 
    254209      IF( lk_iomput ) THEN 
    255         IF( jnt == nrdttrc  ) THEN 
    256            IF( iom_use( "Heup" ) ) CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
    257            IF( iom_use( "PAR"  ) ) CALL iom_put( "PAR" , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     210        IF( knt == nrdttrc ) THEN 
     211           IF( iom_use( "Heup"  ) ) CALL iom_put( "Heup" , heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
     212           IF( iom_use( "PARDM" ) ) CALL iom_put( "PARDM", zpar(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     213           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
    258214        ENDIF 
    259215      ELSE 
    260216         IF( ln_diatrc ) THEN        ! save output diagnostics 
    261             trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
     217            trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1) 
    262218            trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
    263219         ENDIF 
    264220      ENDIF 
    265221      ! 
    266       CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 ) 
    267       CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 
     222      CALL wrk_dealloc( jpi, jpj,      zqsr100, zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     223      CALL wrk_dealloc( jpi, jpj, jpk, zpar, ze0, ze1, ze2, ze3 ) 
    268224      ! 
    269225      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt') 
    … …  
    271227   END SUBROUTINE p4z_opt 
    272228 
    273    SUBROUTINE p4z_optsbc( kt ) 
    274       !!---------------------------------------------------------------------- 
    275       !!                  ***  routine p4z_optsbc  *** 
     229   SUBROUTINE p4z_opt_par( kt, pqsr, pe1, pe2, pe3, pe0 )  
     230      !!---------------------------------------------------------------------- 
     231      !!                  ***  routine p4z_opt_par  *** 
     232      !! 
     233      !! ** purpose :   compute PAR of each wavelength (Red-Green-Blue) 
     234      !!                for a given shortwave radiation 
     235      !! 
     236      !!---------------------------------------------------------------------- 
     237      !! * arguments 
     238      INTEGER, INTENT(in)                                       ::  kt            !   ocean time-step 
     239      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in)              ::  pqsr          !   shortwave 
     240      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::  pe1 , pe2 , pe3   !  PAR ( R-G-B) 
     241      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout), OPTIONAL ::  pe0   
     242      !! * local variables 
     243      INTEGER    ::   ji, jj, jk     ! dummy loop indices 
     244      REAL(wp), DIMENSION(jpi,jpj)     ::  zqsr          !   shortwave 
     245      !!---------------------------------------------------------------------- 
     246 
     247      !  Real shortwave 
     248      IF( ln_varpar ) THEN  ;  zqsr(:,:) = par_varsw(:,:) * pqsr(:,:) 
     249      ELSE                  ;  zqsr(:,:) = xparsw         * pqsr(:,:) 
     250      ENDIF 
     251      ! 
     252      IF( PRESENT( pe0 ) ) THEN     !  W-level 
     253         ! 
     254         pe0(:,:,1) = pqsr(:,:) - 3. * zqsr(:,:)    !   ( 1 - 3 * alpha ) * q 
     255         pe1(:,:,1) = zqsr(:,:)          
     256         pe2(:,:,1) = zqsr(:,:) 
     257         pe3(:,:,1) = zqsr(:,:) 
     258         ! 
     259         DO jk = 2, nksrp + 1 
     260            DO jj = 1, jpj 
     261               DO ji = 1, jpi 
     262                  pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * xsi0r ) 
     263                  pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb(ji,jj,jk-1 ) ) 
     264                  pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg(ji,jj,jk-1 ) ) 
     265                  pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr(ji,jj,jk-1 ) ) 
     266               END DO 
     267              ! 
     268            END DO 
     269            ! 
     270         END DO 
     271        ! 
     272      ELSE   ! T- level 
     273        ! 
     274        pe1(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekb(:,:,1) ) 
     275        pe2(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekg(:,:,1) ) 
     276        pe3(:,:,1) = zqsr(:,:) * EXP( -0.5 * ekr(:,:,1) ) 
     277        ! 
     278        DO jk = 2, nksrp       
     279           DO jj = 1, jpj 
     280              DO ji = 1, jpi 
     281                 pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -0.5 * ( ekb(ji,jj,jk-1) + ekb(ji,jj,jk) ) ) 
     282                 pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -0.5 * ( ekg(ji,jj,jk-1) + ekg(ji,jj,jk) ) ) 
     283                 pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -0.5 * ( ekr(ji,jj,jk-1) + ekr(ji,jj,jk) ) ) 
     284              END DO 
     285           END DO 
     286        END DO     
     287        ! 
     288      ENDIF 
     289      !  
     290   END SUBROUTINE p4z_opt_par 
     291 
     292 
     293   SUBROUTINE p4z_opt_sbc( kt ) 
     294      !!---------------------------------------------------------------------- 
     295      !!                  ***  routine p4z_opt_sbc  *** 
    276296      !! 
    277297      !! ** purpose :   read and interpolate the variable PAR fraction 
    … …  
    284304      !!---------------------------------------------------------------------- 
    285305      !! * arguments 
    286       INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
     306      INTEGER ,                INTENT(in) ::   kt     ! ocean time step 
    287307 
    288308      !! * local declarations 
    … …  
    297317         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN 
    298318            CALL fld_read( kt, 1, sf_par ) 
    299             par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) )/3.0 
     319            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 
    300320         ENDIF 
    301321      ENDIF 
    … …  
    303323      IF( nn_timing == 1 )  CALL timing_stop('p4z_optsbc') 
    304324      ! 
    305    END SUBROUTINE p4z_optsbc 
     325   END SUBROUTINE p4z_opt_sbc 
    306326 
    307327   SUBROUTINE p4z_opt_init 
    … …  
    347367      ! 
    348368      xparsw = parlux / 3.0 
     369      xsi0r  = 1.e0 / rn_si0 
    349370      ! 
    350371      ! Variable PAR at the surface of the ocean 
    … …  
    372393      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_1d(nksrp+1), ' m' 
    373394      ! 
    374                          etot (:,:,:) = 0._wp 
    375                          enano(:,:,:) = 0._wp 
    376                          ediat(:,:,:) = 0._wp 
    377       IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp 
     395                         ekr      (:,:,:) = 0._wp 
     396                         ekb      (:,:,:) = 0._wp 
     397                         ekg      (:,:,:) = 0._wp 
     398                         etot     (:,:,:) = 0._wp 
     399                         etot_ndcy(:,:,:) = 0._wp 
     400                         enano    (:,:,:) = 0._wp 
     401                         ediat    (:,:,:) = 0._wp 
     402      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp 
    378403      !  
    379404      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init') 
    … …  
    386411      !!                     ***  ROUTINE p4z_opt_alloc  *** 
    387412      !!---------------------------------------------------------------------- 
    388       ALLOCATE( enano(jpi,jpj,jpk), ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc )  
     413      ALLOCATE( ekb(jpi,jpj,jpk)      , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk),   & 
     414        &       enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk), & 
     415        &       etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc )  
    389416         ! 
    390417      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 
    … …  
    402429 
    403430   !!====================================================================== 
    404 END MODULE  p4zopt 
     431END MODULE p4zopt 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r5260 r5989  
    5454   REAL(wp) :: texcret2               !: 1 - excret2         
    5555 
    56  
    57    !!* Substitution 
    58 #  include "top_substitute.h90" 
     56   !! * Substitutions 
     57#  include "domzgr_substitute.h90" 
    5958   !!---------------------------------------------------------------------- 
    6059   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    6463CONTAINS 
    6564 
    66    SUBROUTINE p4z_prod( kt , jnt ) 
     65   SUBROUTINE p4z_prod( kt , knt ) 
    6766      !!--------------------------------------------------------------------- 
    6867      !!                     ***  ROUTINE p4z_prod  *** 
    … …  
    7473      !!--------------------------------------------------------------------- 
    7574      ! 
    76       INTEGER, INTENT(in) :: kt, jnt 
     75      INTEGER, INTENT(in) :: kt, knt 
    7776      ! 
    7877      INTEGER  ::   ji, jj, jk 
    … …  
    129128      END DO 
    130129 
    131       IF( ln_newprod ) THEN 
    132          ! Impact of the day duration on phytoplankton growth 
    133          DO jk = 1, jpkm1 
    134             DO jj = 1 ,jpj 
    135                DO ji = 1, jpi 
    136                   IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    137                      zval = MAX( 1., zstrn(ji,jj) ) 
    138                      zval = 1.5 * zval / ( 12. + zval ) 
    139                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 
    140                      zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
    141                   ENDIF 
    142                END DO 
    143             END DO 
    144          END DO 
    145       ENDIF 
     130      ! Impact of the day duration on phytoplankton growth 
     131      DO jk = 1, jpkm1 
     132         DO jj = 1 ,jpj 
     133            DO ji = 1, jpi 
     134               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     135                  zval = MAX( 1., zstrn(ji,jj) ) 
     136                  zval = 1.5 * zval / ( 12. + zval ) 
     137                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 
     138                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
     139               ENDIF 
     140            END DO 
     141         END DO 
     142      END DO 
    146143 
    147144      ! Maximum light intensity 
    … …  
    150147 
    151148      IF( ln_newprod ) THEN 
    152 !CDIR NOVERRCHK 
    153149         DO jk = 1, jpkm1 
    154 !CDIR NOVERRCHK 
    155150            DO jj = 1, jpj 
    156 !CDIR NOVERRCHK 
    157151               DO ji = 1, jpi 
    158152                  ! Computation of the P-I slope for nanos and diatoms 
    159                   IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     153                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    160154                      ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    161155                      zadap       = xadap * ztn / ( 2.+ ztn ) 
    162                       zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 
    163                       zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
     156                      zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
     157                      zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
    164158                      znanotot    = enano(ji,jj,jk) * zstrn(ji,jj) 
    165159                      zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj) 
    166160                      ! 
    167161                      zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap  * EXP( -znanotot ) )  & 
    168                          &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 
     162                         &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
    169163                      ! 
    170                       zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   & 
    171                          &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) 
     164                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   & 
     165                         &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
    172166 
    173167                      ! Computation of production function for Carbon 
    … …  
    188182         END DO 
    189183      ELSE 
    190 !CDIR NOVERRCHK 
    191184         DO jk = 1, jpkm1 
    192 !CDIR NOVERRCHK 
    193185            DO jj = 1, jpj 
    194 !CDIR NOVERRCHK 
    195186               DO ji = 1, jpi 
    196187 
    197188                  ! Computation of the P-I slope for nanos and diatoms 
    198                   IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     189                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    199190                      ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    200191                      zadap       = ztn / ( 2.+ ztn ) 
    201                       zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 
    202                       zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
     192                      zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
     193                      zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
     194                      znanotot    = enano(ji,jj,jk) * zstrn(ji,jj) 
     195                      zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj) 
    203196                      ! 
    204                       zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -0.21 * enano(ji,jj,jk) ) ) 
    205                       zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    206  
    207                       zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                & 
    208                         &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   & 
     197                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -znanotot ) ) 
     198                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trb(ji,jj,jk,jpdia) + rtrn ) 
     199 
     200                      zpislopen =  zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch)                & 
     201                        &          / ( trb(ji,jj,jk,jpphy) * 12.                  + rtrn )   & 
    209202                        &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
    210203 
    211                       zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                & 
    212                         &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   & 
     204                      zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch)                & 
     205                        &          / ( trb(ji,jj,jk,jpdia) * 12.                  + rtrn )   & 
    213206                        &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
    214207 
    215208                      ! Computation of production function for Carbon 
    216209                      !  --------------------------------------------- 
    217                       zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) ) 
    218                       zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 
     210                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot ) ) 
     211                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 
    219212 
    220213                      !  Computation of production function for Chlorophyll 
    221214                      !-------------------------------------------------- 
    222                       zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) ) 
    223                       zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) ) 
     215                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) ) 
     216                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 
    224217                  ENDIF 
    225218               END DO 
    … …  
    231224      !  Computation of a proxy of the N/C ratio 
    232225      !  --------------------------------------- 
    233 !CDIR NOVERRCHK 
    234226      DO jk = 1, jpkm1 
    235 !CDIR NOVERRCHK 
    236227         DO jj = 1, jpj 
    237 !CDIR NOVERRCHK 
    238228            DO ji = 1, jpi 
    239229                zval = MIN( xnanopo4(ji,jj,jk), ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) )   & 
    … …  
    252242            DO ji = 1, jpi 
    253243 
    254                 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     244                IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    255245                   !    Si/C of diatoms 
    256246                   !    ------------------------ 
    … …  
    258248                   !    Si/C is arbitrariliy increased for very high Si concentrations 
    259249                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    260                   zlim  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
     250                  zlim  = trb(ji,jj,jk,jpsil) / ( trb(ji,jj,jk,jpsil) + xksi1 ) 
    261251                  zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
    262252                  zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    263                   zsiborn = trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) * trn(ji,jj,jk,jpsil) 
     253                  zsiborn = trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) * trb(ji,jj,jk,jpsil) 
    264254                  IF (gphit(ji,jj) < -30 ) THEN 
    265255                    zsilfac2 = 1. + 2. * zsiborn / ( zsiborn + xksi2**3 ) 
    … …  
    296286 
    297287      ! Computation of the various production terms  
    298 !CDIR NOVERRCHK 
    299288      DO jk = 1, jpkm1 
    300 !CDIR NOVERRCHK 
    301289         DO jj = 1, jpj 
    302 !CDIR NOVERRCHK 
    303290            DO ji = 1, jpi 
    304                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     291               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    305292                  !  production terms for nanophyto. 
    306                   zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 
     293                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
    307294                  zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    308295                  ! 
    309                   zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     296                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    310297                  zratio = zratio / fecnm  
    311298                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    … …  
    313300                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
    314301                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
    315                   &             * zmax * trn(ji,jj,jk,jpphy) * rfact2 
     302                  &             * zmax * trb(ji,jj,jk,jpphy) * rfact2 
    316303                  !  production terms for diatomees 
    317                   zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 
     304                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 
    318305                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    319306                  ! 
    320                   zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     307                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    321308                  zratio = zratio / fecdm  
    322309                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    … …  
    324311                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
    325312                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
    326                   &             * zmax * trn(ji,jj,jk,jpdia) * rfact2 
     313                  &             * zmax * trb(ji,jj,jk,jpdia) * rfact2 
    327314               ENDIF 
    328315            END DO 
    … …  
    331318 
    332319      IF( ln_newprod ) THEN 
    333 !CDIR NOVERRCHK 
    334320         DO jk = 1, jpkm1 
    335 !CDIR NOVERRCHK 
    336321            DO jj = 1, jpj 
    337 !CDIR NOVERRCHK 
    338322               DO ji = 1, jpi 
    339323                  IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    … …  
    341325                     zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 
    342326                  ENDIF 
    343                   IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     327                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    344328                     !  production terms for nanophyto. ( chlorophyll ) 
    345329                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
    … …  
    359343         END DO 
    360344      ELSE 
    361 !CDIR NOVERRCHK 
    362345         DO jk = 1, jpkm1 
    363 !CDIR NOVERRCHK 
    364346            DO jj = 1, jpj 
    365 !CDIR NOVERRCHK 
    366347               DO ji = 1, jpi 
    367                   IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     348                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    368349                     !  production terms for nanophyto. ( chlorophyll ) 
    369                      znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
    370                      zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 
     350                     znanotot = enano(ji,jj,jk) 
     351                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trb(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 
    371352                     zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 
    372353                     zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 144. * zprod            & 
    373                      &                    / ( zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn ) 
     354                     &                    / ( zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch) * znanotot +rtrn ) 
    374355                     !  production terms for diatomees ( chlorophyll ) 
    375                      zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
    376                      zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 
     356                     zdiattot = ediat(ji,jj,jk) 
     357                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trb(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 
    377358                     zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 
    378359                     zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 144. * zprod             & 
    379                      &                    / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn ) 
     360                     &                    / ( zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch) * zdiattot +rtrn ) 
    380361                  ENDIF 
    381362               END DO 
    … …  
    414395 
    415396    ! Total primary production per year 
    416     IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. jnt == nrdttrc )  )  & 
     397    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  & 
    417398         & tpp = glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    418399 
    419400    IF( lk_iomput ) THEN 
    420        IF( jnt == nrdttrc ) THEN 
     401       IF( knt == nrdttrc ) THEN 
    421402          CALL wrk_alloc( jpi, jpj,      zw2d ) 
    422403          CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    … …  
    629610 
    630611   !!====================================================================== 
    631 END MODULE  p4zprod 
     612END MODULE p4zprod 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r5260 r5989  
    5050   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   - 
    5151 
    52    !!* Substitution 
    53 #  include "top_substitute.h90" 
     52   !! * Substitutions 
     53#  include "domzgr_substitute.h90" 
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    5959CONTAINS 
    6060 
    61    SUBROUTINE p4z_rem( kt, jnt ) 
     61   SUBROUTINE p4z_rem( kt, knt ) 
    6262      !!--------------------------------------------------------------------- 
    6363      !!                     ***  ROUTINE p4z_rem  *** 
    … …  
    6868      !!--------------------------------------------------------------------- 
    6969      ! 
    70       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     70      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    7171      ! 
    7272      INTEGER  ::   ji, jj, jk 
    … …  
    104104               zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
    105105               IF( fsdept(ji,jj,jk) < zdep ) THEN 
    106                   zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 ) 
     106                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 ) 
    107107                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    108108               ELSE 
    … …  
    119119            DO ji = 1, jpi 
    120120               ! denitrification factor computed from O2 levels 
    121                nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trn(ji,jj,jk,jpoxy) )    & 
    122                   &                                / ( oxymin + trn(ji,jj,jk,jpoxy) )  ) 
     121               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trb(ji,jj,jk,jpoxy) )    & 
     122                  &                                / ( oxymin + trb(ji,jj,jk,jpoxy) )  ) 
    123123               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
    124124            END DO 
    … …  
    140140               ! Ammonification in oxic waters with oxygen consumption 
    141141               ! ----------------------------------------------------- 
    142                zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  
    143                zolimi(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )  
     142               zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
     143               zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )  
    144144               ! Ammonification in suboxic waters with denitrification 
    145145               ! ------------------------------------------------------- 
    146                denitr(ji,jj,jk)  = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    147                   &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  ) 
     146               denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
     147                  &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  ) 
    148148               ! 
    149149               zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
    … …  
    165165               ! below 2 umol/L. Inhibited at strong light  
    166166               ! ---------------------------------------------------------- 
    167                zonitr  =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
    168                denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)  
     167               zonitr  =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
     168               denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)  
    169169               ! Update of the tracers trends 
    170170               ! ---------------------------- 
    … …  
    192192               ! ---------------------------------------------------------- 
    193193               zbactfer = 10.e-6 *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             & 
    194                   &              * trn(ji,jj,jk,jpfer) / ( 2.5E-10 + trn(ji,jj,jk,jpfer) )    & 
     194                  &              * trb(ji,jj,jk,jpfer) / ( 2.5E-10 + trb(ji,jj,jk,jpfer) )    & 
    195195                  &              * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk) 
    196196#if defined key_kriest 
    … …  
    228228               ! means a disaggregation constant about 0.5 the value in oxic zones 
    229229               ! ----------------------------------------------------------------- 
    230                zorem  = zremip * trn(ji,jj,jk,jppoc) 
    231                zofer  = zremip * trn(ji,jj,jk,jpsfe) 
     230               zorem  = zremip * trb(ji,jj,jk,jppoc) 
     231               zofer  = zremip * trb(ji,jj,jk,jpsfe) 
    232232#if ! defined key_kriest 
    233                zorem2 = zremip * trn(ji,jj,jk,jpgoc) 
    234                zofer2 = zremip * trn(ji,jj,jk,jpbfe) 
     233               zorem2 = zremip * trb(ji,jj,jk,jpgoc) 
     234               zofer2 = zremip * trb(ji,jj,jk,jpbfe) 
    235235#else 
    236                zorem2 = zremip * trn(ji,jj,jk,jpnum) 
     236               zorem2 = zremip * trb(ji,jj,jk,jpnum) 
    237237#endif 
    238238 
    … …  
    272272               ! Remineralization rate of BSi depedant on T and saturation 
    273273               ! --------------------------------------------------------- 
    274                zsatur   = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
     274               zsatur   = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
    275275               zsatur   = MAX( rtrn, zsatur ) 
    276276               zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 
    … …  
    287287               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) 
    288288               zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 
    289                zosil    = zsiremin * trn(ji,jj,jk,jpgsi) 
     289               zosil    = zsiremin * trb(ji,jj,jk,jpgsi) 
    290290               ! 
    291291               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil 
    … …  
    315315      END DO 
    316316 
    317       IF( jnt == nrdttrc ) THEN 
     317      IF( knt == nrdttrc ) THEN 
    318318          CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    319319          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r5260 r5989  
    8181 
    8282 
    83    !!* Substitution 
    84 #  include "top_substitute.h90" 
     83   !! * Substitutions 
     84#  include "domzgr_substitute.h90" 
     85#  include "vectopt_loop_substitute.h90" 
    8586   !!---------------------------------------------------------------------- 
    8687   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    117118         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
    118119            CALL fld_read( kt, 1, sf_dust ) 
    119             dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     120            IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN 
     121               dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     122            ELSE 
     123               dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) ) 
     124            ENDIF 
    120125         ENDIF 
    121126      ENDIF 
    … …  
    136141            DO jj = 1, jpj 
    137142               DO ji = 1, jpi 
    138                   zcoef = ryyss * cvol(ji,jj,1)  
     143                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
    139144                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    & 
    140145                     &              * 1.E3        / ( 12. * zcoef + rtrn ) 
    … …  
    187192      INTEGER  :: ierr, ierr1, ierr2, ierr3 
    188193      INTEGER  :: ios                 ! Local integer output status for namelist read 
     194      INTEGER  :: ik50                !  last level where depth less than 50 m 
     195      INTEGER  :: isrow             ! index for ORCA1 starting row 
    189196      REAL(wp) :: zexpide, zdenitide, zmaskt 
    190197      REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep  
    … …  
    216223902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp ) 
    217224      IF(lwm) WRITE ( numonp, nampissbc ) 
     225 
     226      IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN 
     227         IF(lwp) THEN 
     228            WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr 
     229            WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead ' 
     230            WRITE(numout,*) ' ln_ironice is forced to .FALSE. ' 
     231            ln_ironice = .FALSE. 
     232         ENDIF 
     233      ENDIF 
    218234 
    219235      IF(lwp) THEN 
    … …  
    247263      ENDIF 
    248264 
     265      ! set the number of level over which river runoffs are applied  
     266      ! online configuration : computed in sbcrnf 
     267      IF( lk_offline ) THEN 
     268        nk_rnf(:,:) = 1 
     269        h_rnf (:,:) = fsdept(:,:,1) 
     270      ENDIF 
     271 
    249272      ! dust input from the atmosphere 
    250273      ! ------------------------------ 
    … …  
    358381         rivalkinput = 0._wp 
    359382      END IF  
    360  
    361383      ! nutrient input from dust 
    362384      ! ------------------------ 
    … …  
    410432         CALL iom_close( numiron ) 
    411433         ! 
    412          DO jk = 1, 5 
     434         ik50 = 5        !  last level where depth less than 50 m 
     435         DO jk = jpkm1, 1, -1 
     436            IF( gdept_1d(jk) > 50. )  ik50 = jk - 1 
     437         END DO 
     438         IF (lwp) WRITE(numout,*) 
     439         IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1) 
     440         IF (lwp) WRITE(numout,*) 
     441         DO jk = 1, ik50 
    413442            DO jj = 2, jpjm1 
    414443               DO ji = fs_2, fs_jpim1 
    … …  
    421450            END DO 
    422451         END DO 
    423          IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN 
    424             ii0 = 176   ;   ii1 =  176        ! Southern Island : Kerguelen 
    425             ij0 =  37   ;   ij1 =   37  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp   
    426             ! 
    427             ii0 = 119   ;   ii1 =  119        ! South Georgia 
    428             ij0 =  29   ;   ij1 =   29  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp   
    429             ! 
    430             ii0 = 111   ;   ii1 =  111        ! Falklands 
    431             ij0 =  35   ;   ij1 =   35  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp   
    432             ! 
    433             ii0 = 168   ;   ii1 =  168        ! Crozet 
    434             ij0 =  40   ;   ij1 =   40  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp   
    435             ! 
    436             ii0 = 119   ;   ii1 =  119        ! South Orkney 
    437             ij0 =  28   ;   ij1 =   28  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp   
    438             ! 
    439             ii0 = 140   ;   ii1 =  140        ! Bouvet Island 
    440             ij0 =  33   ;   ij1 =   33  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp   
    441             ! 
    442             ii0 = 178   ;   ii1 =  178        ! Prince edwards 
    443             ij0 =  34   ;   ij1 =   34  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp   
    444             ! 
    445             ii0 =  43   ;   ii1 =   43        ! Balleny islands 
    446             ij0 =  21   ;   ij1 =   21  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp   
    447          ENDIF 
     452         ! 
    448453         CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
     454         ! 
    449455         DO jk = 1, jpk 
    450456            DO jj = 1, jpj 
    … …  
    514520 
    515521   !!====================================================================== 
    516 END MODULE  p4zsbc 
     522END MODULE p4zsbc 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r5260 r5989  
    2121   USE p4zopt          !  optical model 
    2222   USE p4zlim          !  Co-limitations of differents nutrients 
    23    USE p4zrem          !  Remineralisation of organic matter 
    2423   USE p4zsbc          !  External source of nutrients  
    2524   USE p4zint          !  interpolation and computation of various fields 
    … …  
    3029   PRIVATE 
    3130 
    32    PUBLIC   p4z_sed    
     31   PUBLIC   p4z_sed   
     32   PUBLIC   p4z_sed_alloc 
     33  
    3334 
    3435   !! * Module variables 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation  
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments 
    3538   REAL(wp) :: r1_rday                  !: inverse of rday 
    3639 
    37    INTEGER ::  numnit   
    38  
    39  
    40    !!* Substitution 
    41 #  include "top_substitute.h90" 
     40   !! * Substitutions 
     41#  include "domzgr_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4747CONTAINS 
    4848 
    49    SUBROUTINE p4z_sed( kt, jnt ) 
     49   SUBROUTINE p4z_sed( kt, knt ) 
    5050      !!--------------------------------------------------------------------- 
    5151      !!                     ***  ROUTINE p4z_sed  *** 
    … …  
    5858      !!--------------------------------------------------------------------- 
    5959      ! 
    60       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     60      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    6161      INTEGER  ::   ji, jj, jk, ikt 
    6262#if ! defined key_sed 
    … …  
    6969      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc 
    7070      REAL(wp) ::  ztrfer, ztrpo4, zwdust, zlight 
    71       REAL(wp) ::  zrdenittot, zsdenittot, znitrpottot 
    7271      ! 
    7372      CHARACTER (len=25) :: charout 
    74       REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3, zwork4 
     73      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3 
    7574      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff 
    7675      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal 
    77       REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep, zsoufer 
     76      REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer 
    7877      !!--------------------------------------------------------------------- 
    7978      ! 
    8079      IF( nn_timing == 1 )  CALL timing_start('p4z_sed') 
    8180      ! 
    82       IF( kt == nittrc000 .AND. jnt == 1 )  THEN 
    83          r1_rday  = 1. / rday 
    84          IF( ln_check_mass .AND. lwp)  & 
    85            &  CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    86       ENDIF 
     81      IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday 
    8782      ! 
    8883      ! Allocate temporary workspace 
    89       CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff ) 
     84      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 
    9085      CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 
    91       CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zsoufer ) 
     86      CALL wrk_alloc( jpi, jpj, jpk, zsoufer ) 
    9287 
    9388      zdenit2d(:,:) = 0.e0 
    … …  
    9691      zwork2  (:,:) = 0.e0 
    9792      zwork3  (:,:) = 0.e0 
    98       zwork4  (:,:) = 0.e0 
    9993 
    10094      ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. 
    … …  
    108102               zdep    = rfact2 / fse3t(ji,jj,1) 
    109103               zwflux  = fmmflx(ji,jj) / 1000._wp 
    110                zfminus = MIN( 0._wp, -zwflux ) * trn(ji,jj,1,jpfer) * zdep 
     104               zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep 
    111105               zfplus  = MAX( 0._wp, -zwflux ) * icefeinput * zdep 
    112106               zironice(ji,jj) =  zfplus + zfminus 
    … …  
    114108         END DO 
    115109         ! 
    116          trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + zironice(:,:)  
     110         tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)  
    117111         !  
    118          IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "Ironice" ) )   & 
     112         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   & 
    119113            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice 
    120114         ! 
    … …  
    144138         END DO 
    145139         !                                              ! Iron solubilization of particles in the water column 
    146          trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + zpdep   (:,:) 
    147          trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep  (:,:) 
    148          trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + zirondep(:,:,:)  
     140         tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep   (:,:) 
     141         tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:) 
     142         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:)  
    149143         !  
    150144         IF( lk_iomput ) THEN 
    151             IF( jnt == nrdttrc ) THEN 
     145            IF( knt == nrdttrc ) THEN 
    152146                IF( iom_use( "Irondep" ) )   & 
    153147                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron 
    … …  
    167161      ! ---------------------------------------------------------- 
    168162      IF( ln_river ) THEN 
    169          trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivdip(:,:) * rfact2 
    170          trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + rivdin(:,:) * rfact2 
    171          trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivdic(:,:) * 5.e-5 * rfact2 
    172          trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + rivdsi(:,:) * rfact2 
    173          trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivdic(:,:) * rfact2 
    174          trn(:,:,1,jptal) = trn(:,:,1,jptal) + ( rivalk(:,:) - rno3 * rivdin(:,:) ) * rfact2 
     163         DO jj = 1, jpj 
     164            DO ji = 1, jpi 
     165               DO jk = 1, nk_rnf(ji,jj) 
     166                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2 
     167                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2 
     168                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2 
     169                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2 
     170                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2 
     171                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2 
     172               ENDDO 
     173            ENDDO 
     174         ENDDO 
    175175      ENDIF 
    176176       
    … …  
    178178      ! ---------------------------------------------------------- 
    179179      IF( ln_ndepo ) THEN 
    180          trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + nitdep(:,:) * rfact2 
    181          trn(:,:,1,jptal) = trn(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 
     180         tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2 
     181         tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2 
    182182      ENDIF 
    183183 
    … …  
    185185      ! ------------------------------------------------------ 
    186186      IF( ln_ironsed ) THEN 
    187          trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
     187         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
    188188         ! 
    189          IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "Ironsed" ) )   & 
     189         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   & 
    190190            &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments 
    191191      ENDIF 
    … …  
    194194      ! ------------------------------------------------------ 
    195195      IF( ln_hydrofe ) THEN 
    196          trn(:,:,:,jpfer) = trn(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
     196         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
    197197         ! 
    198          IF( lk_iomput .AND. jnt == nrdttrc .AND. iom_use( "HYDR" ) )   & 
     198         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   & 
    199199            &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input 
    200200      ENDIF 
    … …  
    222222              ikt = mbkt(ji,jj) 
    223223# if defined key_kriest 
    224               zflx =    trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4 
     224              zflx =    trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4 
    225225# else 
    226               zflx = (  trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    227                 &     + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
     226              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
     227                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
    228228#endif 
    229229              zflx  = LOG10( MAX( 1E-3, zflx ) ) 
    230               zo2   = LOG10( MAX( 10. , trn(ji,jj,ikt,jpoxy) * 1E6 ) ) 
    231               zno3  = LOG10( MAX( 1.  , trn(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
     230              zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
     231              zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
    232232              zdep  = LOG10( fsdepw(ji,jj,ikt+1) ) 
    233233              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
    … …  
    235235              zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
    236236              ! 
    237               zflx = (  trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    238                 &     + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
     237              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
     238                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
    239239              zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
    240240           ENDIF 
    … …  
    251251               ikt = mbkt(ji,jj)  
    252252# if defined key_kriest 
    253                zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwscal (ji,jj) 
    254                zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
     253               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj) 
     254               zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
    255255# else 
    256                zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 
    257                zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trn(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)  
     256               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 
     257               zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)  
    258258# endif 
    259259               ! For calcite, burial efficiency is made a function of saturation 
    260260               zfactcal      = MIN( excess(ji,jj,ikt), 0.2 ) 
    261261               zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    262                zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 
     262               zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 
    263263            ENDIF 
    264264         END DO 
    … …  
    279279         DO ji = 1, jpi 
    280280            ikt  = mbkt(ji,jj) 
    281             zdep = xstep / fse3t(ji,jj,ikt) 
     281            zdep = xstep / fse3t(ji,jj,ikt)  
    282282            zws4 = zwsbio4(ji,jj) * zdep 
    283283            zwsc = zwscal (ji,jj) * zdep 
    284284# if defined key_kriest 
    285             zsiloss = trn(ji,jj,ikt,jpgsi) * zws4 
     285            zsiloss = trb(ji,jj,ikt,jpgsi) * zws4 
    286286# else 
    287             zsiloss = trn(ji,jj,ikt,jpgsi) * zwsc 
     287            zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    288288# endif 
    289             zcaloss = trn(ji,jj,ikt,jpcal) * zwsc 
     289            zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
    290290            ! 
    291             trn(ji,jj,ikt,jpgsi) = trn(ji,jj,ikt,jpgsi) - zsiloss 
    292             trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss 
     291            tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 
     292            tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 
    293293#if ! defined key_sed 
    294             trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
     294            tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
    295295            zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
    296296            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    297297            zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn ) 
    298             trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
    299             trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
     298            tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
     299            tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
    300300#endif 
    301301         END DO 
    … …  
    304304      DO jj = 1, jpj 
    305305         DO ji = 1, jpi 
    306             ikt     = mbkt(ji,jj) 
    307             zdep    = xstep / fse3t(ji,jj,ikt) 
     306            ikt  = mbkt(ji,jj) 
     307            zdep = xstep / fse3t(ji,jj,ikt)  
    308308            zws4 = zwsbio4(ji,jj) * zdep 
    309309            zws3 = zwsbio3(ji,jj) * zdep 
    310310            zrivno3 = 1. - zbureff(ji,jj) 
    311311# if ! defined key_kriest 
    312             trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zws4 
    313             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3 
    314             trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zws4 
    315             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3 
    316             zwstpoc              =  trn(ji,jj,ikt,jpgoc) * zws4 + trn(ji,jj,ikt,jppoc) * zws3  
     312            tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4  
     313            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 
     314            tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 
     315            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 
     316            zwstpoc              = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 
    317317# else 
    318             trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zws4 
    319             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zws3 
    320             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zws3 
    321             zwstpoc = trn(ji,jj,ikt,jppoc) * zws3  
     318            tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4  
     319            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 
     320            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 
     321            zwstpoc = trb(ji,jj,ikt,jppoc) * zws3  
    322322# endif 
    323323 
    … …  
    325325            ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 
    326326            ! in the sediments and just above the sediments. Not very clever, but simpliest option. 
    327             zpdenit  = MIN( 0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
     327            zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
    328328            z1pdenit = zwstpoc * zrivno3 - zpdenit 
    329             zolimit = MIN( ( trn(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
    330             zdenitt = MIN(  0.5 * ( trn(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) ) 
    331             trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt 
    332             trn(ji,jj,ikt,jppo4) = trn(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt 
    333             trn(ji,jj,ikt,jpnh4) = trn(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt 
    334             trn(ji,jj,ikt,jpno3) = trn(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt) 
    335             trn(ji,jj,ikt,jpoxy) = trn(ji,jj,ikt,jpoxy) - zolimit * o2ut 
    336             trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 
    337             trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 
    338             zwork4(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt) 
     329            zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
     330            zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) ) 
     331            tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt 
     332            tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt 
     333            tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt 
     334            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt) 
     335            tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 
     336            tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 
     337            tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 
     338            sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt) 
    339339#endif 
    340340         END DO 
    … …  
    356356#endif 
    357357               ztrfer = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       ) 
    358                ztrpo4 = trn  (ji,jj,jk,jppo4) / ( concnnh4   + trn  (ji,jj,jk,jppo4) )  
    359                zlight =  ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) )  
    360                znitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   & 
     358               ztrpo4 = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) )  
     359               zlight =  ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) )  
     360               nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   & 
    361361                 &         *  zfact * MIN( ztrfer, ztrpo4 ) * zlight 
    362362               zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk)) 
    … …  
    370370         DO jj = 1, jpj 
    371371            DO ji = 1, jpi 
    372                zfact = znitrpot(ji,jj,jk) * nitrfix 
    373                trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) +             zfact 
    374                trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3      * zfact 
    375                trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + o2nit     * zfact  
    376                trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trn(ji,jj,jk,jppo4) ) & 
    377                &                     * 0.002 * trn(ji,jj,jk,jpdoc) * rfact2 / rday 
    378                trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     372               zfact = nitrpot(ji,jj,jk) * nitrfix 
     373               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact 
     374               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact 
     375               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact  
     376               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 
     377               &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep 
     378               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep 
    379379           END DO 
    380380         END DO  
    381381      END DO 
    382382 
    383       ! Global budget of N SMS : denitrification in the water column and in the sediment 
    384       !                          nitrogen fixation by the diazotrophs 
    385       ! -------------------------------------------------------------------------------- 
    386       zrdenittot   = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) ) 
    387       zsdenittot   = glob_sum ( zwork4(:,:)   * e1e2t(:,:) ) 
    388       znitrpottot  = glob_sum ( znitrpot(:,:,:) * nitrfix              * cvol(:,:,:) ) 
    389       zfact = 1.e+3 * rfact2r * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/kt ----> TgN/m3/year 
    390       ! 
    391       IF( ln_check_mass .AND. ( kt == nitend .AND. jnt == nrdttrc ) .AND. ( lwp )  )  & 
    392          &  WRITE(numnit,9100) ndastp, znitrpottot * zfact  , & 
    393          &                             zrdenittot  * zfact  , & 
    394          &                             zsdenittot  * zfact 
    395       ! 
    396383      IF( lk_iomput ) THEN 
    397          IF( jnt == nrdttrc ) THEN 
     384         IF( knt == nrdttrc ) THEN 
    398385            zfact = 1.e+3 * rfact2r * rno3  !  conversion from molC/l/kt  to molN/m3/s 
    399             IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix"  , znitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation  
    400             IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", zwork4(:,:) * zfact * tmask(:,:,1) )  ! Nitrate reduction in the sediments 
    401             IF( iom_use("tnfix"  ) ) CALL iom_put( "tnfix"  , znitrpottot * zfact  )               ! Global  nitrogen fixation 
    402             IF( iom_use("tdenit" ) ) CALL iom_put( "tdenit" , zrdenittot  * zfact  )               ! Total denitrification 
     386            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation  
    403387            IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated ) 
    404388               zwork1(:,:) = 0. 
    405389               DO jk = 1, jpkm1 
    406                  zwork1(:,:) = zwork1(:,:) + znitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk) 
     390                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk) 
    407391               ENDDO 
    408392               CALL iom_put( "INTNFIX" , zwork1 )  
    … …  
    411395      ELSE 
    412396         IF( ln_diatrc )  & 
    413             &  trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) 
     397            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) 
    414398      ENDIF 
    415399      ! 
    … …  
    417401         WRITE(charout, fmt="('sed ')") 
    418402         CALL prt_ctl_trc_info(charout) 
    419          CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 
    420       ENDIF 
    421       ! 
    422       CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zwork4, zbureff ) 
     403         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     404      ENDIF 
     405      ! 
     406      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 
    423407      CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 
    424       CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zsoufer ) 
     408      CALL wrk_dealloc( jpi, jpj, jpk, zsoufer ) 
    425409      ! 
    426410      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed') 
    … …  
    429413      ! 
    430414   END SUBROUTINE p4z_sed 
     415 
     416 
     417   INTEGER FUNCTION p4z_sed_alloc() 
     418      !!---------------------------------------------------------------------- 
     419      !!                     ***  ROUTINE p4z_sed_alloc  *** 
     420      !!---------------------------------------------------------------------- 
     421      ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc ) 
     422      ! 
     423      IF( p4z_sed_alloc /= 0 )   CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays') 
     424      ! 
     425   END FUNCTION p4z_sed_alloc 
     426 
    431427 
    432428#else 
    … …  
    440436 
    441437   !!====================================================================== 
    442 END MODULE  p4zsed 
     438END MODULE p4zsed 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

    r5260 r5989  
    6565#endif 
    6666 
    67    !!* Substitution 
    68 #  include "top_substitute.h90" 
     67   !! * Substitutions 
     68#  include "domzgr_substitute.h90" 
    6969   !!---------------------------------------------------------------------- 
    7070   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    7979   !!---------------------------------------------------------------------- 
    8080 
    81    SUBROUTINE p4z_sink ( kt, jnt ) 
     81   SUBROUTINE p4z_sink ( kt, knt ) 
    8282      !!--------------------------------------------------------------------- 
    8383      !!                     ***  ROUTINE p4z_sink  *** 
    … …  
    8888      !! ** Method  : - ??? 
    8989      !!--------------------------------------------------------------------- 
    90       INTEGER, INTENT(in) :: kt, jnt 
     90      INTEGER, INTENT(in) :: kt, knt 
    9191      INTEGER  ::   ji, jj, jk, jit 
    9292      INTEGER  ::   iiter1, iiter2 
    … …  
    199199               zfact = zstep * xdiss(ji,jj,jk) 
    200200               !  Part I : Coagulation dependent on turbulence 
    201                zagg1 = 25.9  * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    202                zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     201               zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 
     202               zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 
    203203 
    204204               ! Part II : Differential settling 
    205205 
    206206               !  Aggregation of small into large particles 
    207                zagg3 =  47.1 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    208                zagg4 =  3.3  * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     207               zagg3 =  47.1 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 
     208               zagg4 =  3.3  * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 
    209209 
    210210               zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    211                zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
     211               zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    212212 
    213213               ! Aggregation of DOC to POC :  
    … …  
    215215               ! 2nd term is shear aggregation of DOC-POC 
    216216               ! 3rd term is differential settling of DOC-POC 
    217                zaggdoc  = ( ( 0.369 * 0.3 * trn(ji,jj,jk,jpdoc) + 102.4 * trn(ji,jj,jk,jppoc) ) * zfact       & 
    218                &            + 2.4 * zstep * trn(ji,jj,jk,jppoc) ) * 0.3 * trn(ji,jj,jk,jpdoc) 
     217               zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       & 
     218               &            + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc) 
    219219               ! transfer of DOC to GOC :  
    220220               ! 1st term is shear aggregation 
    221221               ! 2nd term is differential settling  
    222                zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trn(ji,jj,jk,jpgoc) * 0.3 * trn(ji,jj,jk,jpdoc) 
     222               zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc) 
    223223               ! tranfer of DOC to POC due to brownian motion 
    224                zaggdoc3 =  ( 5095. * trn(ji,jj,jk,jppoc) + 114. * 0.3 * trn(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trn(ji,jj,jk,jpdoc) 
     224               zaggdoc3 =  ( 5095. * trb(ji,jj,jk,jppoc) + 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trb(ji,jj,jk,jpdoc) 
    225225 
    226226               !  Update the trends 
    … …  
    237237 
    238238     ! Total carbon export per year 
    239      IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. jnt == nrdttrc )  )  & 
     239     IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  & 
    240240        &   t_oce_co2_exp = glob_sum( ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) ) 
    241241     ! 
    242242     IF( lk_iomput ) THEN 
    243        IF( jnt == nrdttrc ) THEN 
     243       IF( knt == nrdttrc ) THEN 
    244244          CALL wrk_alloc( jpi, jpj,      zw2d ) 
    245245          CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    … …  
    328328   !!---------------------------------------------------------------------- 
    329329 
    330    SUBROUTINE p4z_sink ( kt, jnt ) 
     330   SUBROUTINE p4z_sink ( kt, knt ) 
    331331      !!--------------------------------------------------------------------- 
    332332      !!                ***  ROUTINE p4z_sink  *** 
    … …  
    338338      !!--------------------------------------------------------------------- 
    339339      ! 
    340       INTEGER, INTENT(in) :: kt, jnt 
     340      INTEGER, INTENT(in) :: kt, knt 
    341341      ! 
    342342      INTEGER  :: ji, jj, jk, jit, niter1, niter2 
    … …  
    373373            DO ji = 1, jpi 
    374374               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 
    375                   znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp 
     375                  znum = trb(ji,jj,jk,jppoc) / ( trb(ji,jj,jk,jpnum) + rtrn ) / xkr_massp 
    376376                  ! -------------- To avoid sinking speed over 50 m/day ------- 
    377377                  znum  = MIN( xnumm(jk), znum ) 
    … …  
    435435               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 
    436436 
    437                   znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp 
     437                  znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp 
    438438                  !-------------- To avoid sinking speed over 50 m/day ------- 
    439439                  znum  = min(xnumm(jk),znum) 
    … …  
    453453                  !    ---------------------------------------------- 
    454454 
    455                   zagg1 =  0.163 * trn(ji,jj,jk,jpnum)**2               & 
     455                  zagg1 =  0.163 * trb(ji,jj,jk,jpnum)**2               & 
    456456                     &            * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3)    & 
    457457                     &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    & 
    458458                     &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  & 
    459459                     &            * (zeps-1.)**2/(zdiv2*zdiv3))  
    460                   zagg2 =  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       & 
     460                  zagg2 =  2*0.163*trb(ji,jj,jk,jpnum)**2*zfm*                       & 
    461461                     &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          & 
    462462                     &                    *xkr_mass_min*(zeps-1.)/zdiv2                 & 
    … …  
    466466                     &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))     
    467467 
    468                   zagg3 =  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   
     468                  zagg3 =  0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   
    469469                   
    470470                 !    Aggregation of small into large particles 
    … …  
    472472                 !    ---------------------------------------------- 
    473473 
    474                   zagg4 =  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
     474                  zagg4 =  2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2*                       & 
    475475                     &                 xkr_wsbio_min*(zeps-1.)**2                         & 
    476476                     &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      & 
    … …  
    479479                     &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )    
    480480 
    481                   zagg5 =   2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         & 
     481                  zagg5 =   2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2                         & 
    482482                     &                 *(zeps-1.)*zfm*xkr_wsbio_min                        & 
    483483                     &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         & 
    … …  
    489489                  !     ------------------------------------ 
    490490 
    491                   zfract = 2.*3.141*0.125*trn(ji,jj,jk,jpmes)*12./0.12/0.06**3*trn(ji,jj,jk,jpnum)  & 
     491                  zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum)  & 
    492492                    &      * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2  & 
    493493                    &      * 10000.*xstep 
    … …  
    496496                  !     -------------------------------------- 
    497497 
    498                   zaggdoc = 0.83 * trn(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc)   & 
    499                      &        + 0.005 * 231. * trn(ji,jj,jk,jpdoc) * xstep * trn(ji,jj,jk,jpdoc) 
    500                   zaggdoc1 = 271. * trn(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  & 
    501                      &  + 0.02 * 16706. * trn(ji,jj,jk,jppoc) * xstep * trn(ji,jj,jk,jpdoc) 
     498                  zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)   & 
     499                     &        + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc) 
     500                  zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  & 
     501                     &  + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc) 
    502502 
    503503# if defined key_degrad 
    … …  
    514514                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
    515515                  ! 
    516                   znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
     516                  znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    517517                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1 
    518518                  tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg 
    … …  
    528528     ! 
    529529     IF( lk_iomput ) THEN 
    530         IF( jnt == nrdttrc ) THEN 
     530        IF( knt == nrdttrc ) THEN 
    531531          CALL wrk_alloc( jpi, jpj,      zw2d ) 
    532532          CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    … …  
    800800      ztraz(:,:,:) = 0.e0 
    801801      zakz (:,:,:) = 0.e0 
    802       ztrb (:,:,:) = trn(:,:,:,jp_tra) 
     802      ztrb (:,:,:) = trb(:,:,:,jp_tra) 
    803803 
    804804      DO jk = 1, jpkm1 
    … …  
    815815         !  first guess of the slopes interior values 
    816816         DO jk = 2, jpkm1 
    817             ztraz(:,:,jk) = ( trn(:,:,jk-1,jp_tra) - trn(:,:,jk,jp_tra) ) * tmask(:,:,jk) 
     817            ztraz(:,:,jk) = ( trb(:,:,jk-1,jp_tra) - trb(:,:,jk,jp_tra) ) * tmask(:,:,jk) 
    818818         END DO 
    819819         ztraz(:,:,1  ) = 0.0 
    … …  
    846846                  zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1) 
    847847                  zew   = zwsink2(ji,jj,jk+1) 
    848                   psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
     848                  psinkflx(ji,jj,jk+1) = -zew * ( trb(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
    849849               END DO 
    850850            END DO 
    … …  
    859859               DO ji = 1, jpi 
    860860                  zflx = ( psinkflx(ji,jj,jk) - psinkflx(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    861                   trn(ji,jj,jk,jp_tra) = trn(ji,jj,jk,jp_tra) + zflx 
     861                  trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + zflx 
    862862               END DO 
    863863            END DO 
    … …  
    875875      END DO 
    876876 
    877       trn(:,:,:,jp_tra) = ztrb(:,:,:) 
     877      trb(:,:,:,jp_tra) = ztrb(:,:,:) 
    878878      psinkflx(:,:,:)   = 2. * psinkflx(:,:,:) 
    879879      ! 
    … …  
    913913 
    914914   !!====================================================================== 
    915 END MODULE  p4zsink 
     915END MODULE p4zsink 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r5260 r5989  
    2424   USE p4zsed          !  Sedimentation 
    2525   USE p4zint          !  time interpolation 
     26   USE p4zrem          !  remineralisation 
    2627   USE iom             !  I/O manager 
    2728   USE trd_oce         !  Ocean trends variables 
    … …  
    3637   PUBLIC   p4z_sms        ! called in p4zsms.F90 
    3738 
    38    REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget 
    39    INTEGER ::  numco2, numnut  !: logical unit for co2 budget 
     39   REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget 
     40   REAL(wp) :: xfact1, xfact2, xfact3 
     41   INTEGER ::  numco2, numnut, numnit  !: logical unit for co2 budget 
     42 
     43   !!* Array used to indicate negative tracer values 
     44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ??? 
     45 
    4046 
    4147   !!---------------------------------------------------------------------- 
    … …  
    6167      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    6268      !! 
    63       INTEGER ::   jnt, jn, jl 
     69      INTEGER ::   ji, jj, jk, jnt, jn, jl 
     70      REAL(wp) ::  ztra 
     71#if defined key_kriest 
     72      REAL(wp) ::  zcoef1, zcoef2 
     73#endif 
    6474      CHARACTER (len=25) :: charout 
    65       REAL(wp), POINTER, DIMENSION(:,:,:,:)  :: ztrdpis 
    6675      !!--------------------------------------------------------------------- 
    6776      ! 
    6877      IF( nn_timing == 1 )  CALL timing_start('p4z_sms') 
    6978      ! 
    70       IF( l_trdtrc )  THEN 
    71          CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdpis )  
    72          DO jn = 1, jp_pisces 
    73             jl = jn + jp_pcs0 - 1 
    74             ztrdpis(:,:,:,jn) = trn(:,:,:,jl) 
    75          ENDDO 
    76       ENDIF 
    77       ! 
    7879      IF( kt == nittrc000 ) THEN 
     80        ! 
     81        ALLOCATE( xnegtr(jpi,jpj,jpk) ) 
    7982        ! 
    8083        CALL p4z_che                              ! initialize the chemical constants 
    … …  
    8891      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers 
    8992      ! 
     93      !                                                                    !   set time step size (Euler/Leapfrog) 
     94      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc(1)     !  at nittrc000 
     95      ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc(1)   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog) 
     96      ENDIF 
     97      ! 
     98      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN 
     99         rfactr  = 1. / rfact 
     100         rfact2  = rfact / FLOAT( nrdttrc ) 
     101         rfact2r = 1. / rfact2 
     102         xstep = rfact2 / rday         ! Time step duration for biology 
     103         IF(lwp) WRITE(numout,*)  
     104         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1) 
     105         IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2 
     106         IF(lwp) WRITE(numout,*) 
     107      ENDIF 
     108 
     109      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 
     110         DO jn = jp_pcs0, jp_pcs1              !   SMS on tracer without Asselin time-filter 
     111            trb(:,:,:,jn) = trn(:,:,:,jn) 
     112         END DO 
     113      ENDIF 
     114      ! 
    90115      IF( ndayflxtr /= nday_year ) THEN      ! New days 
    91116         ! 
    … …  
    105130      DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    106131         ! 
    107          CALL p4z_bio (kt, jnt)    ! Biology 
    108          CALL p4z_sed (kt, jnt)    ! Sedimentation 
    109          ! 
     132         CALL p4z_bio( kt, jnt )   ! Biology 
     133         CALL p4z_sed( kt, jnt )   ! Sedimentation 
     134         CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation 
     135         CALL p4z_flx( kt, jnt )   ! Compute surface fluxes 
     136         ! 
     137         xnegtr(:,:,:) = 1.e0 
    110138         DO jn = jp_pcs0, jp_pcs1 
    111             trb(:,:,:,jn) = trn(:,:,:,jn) 
    112          ENDDO 
    113          ! 
     139            DO jk = 1, jpk 
     140               DO jj = 1, jpj 
     141                  DO ji = 1, jpi 
     142                     IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 
     143                        ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 
     144                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra ) 
     145                     ENDIF 
     146                 END DO 
     147               END DO 
     148            END DO 
     149         END DO 
     150         !                                ! where at least 1 tracer concentration becomes negative 
     151         !                                !  
     152         DO jn = jp_pcs0, jp_pcs1 
     153           trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn) 
     154         END DO 
     155        ! 
     156         DO jn = jp_pcs0, jp_pcs1 
     157            tra(:,:,:,jn) = 0._wp 
     158         END DO 
     159         ! 
     160         IF( ln_top_euler ) THEN 
     161            DO jn = jp_pcs0, jp_pcs1 
     162               trn(:,:,:,jn) = trb(:,:,:,jn) 
     163            END DO 
     164         ENDIF 
    114165      END DO 
    115166 
    116       IF( l_trdtrc )  THEN 
    117          DO jn = 1, jp_pisces 
    118             jl = jn + jp_pcs0 - 1 
    119             ztrdpis(:,:,:,jn) = ( ztrdpis(:,:,:,jn) - trn(:,:,:,jl) ) * rfact2r 
    120          ENDDO 
    121       ENDIF 
    122       CALL p4z_lys( kt )             ! Compute CaCO3 saturation 
    123       CALL p4z_flx( kt )             ! Compute surface fluxes 
    124  
    125       DO jn = jp_pcs0, jp_pcs1 
    126         CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
    127         CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 
    128         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. ) 
     167#if defined key_kriest 
     168      !  
     169      zcoef1 = 1.e0 / xkr_massp  
     170      zcoef2 = 1.e0 / xkr_massp / 1.1 
     171      DO jk = 1,jpkm1 
     172         trb(:,:,jk,jpnum) = MAX(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  ) 
     173         trb(:,:,jk,jpnum) = MIN(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2              ) 
    129174      END DO 
    130175      ! 
     176#endif 
     177      ! 
     178      ! 
     179      IF( l_trdtrc ) THEN 
     180         DO jn = jp_pcs0, jp_pcs1 
     181           CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
     182         END DO 
     183      END IF 
     184      ! 
    131185      IF( lk_sed ) THEN  
    132186         ! 
    … …  
    134188         ! 
    135189         DO jn = jp_pcs0, jp_pcs1 
    136            CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 
     190           CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 
    137191         END DO 
    138192         ! 
    … …  
    141195      IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file  
    142196      ! 
    143       IF( l_trdtrc ) THEN 
    144          DO jn = 1, jp_pisces 
    145             jl = jn + jp_pcs0 - 1 
    146              ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl) 
    147              CALL trd_trc( ztrdpis(:,:,:,jn), jn, jptra_sms, kt )   ! save trends 
    148           END DO 
    149           CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis )  
    150       END IF 
    151       ! 
     197 
    152198      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt ) ! Mass conservation checking 
    153199 
    … …  
    280326               ztmas   = tmask(ji,jj,jk) 
    281327               ztmas1  = 1. - tmask(ji,jj,jk) 
    282                zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    283                zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    284                zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
     328               zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     329               zco3    = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
     330               zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk ) 
    285331               hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    286332            END DO 
    … …  
    361407      REAL(wp) ::  silmean = 91.51     ! mean value of silicate 
    362408      ! 
    363       REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 
     409      REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn 
     410      REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb 
    364411      !!--------------------------------------------------------------------- 
    365412 
    … …  
    374421         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6               
    375422 
    376          zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    377          zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
    378          zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
    379          zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     423         zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
     424         zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
     425         zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
     426         zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
    380427  
    381          IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum 
    382          trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum 
    383  
    384          IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum 
    385          trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum 
    386  
    387          IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum 
    388          trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum 
    389  
    390          IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum 
    391          trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum ) 
    392          ! 
    393       ENDIF 
    394  
     428         IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn 
     429         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn 
     430 
     431         IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn 
     432         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn 
     433 
     434         IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn 
     435         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn 
     436 
     437         IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn 
     438         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn ) 
     439         ! 
     440         ! 
     441         IF( .NOT. ln_top_euler ) THEN 
     442            zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
     443            zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r 
     444            zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3 
     445            zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     446  
     447            IF(lwp) WRITE(numout,*) ' ' 
     448            IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb 
     449            trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb 
     450 
     451            IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb 
     452            trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb 
     453 
     454            IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb 
     455            trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb 
     456 
     457            IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb 
     458            trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb ) 
     459        ENDIF 
     460        ! 
     461      ENDIF 
     462        ! 
    395463   END SUBROUTINE p4z_dmp 
    396464 
    … …  
    404472      !!--------------------------------------------------------------------- 
    405473      ! 
    406       INTEGER , INTENT( in ) ::   kt      ! ocean time-step index       
    407       REAL(wp)               ::  zfact        
    408       !! 
     474      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     475      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot 
     476      CHARACTER(LEN=100)   ::   cltxt 
     477      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol 
     478      INTEGER :: jk 
     479      !!---------------------------------------------------------------------- 
     480 
     481      ! 
    409482      !!--------------------------------------------------------------------- 
    410483 
    … …  
    413486            CALL ctl_opn( numco2, 'carbon.budget'  , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    414487            CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     488            CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     489            xfact1 = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/yr 
     490            xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/s ----> TgN/m3/yr 
     491            xfact3 = 1.e+3 * rfact2r * rno3   ! conversion molC/l/kt ----> molN/m3/s 
     492            cltxt='time-step   Alkalinity        Nitrate        Phosphorus         Silicate           Iron' 
     493            IF( lwp ) WRITE(numnut,*)  TRIM(cltxt) 
     494            IF( lwp ) WRITE(numnut,*)  
    415495         ENDIF 
    416496      ENDIF 
    417497 
     498      ! 
    418499      IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    419500         !   Compute the budget of NO3, ALK, Si, Fer 
    … …  
    431512      ENDIF 
    432513      ! 
    433       IF( iom_use( "psiltot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN 
     514      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
     515         po4budget = glob_sum( (   trn(:,:,:,jppo4)                     & 
     516            &                    + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  & 
     517            &                    + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  & 
     518            &                    + trn(:,:,:,jppoc)                     & 
     519#if ! defined key_kriest 
     520            &                    + trn(:,:,:,jpgoc)                     & 
     521#endif 
     522            &                    + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  ) 
     523         po4budget = po4budget / areatot 
     524         CALL iom_put( "ppo4tot", po4budget ) 
     525      ENDIF 
     526      ! 
     527      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    434528         silbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpgsi)  & 
    435529            &                    + trn(:,:,:,jpdsi)                     ) * cvol(:,:,:)  ) 
    … …  
    439533      ENDIF 
    440534      ! 
    441       IF( iom_use( "palktot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN 
     535      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    442536         alkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              & 
    443537            &                    + trn(:,:,:,jptal)                     & 
    … …  
    448542      ENDIF 
    449543      ! 
    450       IF( iom_use( "pfertot" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN 
     544      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    451545         ferbudget = glob_sum( (   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe)  & 
    452546            &                    + trn(:,:,:,jpdfe)                     & 
    … …  
    462556      ENDIF 
    463557      ! 
     558 
     559      ! Global budget of N SMS : denitrification in the water column and in the sediment 
     560      !                          nitrogen fixation by the diazotrophs 
     561      ! -------------------------------------------------------------------------------- 
     562      IF( iom_use( "tnfix" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN 
     563         znitrpottot  = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) ) 
     564         CALL iom_put( "tnfix"  , znitrpottot * 1.e+3 * rno3 )  ! Global  nitrogen fixation molC/l  to molN/m3  
     565      ENDIF 
     566      ! 
     567      IF( iom_use( "tdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN 
     568         zrdenittot   = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) ) 
     569         CALL iom_put( "tdenit"  , zrdenittot * 1.e+3 * rno3 )  ! Total denitrification molC/l to molN/m3  
     570      ENDIF 
     571      ! 
     572      IF( iom_use( "Sdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN 
     573         zsdenittot   = glob_sum ( sdenit(:,:) * e1e2t(:,:) ) 
     574         CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) )  ! Nitrate reduction in the sediments 
     575      ENDIF 
     576 
    464577      IF( ln_check_mass .AND. kt == nitend ) THEN   ! Compute the budget of NO3, ALK, Si, Fer 
    465          zfact = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/year 
    466578         t_atm_co2_flx  = t_atm_co2_flx / glob_sum( e1e2t(:,:) ) 
    467          t_oce_co2_flx  = t_oce_co2_flx         * zfact * (-1 ) 
    468          tpp            = tpp           * 1000. * zfact 
    469          t_oce_co2_exp  = t_oce_co2_exp * 1000. * zfact 
     579         t_oce_co2_flx  = t_oce_co2_flx         * xfact1 * (-1 ) 
     580         tpp            = tpp           * 1000. * xfact1 
     581         t_oce_co2_exp  = t_oce_co2_exp * 1000. * xfact1 
    470582         IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp 
    471          IF( lwp ) WRITE(numnut,9500) ndastp, alkbudget        * 1.e+06, & 
     583         IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget        * 1.e+06, & 
    472584             &                                no3budget * rno3 * 1.e+06, & 
     585             &                                po4budget * po4r * 1.e+06, & 
    473586             &                                silbudget        * 1.e+06, & 
    474587             &                                ferbudget        * 1.e+09 
     588         ! 
     589         IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2  , & 
     590         &                             zrdenittot  * xfact2  , & 
     591         &                             zsdenittot  * xfact2 
     592 
    475593      ENDIF 
    476594      ! 
    477595 9000  FORMAT(i8,f10.5,e18.10,f10.5,f10.5) 
    478  9500  FORMAT(i8,4e18.10) 
     596 9100  FORMAT(i8,5e18.10) 
     597 9200  FORMAT(i8,3f10.5) 
     598 
    479599       ! 
    480600   END SUBROUTINE p4z_chk_mass 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r3680 r5989  
    6363   INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration 
    6464   INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration 
    65    INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration 
     65   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration 
    6666   INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration 
    6767   INTEGER, PUBLIC, PARAMETER ::   jpnum = 15    !: Big iron particles Concentration 
    6868   INTEGER, PUBLIC, PARAMETER ::   jpsfe = 16    !: number of particulate organic phosphate concentration 
    6969   INTEGER, PUBLIC, PARAMETER ::   jpdfe = 17    !: Diatoms iron Concentration 
    70    INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: Diatoms Silicate Concentration 
     70   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: (big) Silicate Concentration 
    7171   INTEGER, PUBLIC, PARAMETER ::   jpnfe = 19    !: Nano iron Concentration 
    7272   INTEGER, PUBLIC, PARAMETER ::   jpnch = 20    !: Nano Chlorophyll Concentration 
    … …  
    102102   INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration 
    103103   INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration 
    104    INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: (big) Silicate Concentration 
     104   INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration 
    105105   INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration 
    106106   INTEGER, PUBLIC, PARAMETER ::   jpbfe = 15    !: Big iron particles Concentration 
    … …  
    108108   INTEGER, PUBLIC, PARAMETER ::   jpsfe = 17    !: Small iron particles Concentration 
    109109   INTEGER, PUBLIC, PARAMETER ::   jpdfe = 18    !: Diatoms iron Concentration 
    110    INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: Diatoms Silicate Concentration 
     110   INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: (big) Silicate Concentration 
    111111   INTEGER, PUBLIC, PARAMETER ::   jpnfe = 20    !: Nano iron Concentration 
    112112   INTEGER, PUBLIC, PARAMETER ::   jpnch = 21    !: Nano Chlorophyll Concentration 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r5260 r5989  
    106106   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    107107 
    108    !!* Array used to indicate negative tracer values 
    109    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ??? 
    110  
    111108#if defined key_kriest 
    112109   !!*  Kriest parameter for aggregation 
    … …  
    131128      !!---------------------------------------------------------------------- 
    132129      USE lib_mpp , ONLY: ctl_warn 
    133       INTEGER ::   ierr(6)        ! Local variables 
     130      INTEGER ::   ierr(5)        ! Local variables 
    134131      !!---------------------------------------------------------------------- 
    135132      ierr(:) = 0 
    … …  
    162159      ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,    STAT=ierr(5) ) 
    163160         ! 
    164       !* Array used to indicate negative tracer values   
    165       ALLOCATE( xnegtr(jpi,jpj,jpk)  ,                           STAT=ierr(6) ) 
    166161#endif 
    167162      ! 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90

    r5386 r5989  
    2929CONTAINS 
    3030 
     31 
    3132   SUBROUTINE trc_ice_ini_pisces 
    3233      !!---------------------------------------------------------------------- 
    33       !!                   ***  ROUTINE trc_ice_ini_pisces *** 
     34      !!                   ***  ROUTINE trc_ini_pisces *** 
     35      !! 
     36      !! ** Purpose :   Initialisation of the PISCES biochemical model 
     37      !!---------------------------------------------------------------------- 
     38 
     39      IF( lk_p4z ) THEN  ;   CALL p4z_ice_ini   !  PISCES 
     40      ELSE               ;   CALL p2z_ice_ini   !  LOBSTER 
     41      ENDIF 
     42 
     43   END SUBROUTINE trc_ice_ini_pisces 
     44 
     45 
     46   SUBROUTINE p4z_ice_ini 
     47 
     48#if defined key_pisces  
     49      !!---------------------------------------------------------------------- 
     50      !!                   ***  ROUTINE p4z_ice_ini *** 
    3451      !! 
    3552      !! ** Purpose :   PISCES fake sea ice model setting 
    … …  
    5875 
    5976                                        !--- Dummy variables 
    60       REAL(wp), DIMENSION(jptra,2) & 
    61                ::  zratio            ! effective ice-ocean tracer cc ratio 
     77      REAL(wp), DIMENSION(jp_pisces,2)  :: zratio  ! effective ice-ocean tracer cc ratio 
     78      REAL(wp), DIMENSION(jp_pisces,4)  :: zpisc   ! prescribes concentration  
     79      !                                            !  1:global, 2:Arctic, 3:Antarctic, 4:Baltic 
     80 
    6281      REAL(wp), DIMENSION(2) :: zrs  ! ice-ocean salinity ratio, 1 - global, 2- Baltic 
    6382      REAL(wp) :: zsice_bal          ! prescribed ice salinity in the Baltic 
    … …  
    8099      ! fluxes 
    81100 
    82       !--- Global case  
    83       IF ( cn_trc_o(jpdic) == 'GL ' ) trc_o(:,:,jpdic) =  1.99e-3_wp  
    84       IF ( cn_trc_o(jpdoc) == 'GL ' ) trc_o(:,:,jpdoc) =  2.04e-5_wp  
    85       IF ( cn_trc_o(jptal) == 'GL ' ) trc_o(:,:,jptal) =  2.31e-3_wp  
    86       IF ( cn_trc_o(jpoxy) == 'GL ' ) trc_o(:,:,jpoxy) =  2.47e-4_wp 
    87       IF ( cn_trc_o(jpcal) == 'GL ' ) trc_o(:,:,jpcal) =  1.04e-8_wp 
    88       IF ( cn_trc_o(jppo4) == 'GL ' ) trc_o(:,:,jppo4) =  5.77e-7_wp / po4r  
    89       IF ( cn_trc_o(jppoc) == 'GL ' ) trc_o(:,:,jppoc) =  1.27e-6_wp   
     101      !--- Global values 
     102      zpisc(jpdic,1) =  1.99e-3_wp  
     103      zpisc(jpdoc,1) =  2.04e-5_wp  
     104      zpisc(jptal,1) =  2.31e-3_wp  
     105      zpisc(jpoxy,1) =  2.47e-4_wp 
     106      zpisc(jpcal,1) =  1.04e-8_wp 
     107      zpisc(jppo4,1) =  5.77e-7_wp / po4r  
     108      zpisc(jppoc,1) =  1.27e-6_wp   
    90109#  if ! defined key_kriest 
    91       IF ( cn_trc_o(jpgoc) == 'GL ' ) trc_o(:,:,jpgoc) =  5.23e-8_wp   
    92       IF ( cn_trc_o(jpbfe) == 'GL ' ) trc_o(:,:,jpbfe) =  9.84e-13_wp  
     110      zpisc(jpgoc,1) =  5.23e-8_wp   
     111      zpisc(jpbfe,1) =  9.84e-13_wp  
    93112#  else 
    94       IF ( cn_trc_o(jpnum) == 'GL ' ) trc_o(:,:,jpnum) = 0. ! could not get this value since did not use it 
     113      zpisc(jpnum,1) = 0. ! could not get this value since did not use it 
    95114#  endif 
    96       IF ( cn_trc_o(jpsil) == 'GL ' ) trc_o(:,:,jpsil) =  7.36e-6_wp   
    97       IF ( cn_trc_o(jpdsi) == 'GL ' ) trc_o(:,:,jpdsi) =  1.07e-7_wp  
    98       IF ( cn_trc_o(jpgsi) == 'GL ' ) trc_o(:,:,jpgsi) =  1.53e-8_wp 
    99       IF ( cn_trc_o(jpphy) == 'GL ' ) trc_o(:,:,jpphy) =  9.57e-8_wp 
    100       IF ( cn_trc_o(jpdia) == 'GL ' ) trc_o(:,:,jpdia) =  4.24e-7_wp 
    101       IF ( cn_trc_o(jpzoo) == 'GL ' ) trc_o(:,:,jpzoo) =  6.07e-7_wp 
    102       IF ( cn_trc_o(jpmes) == 'GL ' ) trc_o(:,:,jpmes) =  3.44e-7_wp 
    103       IF ( cn_trc_o(jpfer) == 'GL ' ) trc_o(:,:,jpfer) =  4.06e-10_wp 
    104       IF ( cn_trc_o(jpsfe) == 'GL ' ) trc_o(:,:,jpsfe) =  2.51e-11_wp 
    105       IF ( cn_trc_o(jpdfe) == 'GL ' ) trc_o(:,:,jpdfe) =  6.57e-12_wp 
    106       IF ( cn_trc_o(jpnfe) == 'GL ' ) trc_o(:,:,jpnfe) =  1.76e-11_wp 
    107       IF ( cn_trc_o(jpnch) == 'GL ' ) trc_o(:,:,jpnch) =  1.67e-7_wp 
    108       IF ( cn_trc_o(jpdch) == 'GL ' ) trc_o(:,:,jpdch) =  1.02e-7_wp 
    109       IF ( cn_trc_o(jpno3) == 'GL ' ) trc_o(:,:,jpno3) =  5.79e-6_wp / rno3  
    110       IF ( cn_trc_o(jpnh4) == 'GL ' ) trc_o(:,:,jpnh4) =  3.22e-7_wp / rno3 
     115      zpisc(jpsil,1) =  7.36e-6_wp   
     116      zpisc(jpdsi,1) =  1.07e-7_wp  
     117      zpisc(jpgsi,1) =  1.53e-8_wp 
     118      zpisc(jpphy,1) =  9.57e-8_wp 
     119      zpisc(jpdia,1) =  4.24e-7_wp 
     120      zpisc(jpzoo,1) =  6.07e-7_wp 
     121      zpisc(jpmes,1) =  3.44e-7_wp 
     122      zpisc(jpfer,1) =  4.06e-10_wp 
     123      zpisc(jpsfe,1) =  2.51e-11_wp 
     124      zpisc(jpdfe,1) =  6.57e-12_wp 
     125      zpisc(jpnfe,1) =  1.76e-11_wp 
     126      zpisc(jpnch,1) =  1.67e-7_wp 
     127      zpisc(jpdch,1) =  1.02e-7_wp 
     128      zpisc(jpno3,1) =  5.79e-6_wp / rno3  
     129      zpisc(jpnh4,1) =  3.22e-7_wp / rno3 
    111130 
    112131      !--- Arctic specificities (dissolved inorganic & DOM) 
    113       IF ( cn_trc_o(jpdic) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdic) =  1.98e-3_wp  ; END WHERE ; ENDIF 
    114       IF ( cn_trc_o(jpdoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdoc) =  6.00e-6_wp  ; END WHERE ; ENDIF 
    115       IF ( cn_trc_o(jptal) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jptal) =  2.13e-3_wp  ; END WHERE ; ENDIF 
    116       IF ( cn_trc_o(jpoxy) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpoxy) =  3.65e-4_wp  ; END WHERE ; ENDIF 
    117       IF ( cn_trc_o(jpcal) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpcal) =  1.50e-9_wp  ; END WHERE ; ENDIF 
    118       IF ( cn_trc_o(jppo4) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jppo4) =  4.09e-7_wp / po4r ; END WHERE ; ENDIF 
    119       IF ( cn_trc_o(jppoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jppoc) =  4.05e-7_wp  ; END WHERE ; ENDIF 
     132      zpisc(jpdic,2) =  1.98e-3_wp  
     133      zpisc(jpdoc,2) =  6.00e-6_wp  
     134      zpisc(jptal,2) =  2.13e-3_wp  
     135      zpisc(jpoxy,2) =  3.65e-4_wp   
     136      zpisc(jpcal,2) =  1.50e-9_wp   
     137      zpisc(jppo4,2) =  4.09e-7_wp / po4r  
     138      zpisc(jppoc,2) =  4.05e-7_wp   
    120139#  if ! defined key_kriest 
    121       IF ( cn_trc_o(jpgoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpgoc) =  2.84e-8_wp  ; END WHERE ; ENDIF 
    122       IF ( cn_trc_o(jpbfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpbfe) =  7.03e-13_wp ; END WHERE ; ENDIF 
     140      zpisc(jpgoc,2) =  2.84e-8_wp   
     141      zpisc(jpbfe,2) =  7.03e-13_wp  
    123142#  else 
    124       IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnum) =  0.00e-00_wp ; END WHERE ; ENDIF 
     143      zpisc(jpnum,2) =  0.00e-00_wp  
    125144#  endif 
    126       IF ( cn_trc_o(jpsil) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpsil) =  6.87e-6_wp  ; END WHERE ; ENDIF 
    127       IF ( cn_trc_o(jpdsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdsi) =  1.73e-7_wp  ; END WHERE ; ENDIF 
    128       IF ( cn_trc_o(jpgsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpgsi) =  7.93e-9_wp  ; END WHERE ; ENDIF 
    129       IF ( cn_trc_o(jpphy) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpphy) =  5.25e-7_wp  ; END WHERE ; ENDIF 
    130       IF ( cn_trc_o(jpdia) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdia) =  7.75e-7_wp  ; END WHERE ; ENDIF 
    131       IF ( cn_trc_o(jpzoo) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpzoo) =  3.34e-7_wp  ; END WHERE ; ENDIF 
    132       IF ( cn_trc_o(jpmes) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpmes) =  2.49e-7_wp  ; END WHERE ; ENDIF 
    133       IF ( cn_trc_o(jpfer) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpfer) =  1.43e-9_wp  ; END WHERE ; ENDIF 
    134       IF ( cn_trc_o(jpsfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpsfe) =  2.21e-11_wp ; END WHERE ; ENDIF 
    135       IF ( cn_trc_o(jpdfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdfe) =  2.04e-11_wp ; END WHERE ; ENDIF 
    136       IF ( cn_trc_o(jpnfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnfe) =  1.75e-11_wp ; END WHERE ; ENDIF 
    137       IF ( cn_trc_o(jpnch) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnch) =  1.46e-07_wp ; END WHERE ; ENDIF 
    138       IF ( cn_trc_o(jpdch) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdch) =  2.36e-07_wp ; END WHERE ; ENDIF 
    139       IF ( cn_trc_o(jpno3) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpno3) =  3.51e-06_wp / rno3 ; END WHERE ; ENDIF 
    140       IF ( cn_trc_o(jpnh4) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnh4) =  6.15e-08_wp / rno3 ; END WHERE ; ENDIF 
     145      zpisc(jpsil,2) =  6.87e-6_wp   
     146      zpisc(jpdsi,2) =  1.73e-7_wp  
     147      zpisc(jpgsi,2) =  7.93e-9_wp 
     148      zpisc(jpphy,2) =  5.25e-7_wp   
     149      zpisc(jpdia,2) =  7.75e-7_wp  
     150      zpisc(jpzoo,2) =  3.34e-7_wp 
     151      zpisc(jpmes,2) =  2.49e-7_wp   
     152      zpisc(jpfer,2) =  1.43e-9_wp  
     153      zpisc(jpsfe,2) =  2.21e-11_wp  
     154      zpisc(jpdfe,2) =  2.04e-11_wp  
     155      zpisc(jpnfe,2) =  1.75e-11_wp  
     156      zpisc(jpnch,2) =  1.46e-07_wp  
     157      zpisc(jpdch,2) =  2.36e-07_wp  
     158      zpisc(jpno3,2) =  3.51e-06_wp / rno3  
     159      zpisc(jpnh4,2) =  6.15e-08_wp / rno3  
    141160 
    142161      !--- Antarctic specificities (dissolved inorganic & DOM) 
    143       IF ( cn_trc_o(jpdic) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdic) =  2.20e-3_wp  ; END WHERE ; ENDIF 
    144       IF ( cn_trc_o(jpdoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdoc) =  7.02e-6_wp  ; END WHERE ; ENDIF 
    145       IF ( cn_trc_o(jptal) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jptal) =  2.37e-3_wp  ; END WHERE ; ENDIF 
    146       IF ( cn_trc_o(jpoxy) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpoxy) =  3.42e-4_wp  ; END WHERE ; ENDIF 
    147       IF ( cn_trc_o(jpcal) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpcal) =  3.17e-9_wp  ; END WHERE ; ENDIF 
    148       IF ( cn_trc_o(jppo4) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jppo4) =  1.88e-6_wp / po4r  ; END WHERE ; ENDIF 
    149       IF ( cn_trc_o(jppoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jppoc) =  1.13e-6_wp  ; END WHERE ; ENDIF 
     162      zpisc(jpdic,3) =  2.20e-3_wp   
     163      zpisc(jpdoc,3) =  7.02e-6_wp   
     164      zpisc(jptal,3) =  2.37e-3_wp   
     165      zpisc(jpoxy,3) =  3.42e-4_wp   
     166      zpisc(jpcal,3) =  3.17e-9_wp   
     167      zpisc(jppo4,3) =  1.88e-6_wp / po4r   
     168      zpisc(jppoc,3) =  1.13e-6_wp   
    150169#  if ! defined key_kriest 
    151       IF ( cn_trc_o(jpgoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpgoc) =  2.89e-8_wp  ; END WHERE ; ENDIF 
    152       IF ( cn_trc_o(jpbfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpbfe) =  5.63e-13_wp ; END WHERE ; ENDIF 
     170      zpisc(jpgoc,3) =  2.89e-8_wp   
     171      zpisc(jpbfe,3) =  5.63e-13_wp  
    153172#  else 
    154       IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnum) =  0.00e-00_wp ; END WHERE ; ENDIF 
     173      zpisc(jpnum,3) =  0.00e-00_wp  
    155174#  endif 
    156       IF ( cn_trc_o(jpsil) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpsil) =  4.96e-5_wp  ; END WHERE ; ENDIF 
    157       IF ( cn_trc_o(jpdsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdsi) =  5.63e-7_wp  ; END WHERE ; ENDIF 
    158       IF ( cn_trc_o(jpgsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpgsi) =  5.35e-8_wp  ; END WHERE ; ENDIF 
    159       IF ( cn_trc_o(jpphy) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpphy) =  8.10e-7_wp  ; END WHERE ; ENDIF 
    160       IF ( cn_trc_o(jpdia) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdia) =  5.77e-7_wp  ; END WHERE ; ENDIF 
    161       IF ( cn_trc_o(jpzoo) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpzoo) =  6.68e-7_wp  ; END WHERE ; ENDIF 
    162       IF ( cn_trc_o(jpmes) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpmes) =  3.55e-7_wp  ; END WHERE ; ENDIF 
    163       IF ( cn_trc_o(jpfer) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpfer) =  1.62e-10_wp ; END WHERE ; ENDIF 
    164       IF ( cn_trc_o(jpsfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpsfe) =  2.29e-11_wp ; END WHERE ; ENDIF 
    165       IF ( cn_trc_o(jpdfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdfe) =  8.75e-12_wp ; END WHERE ; ENDIF 
    166       IF ( cn_trc_o(jpnfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnfe) =  1.48e-11_wp ; END WHERE ; ENDIF 
    167       IF ( cn_trc_o(jpnch) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnch) =  2.02e-7_wp  ; END WHERE ; ENDIF 
    168       IF ( cn_trc_o(jpdch) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpdch) =  1.60e-7_wp  ; END WHERE ; ENDIF 
    169       IF ( cn_trc_o(jpno3) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpno3) =  2.64e-5_wp / rno3  ; END WHERE ; ENDIF 
    170       IF ( cn_trc_o(jpnh4) == 'AA ' ) THEN ; WHERE( gphit(:,:) <  00._wp ) ; trc_o(:,:,jpnh4) =  3.39e-7_wp / rno3  ; END WHERE ; ENDIF 
     175      zpisc(jpsil,3) =  4.96e-5_wp   
     176      zpisc(jpdsi,3) =  5.63e-7_wp  
     177      zpisc(jpgsi,3) =  5.35e-8_wp 
     178      zpisc(jpphy,3) =  8.10e-7_wp   
     179      zpisc(jpdia,3) =  5.77e-7_wp  
     180      zpisc(jpzoo,3) =  6.68e-7_wp 
     181      zpisc(jpmes,3) =  3.55e-7_wp   
     182      zpisc(jpfer,3) =  1.62e-10_wp 
     183      zpisc(jpsfe,3) =  2.29e-11_wp  
     184      zpisc(jpdfe,3) =  8.75e-12_wp 
     185      zpisc(jpnfe,3) =  1.48e-11_wp  
     186      zpisc(jpnch,3) =  2.02e-7_wp   
     187      zpisc(jpdch,3) =  1.60e-7_wp   
     188      zpisc(jpno3,3) =  2.64e-5_wp / rno3   
     189      zpisc(jpnh4,3) =  3.39e-7_wp / rno3   
    171190 
    172191      !--- Baltic Sea particular case for ORCA configurations 
    173       IF( cp_cfg == "orca" ) THEN            ! Baltic mask 
    174          WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    & 
    175                 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 
    176          trc_o(:,:,jpdic) = 1.14e-3_wp 
    177          trc_o(:,:,jpdoc) = 1.06e-5_wp 
    178          trc_o(:,:,jptal) = 1.16e-3_wp 
    179          trc_o(:,:,jpoxy) = 3.71e-4_wp 
    180          trc_o(:,:,jpcal) = 1.51e-9_wp 
    181          trc_o(:,:,jppo4) = 2.85e-9_wp / po4r 
    182          trc_o(:,:,jppoc) = 4.84e-7_wp 
     192      zpisc(jpdic,4) = 1.14e-3_wp 
     193      zpisc(jpdoc,4) = 1.06e-5_wp 
     194      zpisc(jptal,4) = 1.16e-3_wp 
     195      zpisc(jpoxy,4) = 3.71e-4_wp 
     196      zpisc(jpcal,4) = 1.51e-9_wp 
     197      zpisc(jppo4,4) = 2.85e-9_wp / po4r 
     198      zpisc(jppoc,4) = 4.84e-7_wp 
    183199#  if ! defined key_kriest 
    184          trc_o(:,:,jpgoc) = 1.05e-8_wp 
    185          trc_o(:,:,jpbfe) = 4.97e-13_wp 
     200      zpisc(jpgoc,4) = 1.05e-8_wp 
     201      zpisc(jpbfe,4) = 4.97e-13_wp 
    186202#  else 
    187          trc_o(:,:,jpnum) = 0. ! could not get this value 
     203      zpisc(jpnum,4) = 0. ! could not get this value 
    188204#  endif 
    189          trc_o(:,:,jpsil) = 4.91e-5_wp 
    190          trc_o(:,:,jpdsi) = 3.25e-7_wp 
    191          trc_o(:,:,jpgsi) = 1.93e-8_wp 
    192          trc_o(:,:,jpphy) = 6.64e-7_wp 
    193          trc_o(:,:,jpdia) = 3.41e-7_wp 
    194          trc_o(:,:,jpzoo) = 3.83e-7_wp 
    195          trc_o(:,:,jpmes) = 0.225e-6_wp 
    196          trc_o(:,:,jpfer) = 2.45e-9_wp 
    197          trc_o(:,:,jpsfe) = 3.89e-11_wp 
    198          trc_o(:,:,jpdfe) = 1.33e-11_wp 
    199          trc_o(:,:,jpnfe) = 2.62e-11_wp 
    200          trc_o(:,:,jpnch) = 1.17e-7_wp 
    201          trc_o(:,:,jpdch) = 9.69e-8_wp 
    202          trc_o(:,:,jpno3) = 5.36e-5_wp / rno3 
    203          trc_o(:,:,jpnh4) = 7.18e-7_wp / rno3 
    204          END WHERE 
    205       ENDIF ! cfg 
     205      zpisc(jpsil,4) = 4.91e-5_wp 
     206      zpisc(jpdsi,4) = 3.25e-7_wp 
     207      zpisc(jpgsi,4) = 1.93e-8_wp 
     208      zpisc(jpphy,4) = 6.64e-7_wp 
     209      zpisc(jpdia,4) = 3.41e-7_wp 
     210      zpisc(jpzoo,4) = 3.83e-7_wp 
     211      zpisc(jpmes,4) = 0.225e-6_wp 
     212      zpisc(jpfer,4) = 2.45e-9_wp 
     213      zpisc(jpsfe,4) = 3.89e-11_wp 
     214      zpisc(jpdfe,4) = 1.33e-11_wp 
     215      zpisc(jpnfe,4) = 2.62e-11_wp 
     216      zpisc(jpnch,4) = 1.17e-7_wp 
     217      zpisc(jpdch,4) = 9.69e-8_wp 
     218      zpisc(jpno3,4) = 5.36e-5_wp / rno3 
     219      zpisc(jpnh4,4) = 7.18e-7_wp / rno3 
     220  
     221      DO jn = jp_pcs0, jp_pcs1 
     222         IF( cn_trc_o(jn) == 'GL ' ) trc_o(:,:,jn) = zpisc(jn,1)  ! Global case 
     223         IF( cn_trc_o(jn) == 'AA ' ) THEN  
     224            WHERE( gphit(:,:) >= 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,2) ; END WHERE ! Arctic  
     225            WHERE( gphit(:,:) <  0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic  
     226         ENDIF 
     227         IF( cp_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations 
     228             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    & 
     229                    54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 
     230                    trc_o(:,:,jn) = zpisc(jn,4) 
     231            END WHERE 
     232         ENDIF  
     233      ENDDO 
     234 
     235 
    206236 
    207237      !----------------------------- 
    … …  
    217247 
    218248      DO jn = jp_pcs0, jp_pcs1 
    219          IF ( trc_ice_ratio(jn) >= 0._wp )  zratio(jn,:) = trc_ice_ratio(jn) 
    220          IF ( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:) 
    221          IF ( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp 
     249         IF( trc_ice_ratio(jn) >= 0._wp )  zratio(jn,:) = trc_ice_ratio(jn) 
     250         IF( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:) 
     251         IF( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp 
    222252      END DO 
    223253 
    … …  
    227257      DO jn = jp_pcs0, jp_pcs1 
    228258         !-- Everywhere but in the Baltic 
    229          IF ( trc_ice_ratio(jn) >= -1._wp ) THEN !! no prescribed concentration 
    230                                               !! (typically everything but iron)  
     259         IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; typically everything but iron)  
    231260            trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn)  
    232          ELSE                                 !! prescribed concentration 
     261         ELSE                                    ! prescribed concentration 
    233262            trc_i(:,:,jn) = trc_ice_prescr(jn) 
    234263         ENDIF 
    235264        
    236265         !-- Baltic 
    237          IF( cp_cfg == "orca" ) THEN !! Baltic treated seperately for ORCA configs 
    238             IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN !! no prescribed concentration 
    239                                                  !! (typically everything but iron)  
     266         IF( cp_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs 
     267            IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron)  
    240268               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    & 
    241269                      54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 
    242270                     trc_i(:,:,jn) = zratio(jn,2) * trc_o(:,:,jn)  
    243271               END WHERE 
    244             ELSE                                 !! prescribed tracer concentration in ice 
     272            ELSE                                 ! prescribed tracer concentration in ice 
    245273               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    & 
    246274                   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 
    … …  
    251279      ! 
    252280      END DO ! jn 
    253  
    254    END SUBROUTINE trc_ice_ini_pisces 
     281#endif 
     282 
     283   END SUBROUTINE p4z_ice_ini 
     284 
     285   SUBROUTINE p2z_ice_ini 
     286#if defined key_pisces_reduced  
     287      !!---------------------------------------------------------------------- 
     288      !!                   ***  ROUTINE p2z_ice_ini *** 
     289      !! 
     290      !! ** Purpose :   Initialisation of the LOBSTER biochemical model 
     291      !!---------------------------------------------------------------------- 
     292#endif 
     293   END SUBROUTINE p2z_ice_ini 
     294 
    255295 
    256296#else 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r5260 r5989  
    2727   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module 
    2828 
    29  
    30 #  include "top_substitute.h90" 
    3129   !!---------------------------------------------------------------------- 
    3230   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    7169      USE p4zmort         !  Mortality terms for phytoplankton 
    7270      USE p4zlys          !  Calcite saturation 
     71      USE p4zsed          !  Sedimentation & burial 
    7372      ! 
    7473      REAL(wp), SAVE :: sco2   =  2.312e-3_wp 
    75       REAL(wp), SAVE :: alka0  =  2.423e-3_wp 
     74      REAL(wp), SAVE :: alka0  =  2.426e-3_wp 
    7675      REAL(wp), SAVE :: oxyg0  =  177.6e-6_wp  
    77       REAL(wp), SAVE :: po4    =  2.174e-6_wp  
     76      REAL(wp), SAVE :: po4    =  2.165e-6_wp  
    7877      REAL(wp), SAVE :: bioma0 =  1.000e-8_wp   
    79       REAL(wp), SAVE :: silic1 =  91.65e-6_wp   
    80       REAL(wp), SAVE :: no3    =  31.04e-6_wp * 7.625_wp 
     78      REAL(wp), SAVE :: silic1 =  91.51e-6_wp   
     79      REAL(wp), SAVE :: no3    =  30.9e-6_wp * 7.625_wp 
    8180      ! 
    8281      INTEGER  ::  ji, jj, jk, ierr 
    … …  
    9796      ierr = ierr +  p4z_rem_alloc() 
    9897      ierr = ierr +  p4z_flx_alloc() 
     98      ierr = ierr +  p4z_sed_alloc() 
    9999      ! 
    100100      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    … …  
    107107      CALL p4z_sms_init       !  Maint routine 
    108108      !                                            ! Time-step 
    109       rfact   = rdttrc(1)                          ! --------- 
    110       rfactr  = 1. / rfact 
    111       rfact2  = rfact / FLOAT( nrdttrc ) 
    112       rfact2r = 1. / rfact2 
    113  
    114       IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1) 
    115       IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2 
    116  
    117  
    118109 
    119110      ! Set biological ratios 
    … …  
    165156      END IF 
    166157 
    167       ! Time step duration for biology 
    168       xstep = rfact2 / rday 
    169158 
    170159      CALL p4z_sink_init      !  vertical flux of particulate organic matter 

  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90

    r5260 r5989  
    2121   PUBLIC trc_wri_pisces  
    2222 
    23 #  include "top_substitute.h90" 
     23   !! * Substitutions 
     24#  include "domzgr_substitute.h90" 
     25 
    2426CONTAINS 
    2527 
Note: See TracChangeset for help on using the changeset viewer.