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 5901 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2015-11-20T09:39:06+01:00 (8 years ago)
Author:
jamesharle
Message:

merging branch with head of the trunk

Location:
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC
Files:
2 deleted
75 edited
5 copied

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r5038 r5901  
    5050 
    5151   !! * Substitutions 
    52 #  include "top_substitute.h90" 
    53  
     52#  include "domzgr_substitute.h90" 
    5453   !!---------------------------------------------------------------------- 
    5554   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    56    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $  
     55   !! $Id$  
    5756   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5857   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/C14b/trcwri_c14b.F90

    r5038 r5901  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && key_c14b && defined key_iomput 
     8#if defined key_top && defined key_c14b && defined key_iomput 
    99   !!---------------------------------------------------------------------- 
    1010   !!   'key_c14b'                                           c14b model 
    … …  
    2020   PUBLIC trc_wri_c14b  
    2121 
    22 #  include "top_substitute.h90" 
    2322CONTAINS 
    2423 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r5038 r5901  
    5151 
    5252   !! * Substitutions 
    53 #  include "top_substitute.h90" 
     53#  include "domzgr_substitute.h90" 
    5454   !!---------------------------------------------------------------------- 
    5555   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90

    r5038 r5901  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && key_cfc && defined key_iomput 
     8#if defined key_top && defined key_cfc && defined key_iomput 
    99   !!---------------------------------------------------------------------- 
    1010   !!   'key_cfc'                                           cfc model 
    … …  
    2020   PUBLIC trc_wri_cfc  
    2121 
    22 #  include "top_substitute.h90" 
    2322CONTAINS 
    2423 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90

    r2787 r5901  
    4242 
    4343      IF(lwp) WRITE(numout,*) 
    44       IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: initialisation of MY_TRC model' 
     44      IF(lwp) WRITE(numout,*) ' trc_ini_my_trc: passive tracer unit vector' 
     45      IF(lwp) WRITE(numout,*) ' To check conservation : ' 
     46      IF(lwp) WRITE(numout,*) '   1 - No sea-ice model ' 
     47      IF(lwp) WRITE(numout,*) '   2 - No runoff '  
     48      IF(lwp) WRITE(numout,*) '   3 - precipitation and evaporation equal to 1 : E=P=1 '  
    4549      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    4650       
    47       IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0. 
     51      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 1. 
    4852      ! 
    4953   END SUBROUTINE trc_ini_my_trc 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r5038 r5901  
    4646      INTEGER ::   jn   ! dummy loop index 
    4747      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt 
    48 !!---------------------------------------------------------------------- 
     48      !!---------------------------------------------------------------------- 
    4949      ! 
    5050      IF( nn_timing == 1 )  CALL timing_start('trc_sms_my_trc') 
    … …  
    5555 
    5656      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
    57  
    58       WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) ) 
    59         trn(:,:,1,jpmyt1) = 1._wp 
    60         trb(:,:,1,jpmyt1) = 1._wp 
    61         tra(:,:,1,jpmyt1) = 0._wp 
    62       END WHERE 
    6357 
    6458      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r5038 r5901  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && key_my_trc && defined key_iomput 
     8#if defined key_top && defined key_my_trc && defined key_iomput 
    99   !!---------------------------------------------------------------------- 
    1010   !!   'key_my_trc'                                           my_trc model 
    … …  
    2020   PUBLIC trc_wri_my_trc  
    2121 
    22 #  include "top_substitute.h90" 
    2322CONTAINS 
    2423 

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

    • Property svn:keywords set to Id
    r5038 r5901  
    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) 
    65    !! $Id: p2zbio.F90 3294 2012-01-28 16:44:18Z rblod $  
     66   !! $Id$  
    6667   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6768   !!---------------------------------------------------------------------- 
    … …  
    599600 
    600601   !!====================================================================== 
    601 END MODULE  p2zbio 
     602END MODULE p2zbio 

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

    • Property svn:keywords set to Id
    r5038 r5901  
    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) 
    47    !! $Id: trcexp.F90 3294 2012-01-28 16:44:18Z rblod $  
     48   !! $Id$  
    4849   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4950   !!---------------------------------------------------------------------- 

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

    • Property svn:keywords set to Id
    r5038 r5901  
    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) 
    46    !! $Id: trcopt.F90 3294 2012-01-28 16:44:18Z rblod $  
     46   !! $Id$  
    4747   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4848   !!---------------------------------------------------------------------- 
    … …  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    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) 
    40    !! $Id: p2z_sed.F90 3294 2012-01-28 16:44:18Z rblod $  
     40   !! $Id$  
    4141   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 

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

    • Property svn:keywords set to Id
    r5038 r5901  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    34    !! $Id: p2zsms.F90 3294 2012-01-28 16:44:18Z rblod $  
     34   !! $Id$  
    3535   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    … …  
    8484 
    8585   !!====================================================================== 
    86 END MODULE  p2zsms 
     86END MODULE p2zsms 

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

    r4529 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    • Property svn:keywords set to Id
    r3557 r5901  
    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) 
    170    !! $Id: p4zche.F90 3294 2012-01-28 16:44:18Z rblod $  
     170   !! $Id$  
    171171   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    172172   !!---------------------------------------------------------------------- 
    … …  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    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) 
    65    !! $Id: p4zflx.F90 3294 2012-01-28 16:44:18Z rblod $  
     65   !! $Id$  
    6666   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6767   !!---------------------------------------------------------------------- 
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90

    • Property svn:keywords set to Id
    r3446 r5901  
    2626   !!---------------------------------------------------------------------- 
    2727   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    28    !! $Id: p4zint.F90 3294 2012-01-28 16:44:18Z rblod $  
     28   !! $Id$  
    2929   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3030   !!---------------------------------------------------------------------- 
    … …  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    3535 
    3636 
    37    !!* Substitution 
    38 #  include "top_substitute.h90" 
    3937   !!---------------------------------------------------------------------- 
    4038   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id: p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod $  
     39   !! $Id$  
    4240   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4341   !!---------------------------------------------------------------------- 
    … …  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    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) 
    87    !! $Header:$  
     88   !! $Id$  
    8889   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    8990   !!---------------------------------------------------------------------- 
    … …  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    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) 
    44    !! $Header:$  
     44   !! $Id$  
    4545   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    77   !!        !  06-12  (C. Ethe)  Orignal 
    88   !!---------------------------------------------------------------------- 
     9   !! $Id$ 
    910#if defined key_sed 
    1011   !! Domain characteristics 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90

    • Property svn:keywords set to Id
    r4292 r5901  
    160160   INTEGER, PUBLIC ::  numsed = 27    ! units 
    161161 
     162   !! $Id$ 
    162163CONTAINS 
    163164 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2323   REAL(wp) :: eps = 1.e-13 
    2424 
     25   !! $Id$ 
    2526CONTAINS 
    2627 
    … …  
    438439   !! MODULE sedbtb  :   Dummy module  
    439440   !!====================================================================== 
     441   !! $Id$ 
    440442CONTAINS 
    441443   SUBROUTINE sed_adv( kt )         ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2929   !!---------------------------------------------------------------------- 
    3030   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    31    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp $  
     31   !! $Id$  
    3232   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    1212 
    1313 
     14   !! $Id$ 
    1415CONTAINS 
    1516    
    … …  
    7778   !! MODULE sedbtb  :   Dummy module  
    7879   !!====================================================================== 
     80   !! $Id$ 
    7981CONTAINS 
    8082   SUBROUTINE sed_btb( kt )         ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    163163   DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/ 
    164164 
     165   !! $Id$ 
    165166CONTAINS 
    166167 
    … …  
    559560   !! MODULE sedchem  :   Dummy module  
    560561   !!====================================================================== 
     562   !! $Id$ 
    561563CONTAINS 
    562564   SUBROUTINE sed_chem( kt )         ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2323   !!---------------------------------------------------------------------- 
    2424 
     25   !! $Id$ 
    2526CONTAINS 
    2627 
    … …  
    188189   !! MODULE sedco3  :   Dummy module  
    189190   !!====================================================================== 
     191   !! $Id$ 
    190192CONTAINS 
    191193   SUBROUTINE sed_co3( kt )         ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2020   REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC ::  dens_mol_wgt  ! molecular density  
    2121 
     22   !! $Id$ 
    2223CONTAINS 
    2324    
    … …  
    530531   !! MODULE seddsr  :   Dummy module  
    531532   !!====================================================================== 
     533   !! $Id$ 
    532534CONTAINS 
    533535   SUBROUTINE sed_dsr ( kt ) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2828#endif 
    2929 
     30   !! $Id$ 
    3031CONTAINS 
    3132 
    … …  
    268269   !! MODULE seddta  :   Dummy module  
    269270   !!====================================================================== 
     271   !! $Id$ 
    270272CONTAINS 
    271273   SUBROUTINE sed_dta ( kt ) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90

    • Property svn:keywords set to Id
    r4292 r5901  
    5555   PUBLIC sed_init          ! routine called by opa.F90 
    5656 
     57   !! $Id$ 
    5758CONTAINS 
    5859 
    … …  
    856857   !!   Dummy module :                      NO Sediment model 
    857858   !!---------------------------------------------------------------------- 
     859   !! $Id$ 
    858860CONTAINS 
    859861   SUBROUTINE sed_ini              ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2222 
    2323 
     24   !! $Id$ 
    2425 CONTAINS 
    2526 
    … …  
    257258   !! MODULE sedmat  :   Dummy module  
    258259   !!====================================================================== 
     260   !! $Id$ 
    259261CONTAINS 
    260262   SUBROUTINE sed_mat         ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    3636   REAL(wp)  :: src13ca   
    3737 
     38   !! $Id$ 
    3839CONTAINS 
    3940 
    … …  
    311312   !! MODULE sedmbc :   Dummy module  
    312313   !!====================================================================== 
     314   !! $Id$ 
    313315CONTAINS 
    314316   SUBROUTINE sed_mbc( kt )         ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    1717   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag 
    1818 
     19   !! $Id$ 
    1920CONTAINS 
    2021 
    … …  
    4748   !!====================================================================== 
    4849   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag 
     50   !! $Id$ 
    4951CONTAINS 
    5052   SUBROUTINE sed_model( kt )         ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2525    
    2626    
     27   !! $Id$ 
    2728CONTAINS 
    2829 
    … …  
    270271   !! MODULE sedrst :   Dummy module  
    271272   !!====================================================================== 
     273   !! $Id$ 
    272274CONTAINS 
    273275   SUBROUTINE sed_rst_read                      ! Empty routines 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    1212   PUBLIC sed_sfc 
    1313 
     14   !! $Id$ 
    1415CONTAINS 
    1516 
    … …  
    6768   !! MODULE sedsfc  :   Dummy module  
    6869   !!====================================================================== 
     70   !! $Id$ 
    6971CONTAINS 
    7072   SUBROUTINE sed_sfc ( kt ) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2323   PUBLIC sed_stp  ! called by step.F90 
    2424 
     25   !! $Id$ 
    2526CONTAINS 
    2627 
    … …  
    6970   !! MODULE sedstp  :   Dummy module  
    7071   !!====================================================================== 
     72   !! $Id$ 
    7173CONTAINS 
    7274   SUBROUTINE sed_stp( kt )         ! Empty routine 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90

    • Property svn:keywords set to Id
    r3443 r5901  
    2525   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51 
    2626 
     27   !! $Id$ 
    2728CONTAINS 
    2829 
    … …  
    264265   !! MODULE sedwri  :   Dummy module 
    265266   !!====================================================================== 
     267   !! $Id$ 
    266268CONTAINS 
    267269   SUBROUTINE sed_wri( kt )         ! Empty routine 

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

    r3680 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90

    r5527 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r5038 r5901  
    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_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90

    r5038 r5901  
    2121   PUBLIC trc_wri_pisces  
    2222 
    23 #  include "top_substitute.h90" 
     23   !! * Substitutions 
     24#  include "domzgr_substitute.h90" 
     25 
    2426CONTAINS 
    2527 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r4610 r5901  
    44   !! Ocean passive tracers:  advection trend  
    55   !!============================================================================== 
    6    !! History :  2.0  !  05-11  (G. Madec)  Original code 
    7    !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers 
     6   !! History :  2.0  !  2005-11  (G. Madec)  Original code 
     7   !!            3.0  !  2010-06  (C. Ethe)   Adapted to passive tracers 
     8   !!            3.7  !  2014-05  (G. Madec, C. Ethe)  Add 2nd/4th order cases for CEN and FCT schemes  
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
    … …  
    1112   !!   'key_top'                                                TOP models 
    1213   !!---------------------------------------------------------------------- 
    13    !!   trc_adv      : compute ocean tracer advection trend 
    14    !!   trc_adv_ctl  : control the different options of advection scheme 
    15    !!---------------------------------------------------------------------- 
    16    USE oce_trc         ! ocean dynamics and active tracers 
    17    USE trc             ! ocean passive tracers variables 
    18    USE trcnam_trp      ! passive tracers transport namelist variables 
    19    USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine) 
    20    USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine) 
    21    USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine) 
    22    USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine) 
    23    USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine) 
    24    USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine) 
    25    USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    26    USE traadv_mle      ! ML eddy induced velocity  (tra_adv_mle    routine) 
    27    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    28    USE prtctl_trc      ! Print control 
     14   !!   trc_adv       : compute ocean tracer advection trend 
     15   !!   trc_adv_ini   : control the different options of advection scheme 
     16   !!---------------------------------------------------------------------- 
     17   USE oce_trc        ! ocean dynamics and active tracers 
     18   USE trc            ! ocean passive tracers variables 
     19   USE traadv_cen     ! centered scheme           (tra_adv_cen  routine) 
     20   USE traadv_fct     ! FCT      scheme           (tra_adv_fct  routine) 
     21   USE traadv_mus     ! MUSCL    scheme           (tra_adv_mus  routine) 
     22   USE traadv_ubs     ! UBS      scheme           (tra_adv_ubs  routine) 
     23   USE traadv_qck     ! QUICKEST scheme           (tra_adv_qck  routine) 
     24   USE traadv_mle     ! ML eddy induced velocity  (tra_adv_mle  routine) 
     25   USE ldftra         ! lateral diffusion coefficient on tracers 
     26   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
     27   ! 
     28   USE prtctl_trc     ! Print control 
    2929 
    3030   IMPLICIT NONE 
    3131   PRIVATE 
    3232 
    33    PUBLIC   trc_adv          ! routine called by step module 
    34    PUBLIC   trc_adv_alloc    ! routine called by nemogcm module 
    35  
    36    INTEGER ::   nadv   ! choice of the type of advection scheme 
     33   PUBLIC   trc_adv        
     34   PUBLIC   trc_adv_alloc  
     35   PUBLIC   trc_adv_ini   
     36 
     37   !                            !!* Namelist namtrc_adv * 
     38   LOGICAL ::   ln_trcadv_cen    ! centered scheme flag 
     39   INTEGER ::      nn_cen_h, nn_cen_v   ! =2/4 : horizontal and vertical choices of the order of CEN scheme 
     40   LOGICAL ::   ln_trcadv_fct    ! FCT scheme flag 
     41   INTEGER ::      nn_fct_h, nn_fct_v   ! =2/4 : horizontal and vertical choices of the order of FCT scheme 
     42   INTEGER ::      nn_fct_zts           ! >=1 : 2nd order FCT with vertical sub-timestepping 
     43   LOGICAL ::   ln_trcadv_mus    ! MUSCL scheme flag 
     44   LOGICAL ::      ln_mus_ups           ! use upstream scheme in vivcinity of river mouths 
     45   LOGICAL ::   ln_trcadv_ubs    ! UBS scheme flag 
     46   INTEGER ::      nn_ubs_v             ! =2/4 : vertical choice of the order of UBS scheme 
     47   LOGICAL ::   ln_trcadv_qck    ! QUICKEST scheme flag 
     48 
     49   !                                        ! choices of advection scheme: 
     50   INTEGER, PARAMETER ::   np_NO_adv  = 0   ! no T-S advection 
     51   INTEGER, PARAMETER ::   np_CEN     = 1   ! 2nd/4th order centered scheme 
     52   INTEGER, PARAMETER ::   np_FCT     = 2   ! 2nd/4th order Flux Corrected Transport scheme 
     53   INTEGER, PARAMETER ::   np_FCT_zts = 3   ! 2nd order FCT scheme with vertical sub-timestepping 
     54   INTEGER, PARAMETER ::   np_MUS     = 4   ! MUSCL scheme 
     55   INTEGER, PARAMETER ::   np_UBS     = 5   ! 3rd order Upstream Biased Scheme 
     56   INTEGER, PARAMETER ::   np_QCK     = 6   ! QUICK scheme 
     57 
     58   INTEGER ::              nadv             ! chosen advection scheme 
     59   ! 
    3760   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    3861   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0 
    … …  
    4265#  include "vectopt_loop_substitute.h90" 
    4366   !!---------------------------------------------------------------------- 
    44    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     67   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    4568   !! $Id$  
    4669   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5275      !!                  ***  ROUTINE trc_adv_alloc  *** 
    5376      !!---------------------------------------------------------------------- 
    54  
     77      ! 
    5578      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 
    56  
     79      ! 
    5780      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
    58  
     81      ! 
    5982   END FUNCTION trc_adv_alloc 
    6083 
    … …  
    6891      !! ** Method  : - Update the tracer with the advection term following nadv 
    6992      !!---------------------------------------------------------------------- 
    70       !! 
    7193      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7294      ! 
    73       INTEGER ::   jk  
     95      INTEGER ::   jk   ! dummy loop index 
    7496      CHARACTER (len=22) ::   charout 
    7597      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
    7698      !!---------------------------------------------------------------------- 
    7799      ! 
    78       IF( nn_timing == 1 )  CALL timing_start('trc_adv') 
    79       ! 
    80       CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 
    81       ! 
    82  
    83       IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options 
    84  
    85       IF( ln_top_euler) THEN 
    86          r2dt(:) =  rdttrc(:)              ! = rdttrc (use Euler time stepping) 
    87       ELSE 
    88          IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    89             r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    90          ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
    91             r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    92          ENDIF 
    93       ENDIF 
    94  
    95       !                                                   ! effective transport 
     100      IF( nn_timing == 1 )   CALL timing_start('trc_adv') 
     101      ! 
     102      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
     103      ! 
     104      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
     105         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
     106      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
     107         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
     108      ENDIF 
     109      !                                               !==  effective transport  ==! 
    96110      DO jk = 1, jpkm1 
    97          !                                                ! eulerian transport only 
    98          zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     111         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    99112         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    100113         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    101          ! 
    102114      END DO 
    103115      ! 
    104       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
     116      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    105117         zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    106118         zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
    107119      ENDIF 
    108120      ! 
    109       zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    110       zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    111       zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom 
    112  
    113       IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 
    114          &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 
    115       ! 
    116       IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )    ! add the mle transport (if necessary) 
    117       ! 
    118       SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    119       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
    120       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
    121       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups )   !  MUSCL  
    122       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
    123       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
    124       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
    125       ! 
    126       CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    127          CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )           
    128          WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout) 
    129                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    130          CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    131          WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout) 
    132                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    133          CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra, ln_trcadv_msc_ups  )           
    134          WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout) 
    135                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    136          CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    137          WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout) 
    138                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    139          CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    140          WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout) 
    141                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    142          CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    143          WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout) 
    144                                            CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    145          ! 
     121      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
     122         &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
     123      ! 
     124      IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
     125      ! 
     126      zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
     127      zvn(:,:,jpk) = 0._wp 
     128      zwn(:,:,jpk) = 0._wp 
     129      ! 
     130      ! 
     131      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
     132      ! 
     133      CASE ( np_CEN )                                    ! Centered : 2nd / 4th order 
     134         CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
     135      CASE ( np_FCT )                                    ! FCT      : 2nd / 4th order 
     136         CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
     137      CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting 
     138         CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts ) 
     139      CASE ( np_MUS )                                    ! MUSCL 
     140         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     141      CASE ( np_UBS )                                    ! UBS 
     142         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   ) 
     143      CASE ( np_QCK )                                    ! QUICKEST 
     144         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     145      ! 
    146146      END SELECT 
    147  
    148       !                                              ! print mean trends (used for debugging) 
    149       IF( ln_ctl )   THEN 
     147      !                   
     148      IF( ln_ctl )   THEN                             !== print mean trends (used for debugging) 
    150149         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout) 
    151150                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    152151      END IF 
    153152      ! 
    154       CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     153      CALL wrk_dealloc( jpi,jpj,jpk,  zun, zvn, zwn ) 
    155154      ! 
    156155      IF( nn_timing == 1 )  CALL timing_stop('trc_adv') 
    … …  
    159158 
    160159 
    161    SUBROUTINE trc_adv_ctl 
     160   SUBROUTINE trc_adv_ini 
    162161      !!--------------------------------------------------------------------- 
    163       !!                  ***  ROUTINE trc_adv_ctl  *** 
     162      !!                  ***  ROUTINE trc_adv_ini  *** 
    164163      !!                 
    165164      !! ** Purpose : Control the consistency between namelist options for  
    … …  
    167166      !!---------------------------------------------------------------------- 
    168167      INTEGER ::   ioptio 
    169       !!---------------------------------------------------------------------- 
    170  
    171       ioptio = 0                      ! Parameter control 
    172       IF( ln_trcadv_cen2   )   ioptio = ioptio + 1 
    173       IF( ln_trcadv_tvd    )   ioptio = ioptio + 1 
    174       IF( ln_trcadv_muscl  )   ioptio = ioptio + 1 
    175       IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1 
    176       IF( ln_trcadv_ubs    )   ioptio = ioptio + 1 
    177       IF( ln_trcadv_qck    )   ioptio = ioptio + 1 
    178       IF( lk_esopa         )   ioptio =          1 
    179  
     168      INTEGER ::  ios                 ! Local integer output status for namelist read 
     169      !! 
     170      NAMELIST/namtrc_adv/ ln_trcadv_cen, nn_cen_h, nn_cen_v,               &   ! CEN 
     171         &                 ln_trcadv_fct, nn_fct_h, nn_fct_v, nn_fct_zts,   &   ! FCT 
     172         &                 ln_trcadv_mus,                     ln_mus_ups,   &   ! MUSCL 
     173         &                 ln_trcadv_ubs,           nn_ubs_v,               &   ! UBS 
     174         &                 ln_trcadv_qck                                        ! QCK 
     175      !!---------------------------------------------------------------------- 
     176      ! 
     177      REWIND( numnat_ref )              !  namtrc_adv in reference namelist  
     178      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 
     179901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 
     180 
     181      REWIND( numnat_cfg )              ! namtrc_adv in configuration namelist 
     182      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 
     183902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 
     184      IF(lwm) WRITE ( numont, namtrc_adv ) 
     185 
     186      IF(lwp) THEN                    ! Namelist print 
     187         WRITE(numout,*) 
     188         WRITE(numout,*) 'trc_adv_ini : choice/control of the tracer advection scheme' 
     189         WRITE(numout,*) '~~~~~~~~~~~' 
     190         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers' 
     191         WRITE(numout,*) '      centered scheme                           ln_trcadv_cen = ', ln_trcadv_cen 
     192         WRITE(numout,*) '            horizontal 2nd/4th order               nn_cen_h   = ', nn_fct_h 
     193         WRITE(numout,*) '            vertical   2nd/4th order               nn_cen_v   = ', nn_fct_v 
     194         WRITE(numout,*) '      Flux Corrected Transport scheme           ln_trcadv_fct = ', ln_trcadv_fct 
     195         WRITE(numout,*) '            horizontal 2nd/4th order               nn_fct_h   = ', nn_fct_h 
     196         WRITE(numout,*) '            vertical   2nd/4th order               nn_fct_v   = ', nn_fct_v 
     197         WRITE(numout,*) '            2nd order + vertical sub-timestepping  nn_fct_zts = ', nn_fct_zts 
     198         WRITE(numout,*) '      MUSCL scheme                              ln_trcadv_mus = ', ln_trcadv_mus 
     199         WRITE(numout,*) '            + upstream scheme near river mouths    ln_mus_ups = ', ln_mus_ups 
     200         WRITE(numout,*) '      UBS scheme                                ln_trcadv_ubs = ', ln_trcadv_ubs 
     201         WRITE(numout,*) '            vertical   2nd/4th order               nn_ubs_v   = ', nn_ubs_v 
     202         WRITE(numout,*) '      QUICKEST scheme                           ln_trcadv_qck = ', ln_trcadv_qck 
     203      ENDIF 
     204      ! 
     205 
     206      ioptio = 0                       !==  Parameter control  ==! 
     207      IF( ln_trcadv_cen )   ioptio = ioptio + 1 
     208      IF( ln_trcadv_fct )   ioptio = ioptio + 1 
     209      IF( ln_trcadv_mus )   ioptio = ioptio + 1 
     210      IF( ln_trcadv_ubs )   ioptio = ioptio + 1 
     211      IF( ln_trcadv_qck )   ioptio = ioptio + 1 
     212 
     213      ! 
     214      IF( ioptio == 0 ) THEN 
     215         nadv = np_NO_adv 
     216         CALL ctl_warn( 'trc_adv_init: You are running without tracer advection.' ) 
     217      ENDIF 
    180218      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 
    181  
    182       !                              ! Set nadv 
    183       IF( ln_trcadv_cen2   )   nadv =  1 
    184       IF( ln_trcadv_tvd    )   nadv =  2 
    185       IF( ln_trcadv_muscl  )   nadv =  3 
    186       IF( ln_trcadv_muscl2 )   nadv =  4 
    187       IF( ln_trcadv_ubs    )   nadv =  5 
    188       IF( ln_trcadv_qck    )   nadv =  6 
    189       IF( lk_esopa         )   nadv = -1 
    190  
     219      ! 
     220      IF( ln_trcadv_cen .AND. ( nn_cen_h /= 2 .AND. nn_cen_h /= 4 )   & 
     221                        .AND. ( nn_cen_v /= 2 .AND. nn_cen_v /= 4 )   ) THEN 
     222        CALL ctl_stop( 'trc_adv_init: CEN scheme, choose 2nd or 4th order' ) 
     223      ENDIF 
     224      IF( ln_trcadv_fct .AND. ( nn_fct_h /= 2 .AND. nn_fct_h /= 4 )   & 
     225                        .AND. ( nn_fct_v /= 2 .AND. nn_fct_v /= 4 )   ) THEN 
     226        CALL ctl_stop( 'trc_adv_init: FCT scheme, choose 2nd or 4th order' ) 
     227      ENDIF 
     228      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 ) THEN 
     229         IF( nn_fct_h == 4 ) THEN 
     230            nn_fct_h = 2 
     231            CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' ) 
     232         ENDIF 
     233         IF( lk_vvl ) THEN 
     234            CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' ) 
     235         ENDIF 
     236         IF( nn_fct_zts == 1 )   CALL ctl_warn( 'trc_adv_init: FCT with ONE sub-timestep = FCT without sub-timestep' ) 
     237      ENDIF 
     238      IF( ln_trcadv_ubs .AND. ( nn_ubs_v /= 2 .AND. nn_ubs_v /= 4 )   ) THEN 
     239        CALL ctl_stop( 'trc_adv_init: UBS scheme, choose 2nd or 4th order' ) 
     240      ENDIF 
     241      IF( ln_trcadv_ubs .AND. nn_ubs_v == 4 ) THEN 
     242         CALL ctl_warn( 'trc_adv_init: UBS scheme, only 2nd FCT scheme available on the vertical. It will be used' ) 
     243      ENDIF 
     244      IF( ln_isfcav ) THEN                                                       ! ice-shelf cavities 
     245         IF(  ln_trcadv_cen .AND. nn_cen_v /= 4    .OR.   &                            ! NO 4th order with ISF 
     246            & ln_trcadv_fct .AND. nn_fct_v /= 4   )   CALL ctl_stop( 'tra_adv_init: 4th order COMPACT scheme not allowed with ISF' ) 
     247      ENDIF 
     248      ! 
     249      !                                !==  used advection scheme  ==! 
     250      !                                      ! set nadv 
     251      IF( ln_trcadv_cen                      )   nadv = np_CEN 
     252      IF( ln_trcadv_fct                      )   nadv = np_FCT 
     253      IF( ln_trcadv_fct .AND. nn_fct_zts > 0 )   nadv = np_FCT_zts 
     254      IF( ln_trcadv_mus                      )   nadv = np_MUS 
     255      IF( ln_trcadv_ubs                      )   nadv = np_UBS 
     256      IF( ln_trcadv_qck                      )   nadv = np_QCK 
     257      ! 
    191258      IF(lwp) THEN                   ! Print the choice 
    192259         WRITE(numout,*) 
    193          IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used' 
    194          IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used' 
    195          IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used' 
    196          IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used' 
    197          IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used' 
    198          IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used' 
    199          IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme' 
    200       ENDIF 
    201       ! 
    202    END SUBROUTINE trc_adv_ctl 
     260         IF( nadv == np_NO_adv  )   WRITE(numout,*) '         NO passive tracer advection' 
     261         IF( nadv == np_CEN     )   WRITE(numout,*) '         CEN      scheme is used. Horizontal order: ', nn_cen_h,   & 
     262            &                                                                        ' Vertical   order: ', nn_cen_v 
     263         IF( nadv == np_FCT     )   WRITE(numout,*) '         FCT      scheme is used. Horizontal order: ', nn_fct_h,   & 
     264            &                                                                       ' Vertical   order: ', nn_fct_v 
     265         IF( nadv == np_FCT_zts )   WRITE(numout,*) '         use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 
     266         IF( nadv == np_MUS     )   WRITE(numout,*) '         MUSCL    scheme is used' 
     267         IF( nadv == np_UBS     )   WRITE(numout,*) '         UBS      scheme is used' 
     268         IF( nadv == np_QCK     )   WRITE(numout,*) '         QUICKEST scheme is used' 
     269      ENDIF 
     270      ! 
     271   END SUBROUTINE trc_adv_ini 
    203272    
    204273#else 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r5038 r5901  
    2222   USE oce_trc             ! ocean dynamics and active tracers variables 
    2323   USE trc                 ! ocean passive tracers variables 
    24    USE trcnam_trp      ! passive tracers transport namelist variables 
    2524   USE trabbl              !  
    2625   USE prtctl_trc          ! Print control for debbuging 
    … …  
    3029   PUBLIC   trc_bbl       !  routine called by step.F90 
    3130 
    32  
    33    !! * Substitutions 
    34 #  include "top_substitute.h90" 
    3531   !!---------------------------------------------------------------------- 
    3632   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r5038 r5901  
    1818   USE oce_trc         ! ocean dynamics and tracers variables 
    1919   USE trc             ! ocean passive tracers variables 
    20    USE trcnam_trp      ! passive tracers transport namelist variables 
    2120   USE trcdta 
    2221   USE tradmp 
    … …  
    2423   USE trdtra 
    2524   USE trd_oce 
     25   USE iom 
    2626 
    2727   IMPLICIT NONE 
    2828   PRIVATE 
    2929 
    30    PUBLIC trc_dmp            ! routine called by step.F90 
    31    PUBLIC trc_dmp_clo        ! routine called by step.F90 
    32    PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90 
     30   PUBLIC trc_dmp       
     31   PUBLIC trc_dmp_clo    
     32   PUBLIC trc_dmp_alloc   
     33   PUBLIC trc_dmp_ini     
     34 
     35   INTEGER , PUBLIC ::   nn_zdmp_tr    ! = 0/1/2 flag for damping in the mixed layer 
     36   CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr    !File containing restoration coefficient 
    3337 
    3438   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1) 
    … …  
    3943 
    4044   !! * Substitutions 
    41 #  include "top_substitute.h90" 
     45#  include "domzgr_substitute.h90" 
     46#  include "vectopt_loop_substitute.h90" 
    4247   !!---------------------------------------------------------------------- 
    4348   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    44    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $  
     49   !! $Id$  
    4550   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4651   !!---------------------------------------------------------------------- 
    … …  
    8994      IF( nn_timing == 1 )  CALL timing_start('trc_dmp') 
    9095      ! 
    91       ! 0. Initialization (first time-step only) 
    92       !    -------------- 
    93       IF( kt == nittrc000 ) CALL trc_dmp_init 
    94  
    9596      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends 
    9697      ! 
    … …  
    125126                     DO jj = 2, jpjm1 
    126127                        DO ji = fs_2, fs_jpim1   ! vector opt. 
    127                            IF( avt(ji,jj,jk) <= 5.e-4 )  THEN  
     128                           IF( avt(ji,jj,jk) <= 5.e-4_wp )  THEN  
    128129                              ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 
    129130                              tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    … …  
    170171   END SUBROUTINE trc_dmp 
    171172 
     173   SUBROUTINE trc_dmp_ini 
     174      !!---------------------------------------------------------------------- 
     175      !!                  ***  ROUTINE trc_dmp_ini  *** 
     176      !!  
     177      !! ** Purpose :   Initialization for the newtonian damping  
     178      !! 
     179      !! ** Method  :   read the nammbf namelist and check the parameters 
     180      !!              called by trc_dmp at the first timestep (nittrc000) 
     181      !!---------------------------------------------------------------------- 
     182      ! 
     183      INTEGER ::  ios                 ! Local integer output status for namelist read 
     184      INTEGER :: imask  !local file handle 
     185      ! 
     186      NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 
     187      !!---------------------------------------------------------------------- 
     188 
     189      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
     190      ! 
     191 
     192      REWIND( numnat_ref )              ! Namelist namtrc_dmp in reference namelist : Passive tracers newtonian damping 
     193      READ  ( numnat_ref, namtrc_dmp, IOSTAT = ios, ERR = 909) 
     194909   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in reference namelist', lwp ) 
     195 
     196      REWIND( numnat_cfg )              ! Namelist namtrc_dmp in configuration namelist : Passive tracers newtonian damping 
     197      READ  ( numnat_cfg, namtrc_dmp, IOSTAT = ios, ERR = 910) 
     198910   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dmp in configuration namelist', lwp ) 
     199      IF(lwm) WRITE ( numont, namtrc_dmp ) 
     200 
     201      IF(lwp) THEN                       ! Namelist print 
     202         WRITE(numout,*) 
     203         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping' 
     204         WRITE(numout,*) '~~~~~~~' 
     205         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter' 
     206         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 
     207         WRITE(numout,*) '      Restoration coeff file    cn_resto_tr = ', cn_resto_tr 
     208      ENDIF 
     209      ! 
     210      IF( lzoom .AND. .NOT.lk_c1d )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
     211      SELECT CASE ( nn_zdmp_tr ) 
     212      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
     213      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     214      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
     215      CASE DEFAULT 
     216         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 
     217         CALL ctl_stop(ctmp1) 
     218      END SELECT 
     219 
     220      IF( .NOT.lk_c1d ) THEN 
     221         IF( .NOT. ln_tradmp )   & 
     222            &   CALL ctl_stop( 'passive trace damping need ln_tradmp to compute damping coef.' ) 
     223         ! 
     224         !                          ! Read damping coefficients from file 
     225         !Read in mask from file 
     226         CALL iom_open ( cn_resto_tr, imask) 
     227         CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr) 
     228         CALL iom_close( imask ) 
     229         ! 
     230      ENDIF 
     231      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init') 
     232      ! 
     233   END SUBROUTINE trc_dmp_ini 
     234 
    172235   SUBROUTINE trc_dmp_clo( kt ) 
    173236      !!--------------------------------------------------------------------- 
    … …  
    184247      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    185248      ! 
    186       INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indicesa 
     249      INTEGER :: ji , jj, jk, jn, jl, jc                     ! dummy loop indicesa 
     250      INTEGER :: isrow                                      ! local index 
    187251      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta       ! 3D  workspace 
    188252 
    … …  
    200264            ! 
    201265            SELECT CASE ( jp_cfg ) 
     266            !                                           ! ======================= 
     267            CASE ( 1 )                                  ! eORCA_R1 configuration 
     268            !                                           ! ======================= 
     269            isrow = 332 - jpjglo 
     270            ! 
     271                                                        ! Caspian Sea 
     272            nctsi1(1)   = 332  ; nctsj1(1)   = 243 - isrow 
     273            nctsi2(1)   = 344  ; nctsj2(1)   = 275 - isrow 
     274            !                                         
    202275            !                                           ! ======================= 
    203276            CASE ( 2 )                                  !  ORCA_R2 configuration 
    … …  
    292365 
    293366 
    294    SUBROUTINE trc_dmp_init 
    295       !!---------------------------------------------------------------------- 
    296       !!                  ***  ROUTINE trc_dmp_init  *** 
    297       !!  
    298       !! ** Purpose :   Initialization for the newtonian damping  
    299       !! 
    300       !! ** Method  :   read the nammbf namelist and check the parameters 
    301       !!              called by trc_dmp at the first timestep (nittrc000) 
    302       !!---------------------------------------------------------------------- 
    303       ! 
    304       IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
    305       ! 
    306       SELECT CASE ( nn_hdmp_tr ) 
    307       CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
    308       CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp_tr, ' degrees' 
    309       CASE DEFAULT 
    310          WRITE(ctmp1,*) '          bad flag value for nn_hdmp_tr = ', nn_hdmp_tr 
    311          CALL ctl_stop(ctmp1) 
    312       END SELECT 
    313  
    314       IF( lzoom )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
    315       SELECT CASE ( nn_zdmp_tr ) 
    316       CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    317       CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
    318       CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
    319       CASE DEFAULT 
    320          WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 
    321          CALL ctl_stop(ctmp1) 
    322       END SELECT 
    323  
    324       IF( .NOT. ln_tradmp )   & 
    325          &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' ) 
    326       ! 
    327       !                          ! Damping coefficients initialization 
    328       IF( lzoom ) THEN   ;   CALL dtacof_zoom( restotr ) 
    329       ELSE               ;   CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr,  & 
    330                              &            nn_file_tr, 'TRC'     , restotr                ) 
    331       ENDIF 
    332       ! 
    333       IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init') 
    334       ! 
    335    END SUBROUTINE trc_dmp_init 
    336  
    337367#else 
    338368   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r5038 r5901  
    44   !! Ocean Passive tracers : lateral diffusive trends 
    55   !!===================================================================== 
    6    !! History :  9.0  ! 2005-11 (G. Madec)  Original code 
    7    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
     6   !! History :  1.0  ! 2005-11  (G. Madec)  Original code 
     7   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
     8   !!            3.7  ! 2014-03  (G. Madec)  LDF simplification 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
    … …  
    1112   !!   'key_top'                                                TOP models 
    1213   !!---------------------------------------------------------------------- 
    13    !!---------------------------------------------------------------------- 
    14    !!   trc_ldf     : update the tracer trend with the lateral diffusion 
    15    !!       ldf_ctl : initialization, namelist read, and parameters control 
    16    !!---------------------------------------------------------------------- 
    17    USE oce_trc         ! ocean dynamics and active tracers 
    18    USE trc             ! ocean passive tracers variables 
    19    USE trcnam_trp      ! passive tracers transport namelist variables 
    20    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    21    USE ldfslp          ! ??? 
    22    USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine) 
    23    USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine) 
    24    USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine) 
    25    USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    26    USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine) 
    27    USE trd_oce 
    28    USE trdtra 
     14   !!   trc_ldf      : update the tracer trend with the lateral diffusion 
     15   !!   trc_ldf_ini  : initialization, namelist read, and parameters control 
     16   !!---------------------------------------------------------------------- 
     17   USE trc           ! ocean passive tracers variables 
     18   USE oce_trc       ! ocean dynamics and active tracers 
     19   USE ldfslp        ! lateral diffusion: iso-neutral slope 
     20   USE traldf_lap    ! lateral diffusion: laplacian iso-level            operator  (tra_ldf_lap   routine) 
     21   USE traldf_iso    ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso   routine) 
     22   USE traldf_triad  ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_triad routine) 
     23   USE traldf_blp    ! lateral diffusion (iso-level lap/blp)                       (tra_ldf_lap   routine) 
     24   USE trd_oce       ! trends: ocean variables 
     25   USE trdtra        ! trends manager: tracers  
     26   ! 
    2927   USE prtctl_trc      ! Print control 
    3028 
    … …  
    3230   PRIVATE 
    3331 
    34    PUBLIC   trc_ldf    ! called by step.F90 
    35    !                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
    36    REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient 
     32   PUBLIC   trc_ldf     
     33   PUBLIC   trc_ldf_ini    
     34   ! 
     35   LOGICAL , PUBLIC ::   ln_trcldf_lap       !:   laplacian operator 
     36   LOGICAL , PUBLIC ::   ln_trcldf_blp       !: bilaplacian operator 
     37   LOGICAL , PUBLIC ::   ln_trcldf_lev       !: iso-level   direction 
     38   LOGICAL , PUBLIC ::   ln_trcldf_hor       !: horizontal  direction (rotation to geopotential) 
     39   LOGICAL , PUBLIC ::   ln_trcldf_iso       !: iso-neutral direction (standard) 
     40   LOGICAL , PUBLIC ::   ln_trcldf_triad     !: iso-neutral direction (triad) 
     41   REAL(wp), PUBLIC ::   rn_ahtrc_0          !:   laplacian diffusivity coefficient for passive tracer [m2/s] 
     42   REAL(wp), PUBLIC ::   rn_bhtrc_0          !: bilaplacian      -          --     -       -   [m4/s] 
     43   ! 
     44                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
     45   REAL(wp) ::  rldf    ! ratio between active and passive tracers diffusive coefficient 
    3746   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
     47    
    3848   !! * Substitutions 
    3949#  include "domzgr_substitute.h90" 
    4050#  include "vectopt_loop_substitute.h90" 
    4151   !!---------------------------------------------------------------------- 
    42    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     52   !! NEMO/TOP 3.7 , NEMO Consortium (2014) 
    4353   !! $Id$ 
    4454   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4555   !!---------------------------------------------------------------------- 
    46  
    4756CONTAINS 
    4857 
    … …  
    5867      INTEGER            :: jn 
    5968      CHARACTER (len=22) :: charout 
     69      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zahu, zahv 
    6070      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
    6171      !!---------------------------------------------------------------------- 
    … …  
    6373      IF( nn_timing == 1 )   CALL timing_start('trc_ldf') 
    6474      ! 
    65       IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options 
    66  
    67       rldf = rldf_rat 
    68  
    6975      IF( l_trdtrc )  THEN 
    70          CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
     76         CALL wrk_alloc( jpi,jpj,jpk,jptra,  ztrtrd ) 
    7177         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    7278      ENDIF 
    73  
    74       SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    75       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra        )  ! iso-level laplacian 
    76       CASE ( 1 )                                                                                            ! rotated laplacian 
    77                        IF( ln_traldf_grif ) THEN 
    78                           CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
    79                        ELSE 
    80                           CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 
    81                        ENDIF 
    82       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            )  ! iso-level bilaplacian 
    83       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
    84          ! 
    85       CASE ( -1 )                                     ! esopa: test all possibility with control print 
    86          CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            ) 
    87          WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout) 
    88                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    89          IF( ln_traldf_grif ) THEN 
    90             CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
    91          ELSE 
    92             CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 
    93          ENDIF 
    94          WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    95                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    96          CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra            ) 
    97          WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    98                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    99          CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            ) 
    100          WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout) 
    101                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     79      ! 
     80      !                                        !* set the lateral diffusivity coef. for passive tracer       
     81      CALL wrk_alloc( jpi,jpj,jpk,   zahu, zahv ) 
     82      zahu(:,:,:) = rldf * ahtu(:,:,:) 
     83      zahv(:,:,:) = rldf * ahtv(:,:,:) 
     84 
     85      SELECT CASE ( nldf )                     !* compute lateral mixing trend and add it to the general trend 
     86      ! 
     87      CASE ( np_lap   )                               ! iso-level laplacian 
     88         CALL tra_ldf_lap  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb,      tra, jptra,  1   ) 
     89         ! 
     90      CASE ( np_lap_i )                               ! laplacian : standard iso-neutral operator (Madec) 
     91         CALL tra_ldf_iso  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   ) 
     92         ! 
     93      CASE ( np_lap_it )                              ! laplacian : triad iso-neutral operator (griffies) 
     94         CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra,  1   ) 
     95         ! 
     96      CASE ( np_blp , np_blp_i , np_blp_it )          ! bilaplacian: all operator (iso-level, -neutral) 
     97         CALL tra_ldf_blp  ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb     , tra, jptra, nldf ) 
     98         ! 
    10299      END SELECT 
    103100      ! 
    104       IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     101      IF( l_trdtrc )   THEN                    ! save the horizontal diffusive trends for further diagnostics 
    105102        DO jn = 1, jptra 
    106103           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    … …  
    109106        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    110107      ENDIF 
    111       !                                          ! print mean trends (used for debugging) 
    112       IF( ln_ctl )   THEN 
    113          WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout) 
    114                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    115       ENDIF 
     108      !                                        ! print mean trends (used for debugging) 
     109      IF( ln_ctl ) THEN 
     110         WRITE(charout, FMT="('ldf ')")   ;   CALL prt_ctl_trc_info(charout) 
     111                                              CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     112      ENDIF 
     113      ! 
     114      CALL wrk_dealloc( jpi,jpj,jpk,   zahu, zahv ) 
    116115      ! 
    117116      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf') 
    … …  
    120119 
    121120 
    122    SUBROUTINE ldf_ctl 
     121   SUBROUTINE trc_ldf_ini 
    123122      !!---------------------------------------------------------------------- 
    124123      !!                  ***  ROUTINE ldf_ctl  *** 
    125124      !! 
    126       !! ** Purpose :   Choice of the operator for the lateral tracer diffusion 
     125      !! ** Purpose :   Define the operator for the lateral diffusion 
    127126      !! 
    128127      !! ** Method  :   set nldf from the namtra_ldf logicals 
    129       !!      nldf == -2   No lateral diffusion 
    130       !!      nldf == -1   ESOPA test: ALL operators are used 
    131128      !!      nldf ==  0   laplacian operator 
    132129      !!      nldf ==  1   Rotated laplacian operator 
    … …  
    134131      !!      nldf ==  3   Rotated bilaplacian 
    135132      !!---------------------------------------------------------------------- 
    136       INTEGER ::   ioptio, ierr         ! temporary integers 
    137       !!---------------------------------------------------------------------- 
    138  
    139       IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
    140          IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
    141             rldf_rat = 1.0_wp 
    142          ELSE 
    143             CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    144          END IF 
    145       ELSE 
    146          rldf_rat = rn_ahtrc_0 / rn_aht_0 
    147       END IF 
    148       !  Define the lateral mixing oparator for tracers 
    149       ! =============================================== 
    150  
    151       !                               ! control the input 
     133      INTEGER ::   ioptio, ierr   ! temporary integers 
     134      INTEGER ::   ios            ! Local integer output status for namelist read 
     135      ! 
     136      NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp,                                  & 
     137         &                 ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad,  & 
     138         &                 rn_ahtrc_0   , rn_bhtrc_0 
     139      !!---------------------------------------------------------------------- 
     140      REWIND( numnat_ref )              !  namtrc_ldf in reference namelist  
     141      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903) 
     142903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist', lwp ) 
     143 
     144      REWIND( numnat_cfg )              !  namtrc_ldf in configuration namelist  
     145      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 ) 
     146904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist', lwp ) 
     147      IF(lwm) WRITE ( numont, namtrc_ldf ) 
     148 
     149      IF(lwp) THEN                    ! Namelist print 
     150         WRITE(numout,*) 
     151         WRITE(numout,*) 'trc_ldf_ini : lateral tracer diffusive operator' 
     152         WRITE(numout,*) '~~~~~~~~~~~' 
     153         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 
     154         WRITE(numout,*) '      operator' 
     155         WRITE(numout,*) '           laplacian                 ln_trcldf_lap   = ', ln_trcldf_lap 
     156         WRITE(numout,*) '         bilaplacian                 ln_trcldf_blp   = ', ln_trcldf_blp 
     157         WRITE(numout,*) '      direction of action' 
     158         WRITE(numout,*) '         iso-level                   ln_trcldf_lev   = ', ln_trcldf_lev 
     159         WRITE(numout,*) '         horizontal (geopotential)   ln_trcldf_hor   = ', ln_trcldf_hor 
     160         WRITE(numout,*) '         iso-neutral (standard)      ln_trcldf_iso   = ', ln_trcldf_iso 
     161         WRITE(numout,*) '         iso-neutral (triad)         ln_trcldf_triad = ', ln_trcldf_triad 
     162         WRITE(numout,*) '      diffusivity coefficient' 
     163         WRITE(numout,*) '           laplacian                 rn_ahtrc_0      = ', rn_ahtrc_0 
     164         WRITE(numout,*) '         bilaplacian                 rn_bhtrc_0      = ', rn_bhtrc_0 
     165      ENDIF 
     166      !       
     167      !                                ! control the namelist parameters 
    152168      ioptio = 0 
    153       IF( ln_trcldf_lap   )   ioptio = ioptio + 1 
    154       IF( ln_trcldf_bilap )   ioptio = ioptio + 1 
    155       IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
    156       IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion 
     169      IF( ln_trcldf_lap )   ioptio = ioptio + 1 
     170      IF( ln_trcldf_blp )   ioptio = ioptio + 1 
     171      IF( ioptio >  1   )   CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 
     172      IF( ioptio == 0   )   nldf = np_no_ldf   ! No lateral diffusion 
     173       
     174      IF( ln_trcldf_lap .AND. ln_trcldf_blp )   CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 
     175      IF( ln_trcldf_blp .AND. ln_trcldf_lap )   CALL ctl_stop( 'trc_ldf_ctl:   laplacian should be used on both TRC and TRA' ) 
     176       
    157177      ioptio = 0 
    158       IF( ln_trcldf_level )   ioptio = ioptio + 1 
    159       IF( ln_trcldf_hor   )   ioptio = ioptio + 1 
    160       IF( ln_trcldf_iso   )   ioptio = ioptio + 1 
    161       IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' ) 
     178      IF( ln_trcldf_lev )   ioptio = ioptio + 1 
     179      IF( ln_trcldf_hor )   ioptio = ioptio + 1 
     180      IF( ln_trcldf_iso )   ioptio = ioptio + 1 
     181      IF( ioptio /= 1   )   CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 
    162182 
    163183      ! defined the type of lateral diffusion from ln_trcldf_... logicals 
    164184      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 
    165185      ierr = 0 
    166       IF( ln_trcldf_lap ) THEN       ! laplacian operator 
     186      IF( ln_trcldf_lap ) THEN      !==  laplacian operator  ==! 
    167187         IF ( ln_zco ) THEN                ! z-coordinate 
    168             IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation) 
    169             IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    170             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    171          ENDIF 
    172          IF ( ln_zps ) THEN             ! z-coordinate 
    173             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    174             IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation) 
    175             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    176          ENDIF 
    177          IF ( ln_sco ) THEN             ! z-coordinate 
    178             IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation) 
    179             IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation) 
    180             IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation) 
    181          ENDIF 
    182       ENDIF 
    183  
    184       IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator 
     188            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
     189            IF ( ln_trcldf_hor   )   nldf = np_lap     ! iso-level = horizontal (no rotation) 
     190            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard  (   rotation) 
     191            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad     (   rotation) 
     192         ENDIF 
     193         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     194            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
     195            IF ( ln_trcldf_hor   )   nldf = np_lap     ! horizontal (no rotation) 
     196            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation) 
     197            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation) 
     198         ENDIF 
     199         IF ( ln_sco ) THEN             ! s-coordinate 
     200            IF ( ln_trcldf_lev   )   nldf = np_lap     ! iso-level  (no rotation) 
     201            IF ( ln_trcldf_hor   )   nldf = np_lap_it  ! horizontal (   rotation)       !!gm   a checker.... 
     202            IF ( ln_trcldf_iso   )   nldf = np_lap_i   ! iso-neutral: standard (rotation) 
     203            IF ( ln_trcldf_triad )   nldf = np_lap_it  ! iso-neutral: triad    (rotation) 
     204         ENDIF 
     205         !                                ! diffusivity ratio: passive / active tracers  
     206         IF( ABS(rn_aht_0) < 2._wp*TINY(1.e0) ) THEN 
     207            IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0) ) THEN 
     208               rldf = 1.0_wp 
     209            ELSE 
     210               CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     211            ENDIF 
     212         ELSE 
     213            rldf = rn_ahtrc_0 / rn_aht_0 
     214         ENDIF 
     215      ENDIF 
     216      ! 
     217      IF( ln_trcldf_blp ) THEN      !==  bilaplacian operator  ==! 
    185218         IF ( ln_zco ) THEN                ! z-coordinate 
    186             IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation) 
    187             IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    188             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    189          ENDIF 
    190          IF ( ln_zps ) THEN             ! z-coordinate 
    191             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    192             IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    193             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    194          ENDIF 
    195          IF ( ln_sco ) THEN             ! z-coordinate 
    196             IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation) 
    197             IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation) 
    198             IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    199          ENDIF 
    200       ENDIF 
    201  
     219            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     220            IF ( ln_trcldf_hor   )   nldf = np_blp     ! iso-level = horizontal (no rotation) 
     221            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     222            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     223         ENDIF 
     224         IF ( ln_zps ) THEN             ! z-coordinate with partial step 
     225            IF ( ln_trcldf_lev   )   ierr = 1         ! iso-level not allowed  
     226            IF ( ln_trcldf_hor   )   nldf = np_blp     ! horizontal (no rotation) 
     227            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     228            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     229         ENDIF 
     230         IF ( ln_sco ) THEN             ! s-coordinate 
     231            IF ( ln_trcldf_lev   )   nldf = np_blp     ! iso-level  (no rotation) 
     232            IF ( ln_trcldf_hor   )   nldf = np_blp_it  ! horizontal (   rotation)       !!gm   a checker.... 
     233            IF ( ln_trcldf_iso   )   nldf = np_blp_i   ! iso-neutral: standard (rotation) 
     234            IF ( ln_trcldf_triad )   nldf = np_blp_it  ! iso-neutral: triad    (rotation) 
     235         ENDIF 
     236         !                                ! diffusivity ratio: passive / active tracers  
     237         IF( ABS(rn_bht_0) < 2._wp*TINY(1.e0) ) THEN 
     238            IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1.e0) ) THEN 
     239               rldf = 1.0_wp 
     240            ELSE 
     241               CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     242            ENDIF 
     243         ELSE 
     244            rldf = SQRT(  ABS( rn_bhtrc_0 / rn_bht_0 )  ) 
     245         ENDIF 
     246      ENDIF 
     247      ! 
    202248      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 
    203       IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 
    204       IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   & 
     249      IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso )   & 
    205250           CALL ctl_stop( '          eddy induced velocity on tracers',   & 
    206251           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 
    207252      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation 
    208          IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' ) 
    209 #if defined key_offline 
    210          l_traldf_rot = .TRUE.                 ! needed for trazdf_imp 
    211 #endif 
    212       ENDIF 
    213  
    214       IF( lk_esopa ) THEN 
    215          IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options' 
    216          nldf = -1 
    217       ENDIF 
    218  
    219       IF( .NOT. ln_trcldf_diff ) THEN 
    220          IF(lwp) WRITE(numout,*) '          No lateral diffusion on passive tracers' 
    221          nldf = -2 
    222       ENDIF 
    223  
     253         IF( .NOT.l_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require l_ldfslp' ) 
     254      ENDIF 
     255      ! 
    224256      IF(lwp) THEN 
    225257         WRITE(numout,*) 
    226          IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion' 
    227          IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used' 
    228          IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator' 
    229          IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator' 
    230          IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator' 
    231          IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian' 
    232       ENDIF 
    233  
    234       IF( ln_trcldf_bilap ) THEN 
    235          IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
    236          IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 
    237       ELSE 
    238          IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
    239          IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 
    240       ENDIF 
    241  
    242       ! ratio between active and passive tracers diffusive coef. 
    243       IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
    244          IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
    245             rldf_rat = 1.0_wp 
    246          ELSE 
    247             CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
    248          END IF 
    249       ELSE 
    250          rldf_rat = rn_ahtrc_0 / rn_aht_0 
    251       END IF 
    252       IF( rldf_rat < 0 ) THEN 
    253          IF( .NOT.lk_offline ) THEN  
    254             CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 
    255          ELSE 
    256             CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 
    257          ENDIF  
    258       ENDIF 
    259       ! 
    260    END SUBROUTINE ldf_ctl 
     258         IF( nldf == np_no_ldf )   WRITE(numout,*) '          NO lateral diffusion' 
     259         IF( nldf == np_lap    )   WRITE(numout,*) '          laplacian iso-level operator' 
     260         IF( nldf == np_lap_i  )   WRITE(numout,*) '          Rotated laplacian operator (standard)' 
     261         IF( nldf == np_lap_it )   WRITE(numout,*) '          Rotated laplacian operator (triad)' 
     262         IF( nldf == np_blp    )   WRITE(numout,*) '          bilaplacian iso-level operator' 
     263         IF( nldf == np_blp_i  )   WRITE(numout,*) '          Rotated bilaplacian operator (standard)' 
     264         IF( nldf == np_blp_it )   WRITE(numout,*) '          Rotated bilaplacian operator (triad)' 
     265      ENDIF 
     266      ! 
     267   END SUBROUTINE trc_ldf_ini 
    261268#else 
    262269   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r5038 r5901  
    102102      ENDIF 
    103103 
     104#if defined key_agrif 
     105      CALL Agrif_trc                   ! AGRIF zoom boundaries 
     106#endif 
    104107      ! Update after tracer on domain lateral boundaries 
    105108      DO jn = 1, jptra 
    … …  
    111114!!      CALL bdy_trc( kt )               ! BDY open boundaries 
    112115#endif 
    113 #if defined key_agrif 
    114       CALL Agrif_trc                   ! AGRIF zoom boundaries 
    115 #endif 
    116116 
    117117 
    118118      ! set time step size (Euler/Leapfrog) 
    119119      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler) 
    120       ELSEIF( kt <= nittrc000 + 1 )            THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
     120      ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
    121121      ENDIF 
    122122 
    … …  
    137137      ELSE 
    138138         ! Leap-Frog + Asselin filter time stepping 
    139          IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl)  
    140          ELSE                ;   CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     139         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      & 
     140           &                                                                sbc_trc, sbc_trc_b, jptra )      ! variable volume level (vvl)  
     141         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
    141142         ENDIF 
    142143      ENDIF 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r5038 r5901  
    2222   PRIVATE 
    2323 
    24    PUBLIC trc_rad         ! routine called by trcstp.F90 
    25  
    26    !! * Substitutions 
    27 #  include "top_substitute.h90" 
     24   PUBLIC trc_rad      
     25   PUBLIC trc_rad_ini   
     26 
     27   LOGICAL , PUBLIC ::   ln_trcrad           !: flag to artificially correct negative concentrations 
     28 
    2829   !!---------------------------------------------------------------------- 
    2930   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    7677      ! 
    7778   END SUBROUTINE trc_rad 
     79 
     80   SUBROUTINE trc_rad_ini 
     81      !!--------------------------------------------------------------------- 
     82      !!                  ***  ROUTINE trc _rad_ini *** 
     83      !! 
     84      !! ** Purpose : read  namelist options  
     85      !!---------------------------------------------------------------------- 
     86      INTEGER ::  ios                 ! Local integer output status for namelist read 
     87      NAMELIST/namtrc_rad/ ln_trcrad 
     88      !!---------------------------------------------------------------------- 
     89 
     90      ! 
     91      REWIND( numnat_ref )              ! namtrc_rad in reference namelist  
     92      READ  ( numnat_ref, namtrc_rad, IOSTAT = ios, ERR = 907) 
     93907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in reference namelist', lwp ) 
     94 
     95      REWIND( numnat_cfg )              ! namtrc_rad in configuration namelist  
     96      READ  ( numnat_cfg, namtrc_rad, IOSTAT = ios, ERR = 908 ) 
     97908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_rad in configuration namelist', lwp ) 
     98      IF(lwm) WRITE ( numont, namtrc_rad ) 
     99 
     100      IF(lwp) THEN                     !   ! Control print 
     101         WRITE(numout,*) 
     102         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations' 
     103         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad 
     104      ENDIF 
     105      ! 
     106   END SUBROUTINE trc_rad_ini 
    78107 
    79108   SUBROUTINE trc_rad_sms( kt, ptrb, ptrn, jp_sms0, jp_sms1, cpreserv ) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r5038 r5901  
    1919   USE trc             ! ocean  passive tracers variables 
    2020   USE prtctl_trc      ! Print control for debbuging 
     21   USE iom 
    2122   USE trd_oce 
    2223   USE trdtra 
    … …  
    2728   PUBLIC   trc_sbc   ! routine called by step.F90 
    2829 
     30   REAL(wp) ::   r2dt  !  time-step at surface 
     31 
    2932   !! * Substitutions 
    30 #  include "top_substitute.h90" 
     33#  include "domzgr_substitute.h90" 
     34#  include "vectopt_loop_substitute.h90" 
    3135   !!---------------------------------------------------------------------- 
    3236   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    6064      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    6165      ! 
    62       INTEGER  ::   ji, jj, jn           ! dummy loop indices 
    63       REAL(wp) ::   zsrau, zse3t   ! temporary scalars 
     66      INTEGER  ::   ji, jj, jn                                     ! dummy loop indices 
     67      REAL(wp) ::   zse3t, zrtrn, zratio, zfact                    ! temporary scalars 
     68      REAL(wp) ::   zswitch, zftra, zcd, zdtra, ztfx, ztra         ! temporary scalars 
    6469      CHARACTER (len=22) :: charout 
    6570      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsfx 
    6671      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 
     72 
    6773      !!--------------------------------------------------------------------- 
    6874      ! 
    … …  
    7278                      CALL wrk_alloc( jpi, jpj,      zsfx   ) 
    7379      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 
     80      ! 
     81      zrtrn = 1.e-15_wp 
     82 
     83      SELECT CASE( nn_ice_embd )         ! levitating or embedded sea-ice option 
     84         CASE( 0    )   ;   zswitch = 1  ! (0) standard levitating sea-ice : salt exchange only 
     85         CASE( 1, 2 )   ;   zswitch = 0  ! (1) levitating sea-ice: salt and volume exchange but no pressure effect                                 
     86      !                                  ! (2) embedded sea-ice : salt and volume fluxes and pressure 
     87      END SELECT 
     88 
     89      IF( ln_top_euler) THEN 
     90         r2dt =  rdttrc(1)              ! = rdttrc (use Euler time stepping) 
     91      ELSE 
     92         IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
     93            r2dt = rdttrc(1)           ! = rdttrc (restarting with Euler time stepping) 
     94         ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
     95            r2dt = 2. * rdttrc(1)       ! = 2 rdttrc (leapfrog) 
     96         ENDIF 
     97      ENDIF 
     98 
    7499 
    75100      IF( kt == nittrc000 ) THEN 
    … …  
    77102         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 
    78103         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
     104 
     105         IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     106            iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 
     107            IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 
     108            zfact = 0.5_wp 
     109            DO jn = 1, jptra 
     110               CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
     111            END DO 
     112         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
     113           zfact = 1._wp 
     114           sbc_trc_b(:,:,:) = 0._wp 
     115         ENDIF 
     116      ELSE                                         ! Swap of forcing fields 
     117         IF( ln_top_euler ) THEN 
     118            zfact = 1._wp 
     119            sbc_trc_b(:,:,:) = 0._wp 
     120         ELSE 
     121            zfact = 0.5_wp 
     122            sbc_trc_b(:,:,:) = sbc_trc(:,:,:) 
     123         ENDIF 
     124         ! 
    79125      ENDIF 
    80126 
    … …  
    90136 
    91137      ! 0. initialization 
    92       zsrau = 1. / rau0 
    93138      DO jn = 1, jptra 
    94139         ! 
    95140         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    96141         !                                             ! add the trend to the general tracer trend 
     142 
     143         IF ( nn_ice_tr == -1 ) THEN  ! No tracers in sea ice (null concentration in sea ice) 
     144 
     145            DO jj = 2, jpj 
     146               DO ji = fs_2, fs_jpim1   ! vector opt. 
     147                  sbc_trc(ji,jj,jn) = zsfx(ji,jj) * r1_rau0 * trn(ji,jj,1,jn) 
     148               END DO 
     149            END DO 
     150 
     151         ELSE 
     152 
     153            DO jj = 2, jpj 
     154               DO ji = fs_2, fs_jpim1   ! vector opt. 
     155                  zse3t = 1. / fse3t(ji,jj,1) 
     156                  ! tracer flux at the ice/ocean interface (tracer/m2/s) 
     157                  zftra = - trc_i(ji,jj,jn) * fmmflx(ji,jj) ! uptake of tracer in the sea ice 
     158                  zcd   =   trc_o(ji,jj,jn) * fmmflx(ji,jj) ! concentration dilution due to freezing-melting, 
     159                                                               ! only used in the levitating sea ice case 
     160                  ! tracer flux only       : add concentration dilution term in net tracer flux, no F-M in volume flux 
     161                  ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 
     162                  ztfx  = zftra + zswitch * zcd                ! net tracer flux (+C/D if no ice/ocean mass exchange) 
     163    
     164                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )  
     165                  IF ( zdtra < 0. ) THEN 
     166                     zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn ) 
     167                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 
     168                  ENDIF 
     169                  sbc_trc(ji,jj,jn) =  zdtra  
     170               END DO 
     171            END DO 
     172         ENDIF 
     173         !                                       Concentration dilution effect on tracers due to evaporation & precipitation  
    97174         DO jj = 2, jpj 
    98175            DO ji = fs_2, fs_jpim1   ! vector opt. 
    99                zse3t = 1. / fse3t(ji,jj,1) 
    100                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zsfx(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t 
     176               zse3t = zfact / fse3t(ji,jj,1) 
     177               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ( sbc_trc_b(ji,jj,jn) + sbc_trc(ji,jj,jn) ) * zse3t 
    101178            END DO 
    102179         END DO 
    103           
     180         ! 
    104181         IF( l_trdtrc ) THEN 
    105182            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
    … …  
    109186      END DO                                                     ! tracer loop 
    110187      !                                                          ! =========== 
     188 
     189      !                                           Write in the tracer restar  file 
     190      !                                          ******************************* 
     191      IF( lrst_trc ) THEN 
     192         IF(lwp) WRITE(numout,*) 
     193         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in tracer restart file ',   & 
     194            &                    'at it= ', kt,' date= ', ndastp 
     195         IF(lwp) WRITE(numout,*) '~~~~' 
     196         DO jn = 1, jptra 
     197            CALL iom_rstput( kt, nitrst, numrtw, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc(:,:,jn) ) 
     198         END DO 
     199      ENDIF 
     200      ! 
    111201      IF( ln_ctl )   THEN 
    112202         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r5038 r5901  
    1515   USE oce_trc         ! ocean dynamics and active tracers variables 
    1616   USE trc             ! ocean passive tracers variables  
    17    USE trcnam_trp      ! passive tracers transport namelist variables 
    1817   USE trabbl          ! bottom boundary layer               (trc_bbl routine) 
    1918   USE trcbbl          ! bottom boundary layer               (trc_bbl routine) 
    20    USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine) 
    2119   USE trcdmp          ! internal damping                    (trc_dmp routine) 
    2220   USE trcldf          ! lateral mixing                      (trc_ldf routine) 
    … …  
    3836   PUBLIC   trc_trp    ! called by trc_stp 
    3937 
    40    !! * Substitutions 
    41 #  include "top_substitute.h90" 
    4238   !!---------------------------------------------------------------------- 
    4339   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4844CONTAINS 
    4945 
    50    SUBROUTINE trc_trp( kstp ) 
     46   SUBROUTINE trc_trp( kt ) 
    5147      !!---------------------------------------------------------------------- 
    5248      !!                     ***  ROUTINE trc_trp  *** 
    … …  
    5753      !!              - Update the passive tracers 
    5854      !!---------------------------------------------------------------------- 
    59       INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index 
     55      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
    6056      !! --------------------------------------------------------------------- 
    6157      ! 
    … …  
    6460      IF( .NOT. lk_c1d ) THEN 
    6561         ! 
    66                                 CALL trc_sbc( kstp )            ! surface boundary condition 
    67          IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
    68          IF( ln_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
    69          IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kstp )        ! internal damping trends on closed seas only 
    70                                 CALL trc_adv( kstp )            ! horizontal & vertical advection  
    71                                 CALL trc_ldf( kstp )            ! lateral mixing 
    72          IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    73             &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
     62                                CALL trc_sbc    ( kt )      ! surface boundary condition 
     63         IF( lk_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme 
     64         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends 
     65         IF( ln_trcdmp_clo )    CALL trc_dmp_clo( kt )      ! internal damping trends on closed seas only 
     66                                CALL trc_adv    ( kt )      ! horizontal & vertical advection  
     67         !                                                         ! Partial top/bottom cell: GRADh( trb )   
     68         IF( ln_zps ) THEN 
     69           IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom 
     70           ELSE                 ; CALL zps_hde    ( kt, jptra, trb, gtru, gtrv )                                      !  only bottom 
     71           ENDIF 
     72         ENDIF 
     73         !                                                       
     74                                CALL trc_ldf    ( kt )      ! lateral mixing 
    7475#if defined key_agrif 
    75          IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge 
     76         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge 
    7677#endif 
    77                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
    78                                 CALL trc_nxt( kstp )            ! tracer fields at next time step      
    79          IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     78                                CALL trc_zdf    ( kt )      ! vertical mixing and after tracer fields 
     79                                CALL trc_nxt    ( kt )      ! tracer fields at next time step      
     80         IF( ln_trcrad )        CALL trc_rad    ( kt )      ! Correct artificial negative concentrations 
    8081 
    8182#if defined key_agrif 
    82       IF( .NOT. Agrif_Root())   CALL Agrif_Update_Trc( kstp )  ! Update tracer at AGRIF zoom boundaries : children only 
     83         IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only 
    8384#endif 
    84          IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )  ! Partial steps: now horizontal gradient of passive 
    85                                                                 ! tracers at the bottom ocean level 
    8685         ! 
    8786      ELSE                                               ! 1D vertical configuration 
    88                                 CALL trc_sbc( kstp )            ! surface boundary condition 
    89          IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
    90             &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
    91                                 CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
    92                                 CALL trc_nxt( kstp )            ! tracer fields at next time step      
    93           IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     87                                CALL trc_sbc( kt )            ! surface boundary condition 
     88         IF( ln_trcdmp )        CALL trc_dmp( kt )            ! internal damping trends 
     89                                CALL trc_zdf( kt )            ! vertical mixing and after tracer fields 
     90                                CALL trc_nxt( kt )            ! tracer fields at next time step      
     91          IF( ln_trcrad )       CALL trc_rad( kt )            ! Correct artificial negative concentrations 
    9492         ! 
    9593      END IF 
    … …  
    104102   !!---------------------------------------------------------------------- 
    105103CONTAINS 
    106    SUBROUTINE trc_trp( kstp )              ! Empty routine 
    107       INTEGER, INTENT(in) ::   kstp 
    108       WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kstp 
     104   SUBROUTINE trc_trp( kt )              ! Empty routine 
     105      INTEGER, INTENT(in) ::   kt 
     106      WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt 
    109107   END SUBROUTINE trc_trp 
    110108#endif 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r5038 r5901  
    1111   !!   'key_top'                                                TOP models 
    1212   !!---------------------------------------------------------------------- 
    13    !!   trc_ldf     : update the tracer trend with the lateral diffusion 
    14    !!       ldf_ctl : initialization, namelist read, and parameters control 
     13   !!   trc_zdf      : update the tracer trend with the lateral diffusion 
     14   !!   trc_zdf_ini : initialization, namelist read, and parameters control 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce_trc         ! ocean dynamics and active tracers 
    17    USE trc             ! ocean passive tracers variables 
    18    USE trcnam_trp      ! passive tracers transport namelist variables 
    19    USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    20    USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    21    USE trd_oce 
    22    USE trdtra 
    23    USE prtctl_trc      ! Print control 
     16   USE trc           ! ocean passive tracers variables 
     17   USE oce_trc       ! ocean dynamics and active tracers 
     18   USE trd_oce       ! trends: ocean variables 
     19   USE trazdf_exp    ! vertical diffusion: explicit (tra_zdf_exp     routine) 
     20   USE trazdf_imp    ! vertical diffusion: implicit (tra_zdf_imp     routine) 
     21   USE trcldf        ! passive tracers: lateral diffusion 
     22   USE trdtra        ! trends manager: tracers  
     23   USE prtctl_trc    ! Print control 
    2424 
    2525   IMPLICIT NONE 
    2626   PRIVATE 
    2727 
    28    PUBLIC   trc_zdf          ! called by step.F90  
    29    PUBLIC   trc_zdf_alloc    ! called by nemogcm.F90  
     28   PUBLIC   trc_zdf         ! called by step.F90  
     29   PUBLIC   trc_zdf_ini     ! called by nemogcm.F90  
     30   PUBLIC   trc_zdf_alloc   ! called by nemogcm.F90  
     31    
     32   !                                        !!** Vertical diffusion (nam_trczdf) ** 
     33   LOGICAL , PUBLIC ::   ln_trczdf_exp       !: explicit vertical diffusion scheme flag 
     34   INTEGER , PUBLIC ::   nn_trczdf_exp       !: number of sub-time step (explicit time stepping) 
    3035 
    3136   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    … …  
    3944#  include "vectopt_loop_substitute.h90" 
    4045   !!---------------------------------------------------------------------- 
    41    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     46   !! NEMO/TOP 3.7 , NEMO Consortium (2015) 
    4247   !! $Id$  
    4348   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    7176      IF( nn_timing == 1 )  CALL timing_start('trc_zdf') 
    7277      ! 
    73       IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options 
    74  
    75       IF( ln_top_euler) THEN 
    76          r2dt(:) =  rdttrc(:)              ! = rdttrc (use Euler time stepping) 
    77       ELSE 
    78          IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    79             r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    80          ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
    81             r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    82          ENDIF 
     78      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
     79         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping) 
     80      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
     81         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    8382      ENDIF 
    8483 
    … …  
    8988 
    9089      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    91       CASE ( -1 )                                       ! esopa: test all possibility with control print 
    92          CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
    93          WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    94                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    95          CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )  
    96          WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    97                                             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    9890      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    9991      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
    100  
    10192      END SELECT 
    10293 
    … …  
    121112 
    122113 
    123    SUBROUTINE zdf_ctl 
     114   SUBROUTINE trc_zdf_ini 
    124115      !!---------------------------------------------------------------------- 
    125       !!                 ***  ROUTINE zdf_ctl  *** 
     116      !!                 ***  ROUTINE trc_zdf_ini  *** 
    126117      !! 
    127118      !! ** Purpose :   Choose the vertical mixing scheme 
    … …  
    132123      !!      NB: The implicit scheme is required when using :  
    133124      !!             - rotated lateral mixing operator 
    134       !!             - TKE, GLS or KPP vertical mixing scheme 
     125      !!             - TKE, GLS vertical mixing scheme 
    135126      !!---------------------------------------------------------------------- 
    136  
    137       !  Define the vertical tracer physics scheme 
    138       ! ========================================== 
    139  
    140       ! Choice from ln_zdfexp already read in namelist in zdfini module 
    141       IF( ln_trczdf_exp ) THEN           ! use explicit scheme 
    142          nzdf = 0 
    143       ELSE                               ! use implicit scheme 
    144          nzdf = 1 
     127      INTEGER ::  ios                 ! Local integer output status for namelist read 
     128      !! 
     129      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp 
     130      !!---------------------------------------------------------------------- 
     131      ! 
     132      REWIND( numnat_ref )             ! namtrc_zdf in reference namelist  
     133      READ  ( numnat_ref, namtrc_zdf, IOSTAT = ios, ERR = 905) 
     134905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in reference namelist', lwp ) 
     135      ! 
     136      REWIND( numnat_cfg )             ! namtrc_zdf in configuration namelist  
     137      READ  ( numnat_cfg, namtrc_zdf, IOSTAT = ios, ERR = 906 ) 
     138906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_zdf in configuration namelist', lwp ) 
     139      IF(lwm) WRITE ( numont, namtrc_zdf ) 
     140      ! 
     141      IF(lwp) THEN                     ! Control print 
     142         WRITE(numout,*) 
     143         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion  parameters' 
     144         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp 
     145         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp 
    145146      ENDIF 
    146147 
    147       ! Force implicit schemes 
    148       IF( ln_trcldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics 
    149       IF( ln_trcldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate 
    150 #if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp 
    151                                                           nzdf = 1      ! TKE, GLS or KPP physics        
    152 #endif 
    153       IF( ln_trczdf_exp .AND. nzdf == 1 )   THEN 
    154          CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', & 
    155             &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' ) 
     148      !                                ! Define the vertical tracer physics scheme 
     149      IF( ln_trczdf_exp ) THEN   ;   nzdf = 0     ! explicit scheme 
     150      ELSE                       ;   nzdf = 1     ! implicit scheme 
    156151      ENDIF 
    157152 
    158       ! Test: esopa 
    159       IF( lk_esopa )    nzdf = -1                      ! All schemes used 
     153      !                                ! Force implicit schemes 
     154      IF( ln_trcldf_iso              )   nzdf = 1      ! iso-neutral lateral physics 
     155      IF( ln_trcldf_hor .AND. ln_sco )   nzdf = 1      ! horizontal lateral physics in s-coordinate 
     156#if defined key_zdftke || defined key_zdfgls  
     157                                         nzdf = 1      ! TKE or GLS physics        
     158#endif 
     159      IF( ln_trczdf_exp .AND. nzdf == 1 )  &  
     160         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS vertical scheme ', & 
     161            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' ) 
    160162 
    161163      IF(lwp) THEN 
    … …  
    163165         WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme' 
    164166         WRITE(numout,*) '~~~~~~~~~~~' 
    165          IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used' 
    166167         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme' 
    167168         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme' 
    168169      ENDIF 
    169  
    170    END SUBROUTINE zdf_ctl 
     170      ! 
     171   END SUBROUTINE trc_zdf_ini 
     172    
    171173#else 
    172174   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    88   !!                 !  07-06  (C. Deltel)  key_gyre : do not call lbc_lnk 
    99   !!---------------------------------------------------------------------- 
    10 #if   defined key_top && ( defined key_trdmxl_trc   ||   defined key_esopa ) 
     10#if   defined key_top   &&   defined key_trdmxl_trc 
    1111   !!---------------------------------------------------------------------- 
    1212   !!   'key_trdmxl_trc'                      mixed layer trend diagnostics 
    … …  
    2424   USE zdfddm  , ONLY : avs  ! salinity vertical diffusivity coeff. at w-point 
    2525# endif 
    26    USE trcnam_trp        ! passive tracers transport namelist variables 
    2726   USE trdtrc_oce    ! definition of main arrays used for trends computations 
    2827   USE in_out_manager    ! I/O manager 
    … …  
    6766 
    6867   !! * Substitutions 
    69 #  include "top_substitute.h90" 
     68#  include "domzgr_substitute.h90" 
    7069#  include "zdfddm_substitute.h90" 
    7170   !!---------------------------------------------------------------------- 
    7271   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    73    !! $Header:  $  
     72   !! $Id$  
    7473   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7574   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    2323   !!--------------------------------------------------------------------------------- 
    2424   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    25    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp $  
     25   !! $Id$  
    2626   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!--------------------------------------------------------------------------------- 
    … …  
    3939      ! 
    4040      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step deine as a character 
    41       CHARACTER(LEN=50)   ::   clname   ! ice output restart file name 
     41      CHARACTER(LEN=50)   ::   clname   ! output restart file name 
     42      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    4243      CHARACTER (len=35) :: charout 
    4344      INTEGER :: jl,  jk, jn               ! loop indice 
    … …  
    5152         ENDIF 
    5253         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out) 
    53          IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  '//clname 
    54          CALL iom_open( clname, nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib ) 
     54         clpath = TRIM(cn_trcrst_outdir) 
     55         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     56         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  'TRIM(clpath)//TRIM(clname) 
     57         CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib ) 
    5558      ENDIF 
    5659 
    … …  
    133136      INTEGER ::  jlibalt = jprstlib 
    134137      LOGICAL ::  llok 
     138      CHARACTER(LEN=256)  ::   clpath   ! full path to restart file 
    135139      !!----------------------------------------------------------------------------- 
    136140       
    … …  
    141145      ENDIF 
    142146       
     147      clpath = TRIM(cn_trcrst_indir) 
     148      IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     149 
    143150      IF ( jprstlib == jprstdimg ) THEN 
    144151        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    145152        ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90 
    146         INQUIRE( FILE = TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok ) 
     153        INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok ) 
    147154        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    148155      ENDIF 
    149156 
    150       CALL iom_open( cn_trdrst_trc_in, inum, kiolib = jlibalt )  
     157      CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt )  
    151158       
    152159      IF( ln_trdmxl_trc_instant ) THEN  

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    1414   !!---------------------------------------------------------------------- 
    1515   USE trc               ! tracer definitions (trn, trb, tra, etc.) 
    16    USE trcnam_trp 
    1716   USE trd_oce 
    1817   USE trdtrc_oce       ! definition of main arrays used for trends computations 
    … …  
    2928   PUBLIC trd_trc 
    3029 
    31    !! * Substitutions 
    32 #  include "top_substitute.h90" 
    3330   !!---------------------------------------------------------------------- 
    3431   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    35    !! $Header:  $  
     32   !! $Id$  
    3633   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3734   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    44   !! Ocean trends :   set tracer and momentum trend variables 
    55   !!====================================================================== 
    6 #if defined key_top   ||   defined key_esopa 
     6#if defined key_top 
    77   !!---------------------------------------------------------------------- 
    88   !!   'key_top'                                                TOP models 
    … …  
    3030# endif 
    3131 
    32 # if defined key_trdmxl_trc   ||   defined key_esopa 
     32# if defined key_trdmxl_trc 
    3333   !!---------------------------------------------------------------------- 
    3434   !!   'key_trdmxl_trc'                     mixed layer trends diagnostics 
    … …  
    118118   !!---------------------------------------------------------------------- 
    119119   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    120    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $  
     120   !! $Id$  
    121121   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    122122   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5038 r5901  
    1111   !!   'key_top'                                                TOP models 
    1212   !!---------------------------------------------------------------------- 
    13  
    14    !* Domain size * 
     13   ! 
     14   !                                            !* Domain size * 
    1515   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i  
    1616   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j   
    … …  
    2020   USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1   
    2121   USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj 
    22    USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option 
    2322   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature 
    2423   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity 
    2524 
    26    !* IO manager * 
    27    USE in_out_manager     
    28   
    29    !* Memory Allocation * 
    30    USE wrk_nemo       
    31   
    32    !* Timing * 
    33    USE timing     
    34   
    35    !* MPP library                          
    36    USE lib_mpp  
    37  
    38    !* Fortran utilities                          
    39    USE lib_fortran 
    40  
    41    !* Lateral boundary conditions                          
    42    USE lbclnk 
    43  
    44    !* physical constants * 
    45    USE phycst             
    46  
    47    !* 1D configuration 
    48    USE c1d                                          
    49  
    50    !* model domain * 
    51    USE dom_oce  
     25   USE in_out_manager                           !* IO manager * 
     26   USE wrk_nemo                                 !* Memory Allocation * 
     27   USE timing                                   !* Timing *  
     28   USE lib_mpp                                  !* MPP library                          
     29   USE lib_fortran                              !* Fortran utilities                          
     30   USE lbclnk                                   !* Lateral boundary conditions                          
     31   USE phycst                                   !* physical constants * 
     32   USE c1d                                      !* 1D configuration 
     33   USE dom_oce                                  !* model domain * 
    5234 
    5335   USE domvvl, ONLY : un_td, vn_td          !: thickness diffusion transport 
    … …  
    5638 
    5739   !* ocean fields: here now and after fields * 
    58    USE oce , ONLY :   ua      =>    ua      !: i-horizontal velocity (m s-1)  
    59    USE oce , ONLY :   va      =>    va      !: j-horizontal velocity (m s-1) 
    6040   USE oce , ONLY :   un      =>    un      !: i-horizontal velocity (m s-1)  
    6141   USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1) 
    … …  
    6646   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
    6747   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     48   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
     49   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    
     50   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
     51   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
    6852#if defined key_offline 
    6953   USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points 
    7054#endif 
    71    USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
    72    USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1] 
    73    USE oce , ONLY :   hdivb   =>    hdivb   !: horizontal divergence (1/s) 
    74    USE oce , ONLY :   rotb    =>    rotb    !: relative vorticity    [s-1] 
    75    USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    
    76    USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
    77    USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
    78    USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion 
    7955 
    8056   !* surface fluxes * 
    … …  
    8763   USE sbc_oce , ONLY :   fmmflx     =>    fmmflx     !: freshwater budget: volume flux               [Kg/m2/s] 
    8864   USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s] 
    89    USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Daily mean to Diurnal Cycle short wave (qsr)  
     65   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Diurnal Cycle  
     66   USE sbc_oce , ONLY :   ncpl_qsr_freq   =>   ncpl_qsr_freq   !: qsr coupling frequency per days from atmospher 
    9067   USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths 
    9168   USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1) 
     69   USE sbc_oce , ONLY :   nn_ice_embd => nn_ice_embd  !: flag for  levitating/embedding sea-ice in the ocean 
    9270   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface 
    9371   USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction 
    … …  
    9674   USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.) 
    9775   USE sbcrnf  , ONLY :   h_rnf      =>    h_rnf      !: river runoff   [Kg/m2/s] 
     76   USE sbcrnf  , ONLY :   nk_rnf     =>    nk_rnf     !: depth of runoff in model level 
    9877 
    9978   USE trc_oce 
    10079 
     80!!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line) 
     81!!gm   so the following lines should be removed....   logical should be the one of TRC namelist 
     82!!gm   In case off coarsening....  the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all. 
    10183   !* lateral diffusivity (tracers) * 
    102    USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity 
    103    USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s) 
    104    USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s) 
    105    USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s) 
    106    USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points  
    107    USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points  
    108    USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points  
    109    USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points 
    110    USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s)  
    111    USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)    
    112    USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s)  
    113    USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s)  
    114    USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag 
     84   USE ldftra , ONLY :  rn_aht_0     =>   rn_aht_0     !:   laplacian lateral eddy diffusivity [m2/s] 
     85   USE ldftra , ONLY :  rn_bht_0     =>   rn_bht_0     !: bilaplacian lateral eddy diffusivity [m4/s] 
     86   USE ldftra , ONLY :  ahtu         =>   ahtu         !: lateral diffusivity coef. at u-points  
     87   USE ldftra , ONLY :  ahtv         =>   ahtv         !: lateral diffusivity coef. at v-points  
     88   USE ldftra , ONLY :  rn_aeiv_0    =>   rn_aeiv_0    !: eddy induced velocity coefficient (m2/s)  
     89   USE ldftra , ONLY :  aeiu         =>   aeiu         !: eddy induced velocity coef. at u-points (m2/s)    
     90   USE ldftra , ONLY :  aeiv         =>   aeiv         !: eddy induced velocity coef. at v-points (m2/s)  
     91   USE ldftra , ONLY :  ln_ldfeiv    =>   ln_ldfeiv    !: eddy induced velocity flag 
     92      
     93!!gm this should be : ln_trcldf_triad (TRC namelist) 
     94   USE ldfslp , ONLY :  ln_traldf_triad => ln_traldf_triad   !: triad scheme (Griffies et al.) 
     95 
     96   !* direction of lateral diffusion * 
     97   USE ldfslp , ONLY :   l_ldfslp  =>  l_ldfslp       !: slopes flag 
     98   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-slope at u-point 
     99   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-slope at v-point 
     100   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-slope at w-point 
     101   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-slope at w-point 
     102!!gm end  
    115103 
    116104   !* vertical diffusion * 
    … …  
    126114   USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m) 
    127115 
    128    !* direction of lateral diffusion * 
    129    USE ldfslp , ONLY :   lk_ldfslp  =>  lk_ldfslp     !: slopes flag 
    130 # if   defined key_ldfslp 
    131    USE ldfslp , ONLY :   uslp       =>   uslp         !: i-direction slope at u-, w-points 
    132    USE ldfslp , ONLY :   vslp       =>   vslp         !: j-direction slope at v-, w-points 
    133    USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-direction slope at u-, w-points 
    134    USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-direction slope at v-, w-points 
    135 # endif 
    136  
     116   USE diaar5 , ONLY :   lk_diaar5  =>   lk_diaar5 
    137117#else 
    138118   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r5038 r5901  
    3434   REAL(wp), PUBLIC                                                ::  areatot        !: total volume  
    3535   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option-  
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: traceur concentration for now time step 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: tracer concentration for now time step 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: tracer concentration for next time step 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: tracer concentration for before time step 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc_b      !: Before sbc fluxes for tracers 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  sbc_trc        !: Now sbc fluxes for tracers 
     41 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_i          !: prescribed tracer concentration in sea ice for SBC 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  trc_o          !: prescribed tracer concentration in ocean for SBC 
     44   INTEGER             , PUBLIC                                    ::  nn_ice_tr      !: handling of sea ice tracers 
    3945 
    4046   !! interpolated gradient 
    … …  
    4450   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrui          !: hor. gradient at u-points at top    ocean level 
    4551   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrvi          !: hor. gradient at v-points at top    ocean level 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)             ::  qsr_mean        !: daily mean qsr 
    4653    
    4754   !! passive tracers  (input and output) 
    … …  
    5461   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr. 
    5562   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input) 
     63   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_indir  !: restart input directory 
    5664   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
     65   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory 
    5766   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
    5867   LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration  
    … …  
    6170   LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas 
    6271   INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model 
     72   LOGICAL             , PUBLIC                                    ::  l_trcdm2dc     !: Diurnal cycle for TOP 
     73 
     74   !! Information for the ice module for tracers 
     75   !! ------------------------------------------ 
     76   TYPE TRC_I_NML                    !--- Ice tracer namelist structure 
     77         REAL(wp)         :: trc_ratio  ! ice-ocean trc ratio 
     78         REAL(wp)         :: trc_prescr ! prescribed ice trc cc 
     79         CHARACTER(len=2) :: ctrc_o     ! choice of ocean trc cc 
     80   END TYPE 
     81 
     82   REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio 
     83                                                 trc_ice_prescr   ! prescribed ice trc cc 
     84   CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 
    6385 
    6486   !! information for outputs 
    … …  
    121143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s] 
    122144# endif 
    123 #if defined key_ldfslp 
    124    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points 
    125    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points 
    126    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points 
    127    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points 
    128 #endif 
    129145#if defined key_trabbl 
    130146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points 
    … …  
    161177#endif 
    162178   ! 
    163 #if defined key_ldfslp 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values  
    165 #endif 
    166    !  
    167179# if defined key_zdfddm 
    168180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s] 
    … …  
    172184   !!---------------------------------------------------------------------- 
    173185   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
    174    !! $Id$  
     186   !! $Id$ 
    175187   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    176188   !!---------------------------------------------------------------------- 
    … …  
    185197      ! 
    186198      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &   
     199         &      trc_i(jpi,jpj,jptra)  , trc_o(jpi,jpj,jptra)                          ,       & 
    187200         &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       & 
    188201         &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       & 
     202         &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &   
    189203         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
    190204         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
    191          &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )   
     205         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,  STAT = trc_alloc  )   
    192206 
    193207      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    • Property svn:keywords set to Id
    r5038 r5901  
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    46    !! $Id: trcdta.F90 2977 2011-10-22 13:46:41Z cetlod $  
     46   !! $Id$  
    4747   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4848   !!---------------------------------------------------------------------- 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r4292 r5901  
    5151   INTEGER  ::   nhoritb   !:  id for horizontal mesh 
    5252 
    53    !! * Substitutions 
    54 #  include "top_substitute.h90" 
    5553   !!---------------------------------------------------------------------- 
    5654   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r5038 r5901  
    223223                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 
    224224                        ENDIF 
     225                        ik = mikt(ji,jj) 
     226                        IF( ik > 1 ) THEN 
     227                           zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
     228                           sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik+1) 
     229                        ENDIF 
    225230                     END DO 
    226231                  END DO 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5038 r5901  
    1818   USE oce_trc         ! shared variables between ocean and passive tracers 
    1919   USE trc             ! passive tracers common variables 
    20    USE trcrst          ! passive tracers restart 
    2120   USE trcnam          ! Namelist read 
    22    USE trcini_cfc      ! CFC      initialisation 
    23    USE trcini_pisces   ! PISCES   initialisation 
    24    USE trcini_c14b     ! C14 bomb initialisation 
    25    USE trcini_my_trc   ! MY_TRC   initialisation 
    26    USE trcdta          ! initialisation from files 
    2721   USE daymod          ! calendar manager 
    28    USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    2922   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    3023   USE trcsub          ! variables to substep passive tracers 
     24   USE trcrst 
    3125   USE lib_mpp         ! distribued memory computing library 
    3226   USE sbc_oce 
     27   USE trcice          ! tracers in sea ice 
    3328  
    3429   IMPLICIT NONE 
    … …  
    5853      !!                or read data or analytical formulation 
    5954      !!--------------------------------------------------------------------- 
    60       INTEGER ::   jk, jn, jl    ! dummy loop indices 
    61       CHARACTER (len=25) :: charout 
    62       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
    63       !!--------------------------------------------------------------------- 
    6455      ! 
    6556      IF( nn_timing == 1 )   CALL timing_start('trc_init') 
    … …  
    6960      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    7061 
    71       CALL top_alloc()              ! allocate TOP arrays 
    72  
    73 #if defined key_offline 
    74       ltrcdm2dc = .FALSE. 
    75 #endif 
    76  
    77       IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' ) 
    78  
    79       IF( nn_cla == 1 )   & 
    80          &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    81  
    82       CALL trc_nam      ! read passive tracers namelists 
     62      ! 
     63      CALL top_alloc()   ! allocate TOP arrays 
     64      ! 
     65      CALL trc_ini_ctl   ! control  
     66      ! 
     67      CALL trc_nam       ! read passive tracers namelists 
    8368      ! 
    8469      IF(lwp) WRITE(numout,*) 
    … …  
    8772      ! 
    8873      IF(lwp) WRITE(numout,*) 
    89                                                               ! masked grid volume 
     74      ! 
     75      CALL trc_ini_sms   ! SMS 
     76      ! 
     77      CALL trc_ini_trp   ! passive tracers transport 
     78      ! 
     79      CALL trc_ice_ini   ! Tracers in sea ice 
     80      ! 
     81      IF( lwp )  & 
     82         &  CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
     83      ! 
     84      CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim 
     85      ! 
     86      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
     87      ! 
     88      CALL trc_ini_inv   ! Inventories 
     89      ! 
     90      IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
     91      ! 
     92   END SUBROUTINE trc_init 
     93 
     94 
     95   SUBROUTINE trc_ini_ctl 
     96      !!---------------------------------------------------------------------- 
     97      !!                     ***  ROUTINE trc_ini_ctl  *** 
     98      !! ** Purpose :        Control  + ocean volume 
     99      !!---------------------------------------------------------------------- 
     100      INTEGER ::   jk    ! dummy loop indices 
     101      ! 
     102      ! Define logical parameter ton control dirunal cycle in TOP 
     103      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 
     104      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline 
     105      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   & 
     106         &                           'Computation of a daily mean shortwave for some biogeochemical models ' ) 
     107      ! 
     108   END SUBROUTINE trc_ini_ctl 
     109 
     110 
     111   SUBROUTINE trc_ini_inv 
     112      !!---------------------------------------------------------------------- 
     113      !!                     ***  ROUTINE trc_ini_stat  *** 
     114      !! ** Purpose :      passive tracers inventories at initialsation phase 
     115      !!---------------------------------------------------------------------- 
     116      INTEGER ::  jk, jn    ! dummy loop indices 
     117      CHARACTER (len=25) :: charout 
     118      !!---------------------------------------------------------------------- 
    90119      !                                                              ! masked grid volume 
    91120      DO jk = 1, jpk 
    … …  
    95124      !                                                              ! total volume of the ocean  
    96125      areatot = glob_sum( cvol(:,:,:) ) 
    97  
     126      ! 
     127      trai(:) = 0._wp                                                   ! initial content of all tracers 
     128      DO jn = 1, jptra 
     129         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     130      END DO 
     131 
     132      IF(lwp) THEN               ! control print 
     133         WRITE(numout,*) 
     134         WRITE(numout,*) 
     135         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
     136         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
     137         WRITE(numout,*) '          *** Total inital content of all tracers ' 
     138         WRITE(numout,*) 
     139         DO jn = 1, jptra 
     140            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
     141         ENDDO 
     142         WRITE(numout,*) 
     143      ENDIF 
     144      IF(lwp) WRITE(numout,*) 
     145      IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
     146         CALL prt_ctl_trc_init 
     147         WRITE(charout, FMT="('ini ')") 
     148         CALL prt_ctl_trc_info( charout ) 
     149         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     150      ENDIF 
     1519000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
     152      ! 
     153   END SUBROUTINE trc_ini_inv 
     154 
     155 
     156   SUBROUTINE trc_ini_sms 
     157      !!---------------------------------------------------------------------- 
     158      !!                     ***  ROUTINE trc_ini_sms  *** 
     159      !! ** Purpose :   SMS initialisation 
     160      !!---------------------------------------------------------------------- 
     161      USE trcini_cfc      ! CFC      initialisation 
     162      USE trcini_pisces   ! PISCES   initialisation 
     163      USE trcini_c14b     ! C14 bomb initialisation 
     164      USE trcini_my_trc   ! MY_TRC   initialisation 
     165      !!---------------------------------------------------------------------- 
    98166      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
    99167      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    100168      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    101169      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
    102  
    103       IF( lwp ) THEN 
    104          ! 
    105          CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
    106          ! 
    107       ENDIF 
    108  
     170      ! 
     171   END SUBROUTINE trc_ini_sms 
     172 
     173   SUBROUTINE trc_ini_trp 
     174      !!---------------------------------------------------------------------- 
     175      !!                     ***  ROUTINE trc_ini_trp  *** 
     176      !! 
     177      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
     178      !!---------------------------------------------------------------------- 
     179      USE trcdmp , ONLY:  trc_dmp_ini 
     180      USE trcadv , ONLY:  trc_adv_ini 
     181      USE trcldf , ONLY:  trc_ldf_ini 
     182      USE trczdf , ONLY:  trc_zdf_ini 
     183      USE trcrad , ONLY:  trc_rad_ini 
     184      ! 
     185      INTEGER :: ierr 
     186      !!---------------------------------------------------------------------- 
     187      ! 
     188      IF( ln_trcdmp )  CALL  trc_dmp_ini          ! damping 
     189                       CALL  trc_adv_ini          ! advection 
     190                       CALL  trc_ldf_ini          ! lateral diffusion 
     191                       CALL  trc_zdf_ini          ! vertical diffusion 
     192                       CALL  trc_rad_ini          ! positivity of passive tracers  
     193      ! 
     194   END SUBROUTINE trc_ini_trp 
     195 
     196 
     197   SUBROUTINE trc_ini_state 
     198      !!---------------------------------------------------------------------- 
     199      !!                     ***  ROUTINE trc_ini_state *** 
     200      !! ** Purpose :          Initialisation of passive tracer concentration  
     201      !!---------------------------------------------------------------------- 
     202      USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
     203      USE trcrst          ! passive tracers restart 
     204      USE trcdta          ! initialisation from files 
     205      ! 
     206      INTEGER ::   jk, jn, jl    ! dummy loop indices 
     207      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
     208      !!---------------------------------------------------------------------- 
     209      ! 
    109210      IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    110  
    111211 
    112212      IF( ln_rsttr ) THEN 
    … …  
    143243  
    144244      tra(:,:,:,:) = 0._wp 
    145       IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    146         &    CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi )       ! tracers at the bottom ocean level 
    147  
    148       ! 
    149       IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    150       ! 
    151  
    152       trai(:) = 0._wp                                                   ! initial content of all tracers 
    153       DO jn = 1, jptra 
    154          trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    155       END DO 
    156  
    157       IF(lwp) THEN               ! control print 
    158          WRITE(numout,*) 
    159          WRITE(numout,*) 
    160          WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
    161          WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
    162          WRITE(numout,*) '          *** Total inital content of all tracers ' 
    163          WRITE(numout,*) 
    164          DO jn = 1, jptra 
    165             WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
    166          ENDDO 
    167          WRITE(numout,*) 
    168       ENDIF 
    169       IF(lwp) WRITE(numout,*) 
    170       IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
    171          CALL prt_ctl_trc_init 
    172          WRITE(charout, FMT="('ini ')") 
    173          CALL prt_ctl_trc_info( charout ) 
    174          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    175       ENDIF 
    176 9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    177       ! 
    178       IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
    179       ! 
    180    END SUBROUTINE trc_init 
     245      !                                                         ! Partial top/bottom cell: GRADh(trn) 
     246   END SUBROUTINE trc_ini_state 
    181247 
    182248 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r5038 r5901  
    2020   USE oce_trc           ! shared variables between ocean and passive tracers 
    2121   USE trc               ! passive tracers common variables 
    22    USE trcnam_trp        ! Transport namelist 
    2322   USE trcnam_pisces     ! PISCES namelist 
    2423   USE trcnam_cfc        ! CFC SMS namelist 
    … …  
    3534   PUBLIC trc_nam      ! called in trcini 
    3635 
    37    !! * Substitutions 
    38 #  include "top_substitute.h90" 
    3936   !!---------------------------------------------------------------------- 
    4037   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id$  
     38   !! $Id$ 
    4239   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4340   !!---------------------------------------------------------------------- 
    44  
    4541CONTAINS 
    46  
    4742 
    4843   SUBROUTINE trc_nam 
    … …  
    5752      !!--------------------------------------------------------------------- 
    5853      INTEGER  ::   jn                  ! dummy loop indice 
    59       !                                        !   Parameters of the run  
    60       IF( .NOT. lk_offline ) CALL trc_nam_run 
    61        
    62       !                                        !  passive tracer informations 
    63       CALL trc_nam_trc 
    64        
    65       !                                        !   Parameters of additional diagnostics 
    66       CALL trc_nam_dia 
    67  
    68       !                                        !   namelist of transport 
    69       CALL trc_nam_trp 
    70  
    71  
    72       IF( ln_rsttr )                      ln_trcdta = .FALSE.   ! restart : no need of clim data 
    73       ! 
    74       IF( ln_trcdmp .OR. ln_trcdmp_clo )  ln_trcdta = .TRUE.   ! damping : need to have clim data 
    75       ! 
    76       IF( .NOT.ln_trcdta ) THEN 
    77          ln_trc_ini(:) = .FALSE. 
    78       ENDIF 
    79  
    80      IF(lwp) THEN                   ! control print 
     54      !                                   
     55      IF( .NOT.lk_offline )   CALL trc_nam_run     ! Parameters of the run  
     56      !                
     57                              CALL trc_nam_trc     ! passive tracer informations 
     58      !                                         
     59                              CALL trc_nam_dia     ! Parameters of additional diagnostics 
     60      !                                       
     61      ! 
     62      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data 
     63      ! 
     64      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data 
     65      ! 
     66      IF( .NOT.ln_trcdta               )   ln_trc_ini(:) = .FALSE. 
     67 
     68      IF(lwp) THEN                   ! control print 
    8169         WRITE(numout,*) 
    8270         WRITE(numout,*) ' Namelist : namtrc' 
    … …  
    147135 
    148136 
     137      ! Call the ice module for tracers 
     138      ! ------------------------------- 
     139                                  CALL trc_nam_ice 
     140 
    149141      ! namelist of SMS 
    150142      ! ---------------       
    … …  
    167159   END SUBROUTINE trc_nam 
    168160 
     161 
    169162   SUBROUTINE trc_nam_run 
    170163      !!--------------------------------------------------------------------- 
    … …  
    175168      !!--------------------------------------------------------------------- 
    176169      NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
    177         &                  cn_trcrst_in, cn_trcrst_out 
    178  
     170        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
     171      ! 
    179172      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    180  
    181       !!--------------------------------------------------------------------- 
    182  
    183  
     173      !!--------------------------------------------------------------------- 
     174      ! 
    184175      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
    185176      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    … …  
    216207 
    217208 
     209   SUBROUTINE trc_nam_ice 
     210      !!--------------------------------------------------------------------- 
     211      !!                     ***  ROUTINE trc_nam_ice *** 
     212      !! 
     213      !! ** Purpose :   Read the namelist for the ice effect on tracers 
     214      !! 
     215      !! ** Method  : - 
     216      !! 
     217      !!--------------------------------------------------------------------- 
     218      INTEGER :: jn      ! dummy loop indices 
     219      INTEGER :: ios     ! Local integer output status for namelist read 
     220      ! 
     221      TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 
     222      !! 
     223      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
     224      !!--------------------------------------------------------------------- 
     225      ! 
     226      IF(lwp) THEN 
     227         WRITE(numout,*) 
     228         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice' 
     229         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     230      ENDIF 
     231 
     232      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice') 
     233 
     234      ! 
     235      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data 
     236      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 
     237 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 
     238 
     239      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 
     240      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 
     241 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 
     242 
     243      IF( lwp ) THEN 
     244         WRITE(numout,*) ' ' 
     245         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 
     246         WRITE(numout,*) ' ' 
     247      ENDIF 
     248 
     249      ! Assign namelist stuff 
     250      DO jn = 1, jptra 
     251         trc_ice_ratio(jn)  = sn_tri_tracer(jn)%trc_ratio 
     252         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr 
     253         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o 
     254      END DO 
     255 
     256      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice') 
     257      ! 
     258   END SUBROUTINE trc_nam_ice 
     259 
     260 
    218261   SUBROUTINE trc_nam_trc 
    219262      !!--------------------------------------------------------------------- 
    … …  
    223266      !! 
    224267      !!--------------------------------------------------------------------- 
    225       TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    226       !! 
    227       NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
    228    
    229268      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    230269      INTEGER  ::   jn                  ! dummy loop indice 
     270      ! 
     271      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
     272      !! 
     273      NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 
    231274      !!--------------------------------------------------------------------- 
    232275      IF(lwp) WRITE(numout,*) 
    233276      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 
    234277      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    235  
    236278 
    237279      REWIND( numnat_ref )              ! Namelist namtrc in reference namelist : Passive tracer variables 
    … …  
    251293         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    252294      END DO 
    253        
    254     END SUBROUTINE trc_nam_trc 
     295      ! 
     296   END SUBROUTINE trc_nam_trc 
    255297 
    256298 
    … …  
    265307      !!                ( (PISCES, CFC, MY_TRC ) 
    266308      !!--------------------------------------------------------------------- 
     309      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    267310      INTEGER ::  ierr 
     311      !! 
    268312#if defined key_trdmxl_trc  || defined key_trdtrc 
    269313      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    … …  
    272316#endif 
    273317      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    274  
    275       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    276318      !!--------------------------------------------------------------------- 
    277319 
    … …  
    339381   !!---------------------------------------------------------------------- 
    340382   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    341    !! $Id$  
     383   !! $Id$ 
    342384   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    343385   !!====================================================================== 
    344 END MODULE  trcnam 
     386END MODULE trcnam 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r5038 r5901  
    2525   USE oce_trc 
    2626   USE trc 
    27    USE trcnam_trp 
    2827   USE iom 
    2928   USE daymod 
    … …  
    3736 
    3837   !! * Substitutions 
    39 #  include "top_substitute.h90" 
     38#  include "domzgr_substitute.h90" 
    4039    
    4140CONTAINS 
    … …  
    5150      CHARACTER(LEN=20)   ::   clkt     ! ocean time-step define as a character 
    5251      CHARACTER(LEN=50)   ::   clname   ! trc output restart file name 
     52      CHARACTER(LEN=256)  ::   clpath   ! full path to ocean output restart file 
    5353      !!---------------------------------------------------------------------- 
    5454      ! 
    … …  
    5656         IF( kt == nittrc000 ) THEN 
    5757            lrst_trc = .FALSE. 
    58             nitrst = nitend 
    59          ENDIF 
    60  
    61          IF( MOD( kt - 1, nstock ) == 0 ) THEN 
     58            IF( ln_rst_list ) THEN 
     59               nrst_lst = 1 
     60               nitrst = nstocklist( nrst_lst ) 
     61            ELSE 
     62               nitrst = nitend 
     63            ENDIF 
     64         ENDIF 
     65 
     66         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 
    6267            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
    6368            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    … …  
    7984         IF(lwp) WRITE(numout,*) 
    8085         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out) 
    81          IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname 
    82          CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 
     86         clpath = TRIM(cn_trcrst_outdir) 
     87         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
     88         IF(lwp) WRITE(numout,*) & 
     89             '             open trc restart.output NetCDF file: ',TRIM(clpath)//clname 
     90         CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 
    8391         lrst_trc = .TRUE. 
    8492      ENDIF 
    … …  
    140148          lrst_trc = .FALSE. 
    141149#endif 
     150          IF( lk_offline .AND. ln_rst_list ) THEN 
     151             nrst_lst = nrst_lst + 1 
     152             nitrst = nstocklist( nrst_lst ) 
     153          ENDIF 
    142154      ENDIF 
    143155      ! 
    … …  
    190202           ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    191203           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
    192            INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
     204           INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
    193205           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    194206         ENDIF 
    195207 
    196          CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
    197  
    198          CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
    199  
    200          IF(lwp) THEN 
    201             WRITE(numout,*) ' *** Info read in restart : ' 
    202             WRITE(numout,*) '   previous time-step                               : ', NINT( zkt ) 
    203             WRITE(numout,*) ' *** restart option' 
    204             SELECT CASE ( nn_rsttr ) 
    205             CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 
    206             CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 
    207             CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
    208             END SELECT 
    209             WRITE(numout,*) 
    210          ENDIF 
    211          ! Control of date  
    212          IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
    213             &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
    214             &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    215          IF( lk_offline ) THEN      ! set the date in offline mode 
    216             ! Check dynamics and tracer time-step consistency and force Euler restart if changed 
    217             IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN 
    218                CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 ) 
    219                IF( zrdttrc1 /= rdt * nn_dttrc )   neuler = 0 
    220             ENDIF 
    221             !                          ! define ndastp and adatrj 
    222             IF( nn_rsttr == 2 ) THEN 
     208         IF( ln_rsttr ) THEN 
     209            CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) 
     210            CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
     211 
     212            IF(lwp) THEN 
     213               WRITE(numout,*) ' *** Info read in restart : ' 
     214               WRITE(numout,*) '   previous time-step                               : ', NINT( zkt ) 
     215               WRITE(numout,*) ' *** restart option' 
     216               SELECT CASE ( nn_rsttr ) 
     217               CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 
     218               CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 
     219               CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
     220               END SELECT 
     221               WRITE(numout,*) 
     222            ENDIF 
     223            ! Control of date  
     224            IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
     225               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
     226               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
     227         ENDIF 
     228         ! 
     229         IF( lk_offline ) THEN     
     230            !                                          ! set the date in offline mode 
     231            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN 
    223232               CALL iom_get( numrtr, 'ndastp', zndastp )  
    224233               ndastp = NINT( zndastp ) 
    225234               CALL iom_get( numrtr, 'adatrj', adatrj  ) 
    226             ELSE 
     235             ELSE 
    227236               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    228237               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
    … …  
    235244              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
    236245              WRITE(numout,*) 
     246            ENDIF 
     247            ! 
     248            IF( ln_rsttr )  THEN   ;    neuler = 1 
     249            ELSE                   ;    neuler = 0 
    237250            ENDIF 
    238251            ! 
    … …  
    265278      INTEGER  :: jk, jn 
    266279      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
     280      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol 
    267281      !!---------------------------------------------------------------------- 
    268282 
    … …  
    273287      ENDIF 
    274288      ! 
    275       DO jn = 1, jptra 
    276          ztraf = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 
     289      DO jk = 1, jpk 
     290         zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk) 
     291      END DO 
     292      ! 
     293      DO jn = 1, jptra 
     294         ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) ) 
    277295         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    278296         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    … …  
    306324   !!---------------------------------------------------------------------- 
    307325   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    308    !! $Id$  
     326   !! $Id$ 
    309327   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    310328   !!====================================================================== 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r3680 r5901  
    7575 
    7676   !!====================================================================== 
    77 END MODULE  trcsms 
     77END MODULE trcsms 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r5038 r5901  
    3030   PUBLIC   trc_stp    ! called by step 
    3131 
     32   REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE ::   qsr_arr ! save qsr during TOP time-step 
     33   REAL(wp) :: rdt_sampl 
     34   INTEGER  :: nb_rec_per_days 
     35   INTEGER  :: isecfst, iseclast 
     36   LOGICAL  :: llnew 
     37 
    3238   !! * Substitutions 
    3339#  include "domzgr_substitute.h90" 
    … …  
    5460      CHARACTER (len=25)    ::  charout  
    5561 
    56       REAL(wp), DIMENSION(:,:), POINTER ::   zqsr_tmp ! save qsr during TOP time-step 
    5762      !!------------------------------------------------------------------- 
    5863      ! 
    … …  
    6873         areatot         = glob_sum( cvol(:,:,:) ) 
    6974      ENDIF 
    70       !     
    71       IF( ltrcdm2dc ) THEN 
    72          ! When Diurnal cycle, core bulk and LIM2  are activated, put daily mean qsr in qsr for TOP/biogeochemistery time-step 
    73          ! and save qsr with diurnal cycle in qsr_tmp 
    74          CALL wrk_alloc( jpi,jpj, zqsr_tmp ) 
    75          zqsr_tmp(:,:) = qsr     (:,:) 
    76          qsr     (:,:) = qsr_mean(:,:)     
    77       ENDIF 
     75      ! 
     76      IF( l_trcdm2dc )   CALL trc_mean_qsr( kt ) 
    7877      !     
    7978      IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping 
    … …  
    106105      ENDIF 
    107106      ! 
    108       IF( ltrcdm2dc ) THEN 
    109          ! put back qsr with diurnal cycle in qsr 
    110          qsr(:,:) = zqsr_tmp(:,:) 
    111          CALL wrk_dealloc( jpi,jpj, zqsr_tmp ) 
    112       ENDIF 
    113       ! 
    114107      ztrai = 0._wp                                                   !  content of all tracers 
    115108      DO jn = 1, jptra 
    … …  
    122115      ! 
    123116   END SUBROUTINE trc_stp 
     117 
     118   SUBROUTINE trc_mean_qsr( kt ) 
     119      !!---------------------------------------------------------------------- 
     120      !!             ***  ROUTINE trc_mean_qsr  *** 
     121      !! 
     122      !! ** Purpose :  Compute daily mean qsr for biogeochemical model in case 
     123      !!               of diurnal cycle 
     124      !! 
     125      !! ** Method  : store in TOP the qsr every hour ( or every time-step the latter  
     126      !!              is greater than 1 hour ) and then, compute the  mean with  
     127      !!              a moving average over 24 hours.  
     128      !!              In coupled mode, the sampling is done at every coupling frequency  
     129      !!---------------------------------------------------------------------- 
     130      INTEGER, INTENT(in) ::   kt 
     131      INTEGER  :: jn 
     132 
     133      IF( kt == nittrc000 ) THEN 
     134         IF( ln_cpl )  THEN   
     135            rdt_sampl = 86400. / ncpl_qsr_freq 
     136            nb_rec_per_days = ncpl_qsr_freq 
     137         ELSE   
     138            rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 
     139            nb_rec_per_days = INT( 86400 / rdt_sampl ) 
     140         ENDIF 
     141         ! 
     142         IF( lwp ) THEN 
     143            WRITE(numout,*)  
     144            WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's','   Number of sampling per day  nrec = ', nb_rec_per_days 
     145            WRITE(numout,*)  
     146         ENDIF 
     147         ! 
     148         ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 
     149         DO jn = 1, nb_rec_per_days 
     150            qsr_arr(:,:,jn) = qsr(:,:) 
     151         ENDDO 
     152         qsr_mean(:,:) = qsr(:,:) 
     153         ! 
     154         isecfst  = nsec_year + nsec1jan000   !   number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 
     155         iseclast = isecfst 
     156         ! 
     157      ENDIF 
     158      ! 
     159      iseclast = nsec_year + nsec1jan000 
     160      llnew   = ( iseclast - isecfst )  > INT( rdt_sampl )   !   new shortwave to store 
     161      IF( kt /= nittrc000 .AND. llnew ) THEN 
     162          IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, & 
     163             &                      ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 
     164          isecfst = iseclast 
     165          DO jn = 1, nb_rec_per_days - 1 
     166             qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 
     167          ENDDO 
     168          qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 
     169          qsr_mean(:,:                ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 
     170      ENDIF 
     171      ! 
     172   END SUBROUTINE trc_mean_qsr 
    124173 
    125174#else 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    • Property svn:keywords set to Id
    r4611 r5901  
    2525   USE zdf_oce 
    2626   USE domvvl 
    27    USE divcur          ! hor. divergence and curl      (div & cur routines) 
     27   USE divhor          ! horizontal divergence            (div_hor routine) 
    2828   USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff  
    2929   USE bdy_oce 
    … …  
    4444   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1)  
    4545 
    46    !!* Substitution 
    47 #  include "top_substitute.h90" 
     46   !                                                       !* iso-neutral slopes (if l_ldfslp=T) 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_temp, vslp_temp, wslpi_temp, wslpj_temp   !: hold current values  
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm  , vslp_tm  , wslpi_tm  , wslpj_tm     !: time mean  
     49 
     50   !! * Substitutions 
     51#  include "domzgr_substitute.h90" 
    4852   !!---------------------------------------------------------------------- 
    4953   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    50    !! $Id: trcstp.F90 2528 2010-12-27 17:33:53Z rblod $  
     54   !! $Id$  
    5155   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5256   !!---------------------------------------------------------------------- 
    … …  
    9397          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
    9498# endif 
    95 #if defined key_ldfslp 
    96           wslpi_tm(:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
    97           wslpj_tm(:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
    98           uslp_tm (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:) 
    99           vslp_tm (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:) 
    100 #endif 
     99         IF( l_ldfslp ) THEN 
     100            uslp_tm (:,:,:)      = uslp_tm (:,:,:)        + uslp (:,:,:) 
     101            vslp_tm (:,:,:)      = vslp_tm (:,:,:)        + vslp (:,:,:) 
     102            wslpi_tm(:,:,:)      = wslpi_tm(:,:,:)        + wslpi(:,:,:) 
     103            wslpj_tm(:,:,:)      = wslpj_tm(:,:,:)        + wslpj(:,:,:) 
     104         ENDIF 
    101105# if defined key_trabbl 
    102106          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    131135         avs_temp   (:,:,:)      = avs   (:,:,:) 
    132136# endif 
    133 #if defined key_ldfslp 
    134          wslpi_temp (:,:,:)      = wslpi (:,:,:) 
    135          wslpj_temp (:,:,:)      = wslpj (:,:,:) 
    136          uslp_temp  (:,:,:)      = uslp  (:,:,:) 
    137          vslp_temp  (:,:,:)      = vslp  (:,:,:) 
    138 #endif 
     137         IF( l_ldfslp ) THEN 
     138            uslp_temp  (:,:,:)   = uslp  (:,:,:)   ;   wslpi_temp (:,:,:)   = wslpi (:,:,:) 
     139            vslp_temp  (:,:,:)   = vslp  (:,:,:)   ;   wslpj_temp (:,:,:)   = wslpj (:,:,:) 
     140         ENDIF 
    139141# if defined key_trabbl 
    140142          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    160162         wndm_temp  (:,:)        = wndm  (:,:) 
    161163         !                                    !  Variables reset in trc_sub_ssh 
    162          rotn_temp  (:,:,:)      = rotn  (:,:,:) 
    163164         hdivn_temp (:,:,:)      = hdivn (:,:,:) 
    164          rotb_temp  (:,:,:)      = rotb  (:,:,:) 
    165          hdivb_temp (:,:,:)      = hdivb (:,:,:) 
    166165         ! 
    167166         ! 2. Create averages and reassign variables 
    … …  
    175174         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)   
    176175# endif 
    177 #if defined key_ldfslp 
    178          wslpi_tm (:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:)  
    179          wslpj_tm (:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:)  
    180          uslp_tm  (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:)  
    181          vslp_tm  (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:) 
    182 #endif 
     176         IF( l_ldfslp ) THEN 
     177            uslp_tm  (:,:,:)     = uslp_tm (:,:,:)        + uslp (:,:,:)  
     178            vslp_tm  (:,:,:)     = vslp_tm (:,:,:)        + vslp (:,:,:) 
     179            wslpi_tm (:,:,:)     = wslpi_tm(:,:,:)        + wslpi(:,:,:)  
     180            wslpj_tm (:,:,:)     = wslpj_tm(:,:,:)        + wslpj(:,:,:)  
     181         ENDIF 
    183182# if defined key_trabbl 
    184183          IF( nn_bbl_ldf == 1 ) THEN 
    … …  
    255254                  tsn  (ji,jj,jk,jp_sal) = tsn_tm  (ji,jj,jk,jp_sal) * z1_ne3t 
    256255                  rhop (ji,jj,jk)        = rhop_tm (ji,jj,jk)        * z1_ne3t 
     256!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    257257                  avt  (ji,jj,jk)        = avt_tm  (ji,jj,jk)        * z1_ne3w 
    258258# if defined key_zdfddm 
    259259                  avs  (ji,jj,jk)        = avs_tm  (ji,jj,jk)        * z1_ne3w 
    260260# endif 
    261 #if defined key_ldfslp 
    262                   wslpi(ji,jj,jk)        = wslpi_tm(ji,jj,jk)  
    263                   wslpj(ji,jj,jk)        = wslpj_tm(ji,jj,jk) 
    264                   uslp (ji,jj,jk)        = uslp_tm (ji,jj,jk) 
    265                   vslp (ji,jj,jk)        = vslp_tm (ji,jj,jk) 
    266 #endif 
    267                ENDDO 
    268             ENDDO 
    269          ENDDO 
     261               END DO 
     262            END DO 
     263         END DO 
     264         IF( l_ldfslp ) THEN 
     265            wslpi(:,:,:)        = wslpi_tm(:,:,:)  
     266            wslpj(:,:,:)        = wslpj_tm(:,:,:) 
     267            uslp (:,:,:)        = uslp_tm (:,:,:) 
     268            vslp (:,:,:)        = vslp_tm (:,:,:) 
     269         ENDIF 
    270270         ! 
    271271         CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity 
    … …  
    276276      ! 
    277277   END SUBROUTINE trc_sub_stp 
     278 
    278279 
    279280   SUBROUTINE trc_sub_ini 
    … …  
    304305      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)   
    305306      rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)   
     307!!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 
    306308      avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)   
    307309# if defined key_zdfddm 
    308310      avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
    309311# endif 
    310 #if defined key_ldfslp 
    311       wslpi_tm(:,:,:)        = wslpi(:,:,:) 
    312       wslpj_tm(:,:,:)        = wslpj(:,:,:) 
    313       uslp_tm (:,:,:)        = uslp (:,:,:) 
    314       vslp_tm (:,:,:)        = vslp (:,:,:) 
    315 #endif 
     312      IF( l_ldfslp ) THEN 
     313         wslpi_tm(:,:,:)     = wslpi(:,:,:) 
     314         wslpj_tm(:,:,:)     = wslpj(:,:,:) 
     315         uslp_tm (:,:,:)     = uslp (:,:,:) 
     316         vslp_tm (:,:,:)     = vslp (:,:,:) 
     317      ENDIF 
    316318      sshn_tm  (:,:) = sshn  (:,:)  
    317319      rnf_tm   (:,:) = rnf   (:,:)  
    … …  
    365367      avs   (:,:,:)   =  avs_temp   (:,:,:) 
    366368# endif 
    367 #if defined key_ldfslp 
    368       wslpi (:,:,:)   =  wslpi_temp (:,:,:) 
    369       wslpj (:,:,:)   =  wslpj_temp (:,:,:) 
    370       uslp  (:,:,:)   =  uslp_temp  (:,:,:) 
    371       vslp  (:,:,:)   =  vslp_temp  (:,:,:) 
    372 #endif 
     369      IF( l_ldfslp ) THEN 
     370         wslpi (:,:,:)=  wslpi_temp (:,:,:) 
     371         wslpj (:,:,:)=  wslpj_temp (:,:,:) 
     372         uslp  (:,:,:)=  uslp_temp  (:,:,:) 
     373         vslp  (:,:,:)=  vslp_temp  (:,:,:) 
     374      ENDIF 
    373375      sshn  (:,:)     =  sshn_temp  (:,:) 
    374376      sshb  (:,:)     =  sshb_temp  (:,:) 
    … …  
    396398      ! 
    397399      hdivn (:,:,:)   =  hdivn_temp (:,:,:) 
    398       rotn  (:,:,:)   =  rotn_temp  (:,:,:) 
    399       hdivb (:,:,:)   =  hdivb_temp (:,:,:) 
    400       rotb  (:,:,:)   =  rotb_temp  (:,:,:) 
    401400      !                                       
    402  
    403401      ! Start new averages 
    404402         un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:)  
    … …  
    411409         avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)   
    412410# endif 
    413 #if defined key_ldfslp 
     411      IF( l_ldfslp ) THEN 
     412         uslp_tm (:,:,:)        = uslp (:,:,:) 
     413         vslp_tm (:,:,:)        = vslp (:,:,:) 
    414414         wslpi_tm(:,:,:)        = wslpi(:,:,:)  
    415415         wslpj_tm(:,:,:)        = wslpj(:,:,:) 
    416          uslp_tm (:,:,:)        = uslp (:,:,:) 
    417          vslp_tm (:,:,:)        = vslp (:,:,:) 
    418 #endif 
     416      ENDIF 
    419417      ! 
    420418      sshb_hold  (:,:) = sshn  (:,:) 
    … …  
    487485      ENDIF 
    488486      ! 
    489       CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity 
     487      CALL div_hor( kt )                              ! Horizontal divergence & Relative vorticity 
    490488      ! 
    491489      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
    … …  
    551549         &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      & 
    552550         &      ssha_temp(jpi,jpj)          ,                           & 
    553 #if defined key_ldfslp 
    554          &      wslpi_temp(jpi,jpj,jpk)     ,  wslpj_temp(jpi,jpj,jpk),  & 
    555          &      uslp_temp(jpi,jpj,jpk)      ,  vslp_temp(jpi,jpj,jpk),   & 
    556 #endif 
    557551#if defined key_trabbl 
    558552         &      ahu_bbl_temp(jpi,jpj)       ,  ahv_bbl_temp(jpi,jpj),    & 
    … …  
    569563# endif 
    570564         &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  & 
    571          &      rotn_temp(jpi,jpj,jpk)      ,  rotb_temp(jpi,jpj,jpk),   & 
    572565         &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     & 
    573566         &      avt_tm(jpi,jpj,jpk)                                ,     & 
    … …  
    577570         &      emp_b_hold(jpi,jpj)         ,                            & 
    578571         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         & 
    579 #if defined key_ldfslp 
    580          &      wslpi_tm(jpi,jpj,jpk)       ,  wslpj_tm(jpi,jpj,jpk),    & 
    581          &      uslp_tm(jpi,jpj,jpk)        ,  vslp_tm(jpi,jpj,jpk),     & 
    582 #endif 
    583572#if defined key_trabbl 
    584573         &      ahu_bbl_tm(jpi,jpj)         ,  ahv_bbl_tm(jpi,jpj),      & 
    585574         &      utr_bbl_tm(jpi,jpj)         ,  vtr_bbl_tm(jpi,jpj),      & 
    586575#endif 
    587          &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) ,       & 
    588          &                                    STAT=trc_sub_alloc )   
     576         &      rnf_tm(jpi,jpj)             ,  h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc )   
     577      ! 
    589578      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate arrays') 
    590  
     579      ! 
     580      IF( l_ldfslp ) THEN 
     581         ALLOCATE( uslp_temp(jpi,jpj,jpk)   ,  wslpi_temp(jpi,jpj,jpk),      & 
     582            &      vslp_temp(jpi,jpj,jpk)   ,  wslpj_temp(jpi,jpj,jpk),      & 
     583            &      uslp_tm  (jpi,jpj,jpk)   ,  wslpi_tm  (jpi,jpj,jpk),      & 
     584            &      vslp_tm  (jpi,jpj,jpk)   ,  wslpj_tm  (jpi,jpj,jpk),  STAT=trc_sub_alloc ) 
     585      ENDIF 
     586      ! 
     587      IF( trc_sub_alloc /= 0 )   CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays') 
    591588      ! 
    592589   END FUNCTION trc_sub_alloc 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r3750 r5901  
    2626 
    2727   PUBLIC trc_wri       
    28  
    29    !! * Substitutions 
    30 #  include "top_substitute.h90" 
    3128 
    3229CONTAINS 
Note: See TracChangeset for help on using the changeset viewer.