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 2528 for trunk/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

Location:
trunk/NEMOGCM/NEMO/TOP_SRC
Files:
34 deleted
77 edited
12 copied

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    • Property svn:keywords set to Id
    r2047 r2528  
    66   !! History :   2.0  !  2008-12  (C. Ethe, G. Madec)  revised architecture 
    77   !!---------------------------------------------------------------------- 
    8    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    9    !! $Id: par_cfc.F90 1152 2008-06-26 14:11:13Z rblod $  
    10    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     8   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     9   !! $Id$  
     10   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    • Property svn:keywords set to Id
    r1581 r2528  
    4141 
    4242   !!--------------------------------------------------------------------- 
    43    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    44    !! $Id: trcini_cfc.F90 1146 2008-06-25 11:42:56Z rblod $  
    45    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     43   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     44   !! $Id$  
     45   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    4747 
    … …  
    5959      !!---------------------------------------------------------------------- 
    6060 
    61       IF(lwp) WRITE(numout,*) 
    62       IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model' 
     61      !  Control consitency 
     62      CALL trc_ctl_c14b 
     63 
     64      IF(lwp) WRITE(numout,*) '' 
     65      IF(lwp) WRITE(numout,*) ' trc_ini_c14b: initialisation of Bomb C14 chemical model' 
    6366      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    6467 
    … …  
    162165   END SUBROUTINE trc_ini_c14b 
    163166    
     167   SUBROUTINE trc_ctl_c14b 
     168      !!---------------------------------------------------------------------- 
     169      !!                     ***  ROUTINE trc_ctl_c14b  *** 
     170      !! 
     171      !! ** Purpose :   control the cpp options, namelist and files  
     172      !!---------------------------------------------------------------------- 
     173 
     174      IF(lwp) THEN 
     175          WRITE(numout,*) ' C14 bomb Model ' 
     176          WRITE(numout,*) ' ' 
     177      ENDIF 
     178 
     179      ! Check number of tracers 
     180      ! -----------------------    
     181      IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 
     182 
     183      ! Check tracer names 
     184      ! ------------------ 
     185      IF ( ctrcnm(jpc14) /= 'C14B' ) THEN 
     186           ctrcnm(jpc14)  = 'C14B' 
     187           ctrcnl(jpc14)  = 'Bomb C14 concentration' 
     188      ENDIF 
     189 
     190      IF(lwp) THEN 
     191         CALL ctl_warn( ' we force tracer names' ) 
     192         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14) 
     193         WRITE(numout,*) ' ' 
     194      ENDIF 
     195 
     196      ! Check tracer units 
     197      ! ------------------ 
     198      IF( ctrcun(jpc14) /= 'ration' ) THEN 
     199          ctrcun(jpc14) = 'ration' 
     200          IF(lwp) THEN 
     201             CALL ctl_warn( ' we force tracer unit' ) 
     202             WRITE(numout,*) ' tracer  ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14) 
     203             WRITE(numout,*) ' ' 
     204          ENDIF 
     205       ENDIF 
     206      ! 
     207   END SUBROUTINE trc_ctl_c14b 
    164208#else 
    165209   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90

    • Property svn:keywords set to Id
    r1801 r2528  
    4343      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    4444       
    45       DO jn = jp_c14b0, jp_c14b1 
    46          CALL iom_get( knum, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_c14(:,:,jn) )  
    47       END DO 
     45      CALL iom_get( knum, jpdom_autoglo, 'qint_c14', qint_c14 )  
    4846 
    4947   END SUBROUTINE trc_rst_read_c14b 
    … …  
    5957      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write 
    6058      INTEGER, INTENT(in)  :: knum    ! unit of the restart file 
    61       INTEGER              :: jn      ! dummy loop indices 
    6259      !!---------------------------------------------------------------------- 
    6360 
    … …  
    6663      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    6764 
    68       DO jn = jp_c14b0, jp_c14b1 
    69          CALL iom_rstput( kt, kitrst, kum, 'qint_'//ctrcnm(jn), qint_c14(:,:,jn) ) 
    70       END DO 
     65      CALL iom_rstput( kt, kitrst, knum, 'qint_c14', qint_c14 ) 
    7166 
    7267   END SUBROUTINE trc_rst_wri_c14b 

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    • Property svn:keywords set to Id
    r1736 r2528  
    1717   USE par_trc      ! TOP parameters 
    1818   USE trc          ! TOP variables 
    19    USE trdmld_trc_oce 
    20    USE trdmld_trc 
     19   USE trdmod_oce 
     20   USE trdmod_trc 
    2121   USE iom 
    2222 
    … …  
    126126       zpv  ,        &      !: piston velocity  
    127127       zdemi, ztra 
    128 #if defined key_trc_dia3d  && defined key_iomput 
     128#if defined key_diatrc  && defined key_iomput 
    129129      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d 
    130130#endif 
    131131      !!---------------------------------------------------------------------- 
    132132 
    133       IF( kt == nittrc000 )  THEN 
     133      IF( kt == nit000 )  THEN 
    134134         ! Computation of decay coeffcient 
    135135         zdemi   = 5730. 
    … …  
    234234            !  Computation of solubility   
    235235            IF (tmask(ji,jj,1) >  0.) THEN 
    236                ztp  = ( tn(ji,jj,1) + 273.16 ) * 0.01 
     236               ztp  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01 
    237237               zsk  = 0.023517 + ztp * ( -0.023656 + 0.0047036 * ztp ) 
    238                zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * sn(ji,jj,1) ) 
     238               zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) ) 
    239239               ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)] 
    240240               zsol = zsol * 1.0e-03 
    … …  
    247247 
    248248            ! Computes the Schmidt number of CO2 in seawater 
    249             zt   = tn(ji,jj,1) 
     249            zt   = tsn(ji,jj,1,jp_tem) 
    250250            zsch = 2073.1 + zt * ( -125.62 + zt * (3.6276 - 0.043219 * zt ) ) 
    251251 
    … …  
    259259            qtr_c14(ji,jj) = -zpv * zsol * zpco2at                                   & 
    260260                 &                       * ( trb(ji,jj,1,jpc14) - zatmbc14(ji,jj) )  & 
    261 #if defined key_off_degrad 
     261#if defined key_degrad 
    262262                 &                       * facvol(ji,jj,1)                           & 
    263263#endif 
    … …  
    270270            qint_c14(ji,jj) = qint_c14(ji,jj) + qtr_c14(ji,jj) * rdt 
    271271 
    272 # if defined key_trc_diaadd && ! defined key_iomput 
     272# if defined key_diatrc && ! defined key_iomput 
    273273            ! Save 2D diagnostics 
    274274            trc2d(ji,jj,jp_c14b0_2d    ) = qtr_c14 (ji,jj) 
    … …  
    282282         DO jj = 1, jpj 
    283283            DO ji = 1, jpi 
    284 #if ! defined key_off_degrad 
     284#if ! defined key_degrad 
    285285               ztra = trn(ji,jj,jk,jpc14) * xaccum 
    286286#else 
    … …  
    288288#endif 
    289289               tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - ztra / rdt 
    290 #if defined key_trc_dia3d 
     290#if defined key_diatrc 
    291291               ! Save 3D diagnostics 
    292292# if ! defined key_iomput 
    … …  
    300300      END DO 
    301301 
    302 #if defined key_trc_diaadd  && defined key_iomput 
     302#if defined key_diatrc  && defined key_iomput 
    303303      CALL iom_put( "qtrC14b"  , qtr_c14  ) 
    304304      CALL iom_put( "qintC14b" , qint_c14 ) 
    305305#endif 
    306 #if defined key_trc_dia3d  && defined key_iomput 
     306#if defined key_diatrc  && defined key_iomput 
    307307      CALL iom_put( "fdecay" , zw3d ) 
    308308#endif 
    309309      IF( l_trdtrc ) THEN 
    310          CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptrc_trd_sms, kt )   ! save trends 
     310         CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
    311311      END IF 
    312312 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r2047 r2528  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    77   !!---------------------------------------------------------------------- 
    8    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     8   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    99   !! $Id$  
    10    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     10   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r2047 r2528  
    3030 
    3131   !!---------------------------------------------------------------------- 
    32    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     32   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3333   !! $Id$  
    34    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3535   !!---------------------------------------------------------------------- 
    3636 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcrst_cfc.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2423 r2528  
    1818   USE par_trc      ! TOP parameters 
    1919   USE trc          ! TOP variables 
    20    USE trdmld_trc_oce 
    21    USE trdmld_trc 
     20   USE trdmod_oce 
     21   USE trdmod_trc 
    2222   USE iom 
    2323 
    … …  
    3434   INTEGER , PUBLIC    ::   npyear         ! Number of years read in CFC1112 file 
    3535    
    36    REAL(wp), PUBLIC, DIMENSION(jpyear,jphem,2     ) ::   p_cfc    ! partial hemispheric pressure for CFC           
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)             ::   xphem    ! spatial interpolation factor for patm 
     36   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2    ) ::   p_cfc    ! partial hemispheric pressure for CFC           
     37   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)              ::   xphem    ! spatial interpolation factor for patm 
    3838   REAL(wp), PUBLIC, DIMENSION(jpi,jpj     ,jp_cfc) ::   qtr_cfc  ! flux at surface 
    3939   REAL(wp), PUBLIC, DIMENSION(jpi,jpj     ,jp_cfc) ::   qint_cfc ! cumulative flux  
    … …  
    5252#  include "top_substitute.h90" 
    5353   !!---------------------------------------------------------------------- 
    54    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     54   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5555   !! $Id$  
    56    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     56   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5757   !!---------------------------------------------------------------------- 
    5858 
    … …  
    9393      !!---------------------------------------------------------------------- 
    9494 
    95       IF( kt == nittrc000 )   CALL trc_cfc_cst 
     95      IF( kt == nit000 )   CALL trc_cfc_cst 
    9696 
    9797      ! Temporal interpolation 
    … …  
    129129               ! coefficient for solubility for CFC-11/12 in  mol/l/atm 
    130130               IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 
    131                   ztap  = ( tn(ji,jj,1) + 273.16 ) * 0.01 
     131                  ztap  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01 
    132132                  zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) )  
    133133                  zsol  =  EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap )   & 
    134                      &                    + soa(4,jl) * ztap * ztap + sn(ji,jj,1) * zdtap )  
     134                     &                    + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap )  
    135135               ELSE 
    136136                  zsol  = 0.e0 
    … …  
    143143               ! Computation of speed transfert 
    144144               !    Schmidt number 
    145                zt1  = tn(ji,jj,1) 
     145               zt1  = tsn(ji,jj,1,jp_tem) 
    146146               zt2  = zt1 * zt1  
    147147               zt3  = zt1 * zt2 
    … …  
    156156               ! trn in pico-mol/l idem qtr; ak in en m/s 
    157157               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    158 #if defined key_off_degrad 
     158#if defined key_degrad 
    159159                  &                         * facvol(ji,jj,1)                           & 
    160160#endif 
    … …  
    173173      !                                                     !----------------! 
    174174 
    175 #if defined key_trc_diaadd  
     175#if defined key_diatrc  
    176176      ! Save diagnostics , just for CFC11 
    177177# if ! defined key_iomput 
    … …  
    187187          DO jn = jp_cfc0, jp_cfc1 
    188188            ztrcfc(:,:,:) = tra(:,:,:,jn) 
    189             CALL trd_mod_trc( ztrcfc, jn, jptrc_trd_sms, kt )   ! save trends 
     189            CALL trd_mod_trc( ztrcfc, jn, jptra_trd_sms, kt )   ! save trends 
    190190          END DO 
    191191      END IF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90

    r2047 r2528  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    77   !!---------------------------------------------------------------------- 
    8    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     8   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    99   !! $Id$  
    10    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     10   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    1212 
    … …  
    1919   LOGICAL, PUBLIC, PARAMETER ::   lk_lobster     = .TRUE.    !: LOBSTER flag  
    2020   INTEGER, PUBLIC, PARAMETER ::   jp_lobster     =  6        !: number of LOBSTER tracers 
    21    INTEGER, PUBLIC, PARAMETER ::   jp_lobster_2d  = 19        !: additional 2d output arrays ('key_trc_diaadd') 
    22    INTEGER, PUBLIC, PARAMETER ::   jp_lobster_3d  =  3        !: additional 3d output arrays ('key_trc_diaadd') 
     21   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_2d  = 19        !: additional 2d output arrays ('key_diatrc') 
     22   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_3d  =  3        !: additional 3d output arrays ('key_diatrc') 
    2323   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_trd = 17       !: number of sms trends for LOBSTER 
    2424 
    2525   ! assign an index in trc arrays for each LOBSTER prognostic variables 
    26    INTEGER, PUBLIC, PARAMETER ::   jpdet          =  1        !: detritus                    [mmoleN/m3] 
    27    INTEGER, PUBLIC, PARAMETER ::   jpzoo          =  2        !: zooplancton concentration   [mmoleN/m3] 
    28    INTEGER, PUBLIC, PARAMETER ::   jpphy          =  3        !: phytoplancton concentration [mmoleN/m3] 
    29    INTEGER, PUBLIC, PARAMETER ::   jpno3          =  4        !: nitrate concentration       [mmoleN/m3] 
    30    INTEGER, PUBLIC, PARAMETER ::   jpnh4          =  5        !: ammonium concentration      [mmoleN/m3] 
    31    INTEGER, PUBLIC, PARAMETER ::   jpdom          =  6        !: dissolved organic matter    [mmoleN/m3] 
     26   INTEGER, PUBLIC, PARAMETER ::   jp_lob_det     =  1        !: detritus                    [mmoleN/m3] 
     27   INTEGER, PUBLIC, PARAMETER ::   jp_lob_zoo     =  2        !: zooplancton concentration   [mmoleN/m3] 
     28   INTEGER, PUBLIC, PARAMETER ::   jp_lob_phy     =  3        !: phytoplancton concentration [mmoleN/m3] 
     29   INTEGER, PUBLIC, PARAMETER ::   jp_lob_no3     =  4        !: nitrate concentration       [mmoleN/m3] 
     30   INTEGER, PUBLIC, PARAMETER ::   jp_lob_nh4     =  5        !: ammonium concentration      [mmoleN/m3] 
     31   INTEGER, PUBLIC, PARAMETER ::   jp_lob_dom     =  6        !: dissolved organic matter    [mmoleN/m3] 
    3232 
    3333   ! productive layer depth 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90

    r1152 r2528  
    2323 
    2424   !!---------------------------------------------------------------------- 
    25    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     25   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    2626   !! $Id$  
    27    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     27   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2828   !!---------------------------------------------------------------------- 
    2929 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r1795 r2528  
    2020   USE lbclnk          !  
    2121   USE prtctl_trc      ! Print control for debbuging 
    22    USE trdmld_trc 
    23    USE trdmld_trc_oce 
     22   USE trdmod_oce 
     23   USE trdmod_trc 
    2424   USE iom 
    2525    
    … …  
    3232#  include "top_substitute.h90" 
    3333   !!---------------------------------------------------------------------- 
    34    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     34   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3535   !! $Id$  
    36    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 
    3838 
    … …  
    5757      !!                                  source      sink 
    5858      !!         
    59       !!              IF 'key_trc_diabio' defined , the biogeochemical trends 
     59      !!              IF 'key_diabio' defined , the biogeochemical trends 
    6060      !!              for passive tracers are saved for futher diagnostics. 
    6161      !!--------------------------------------------------------------------- 
    … …  
    7171      REAL(wp) ::   zfilpz, zfildz, zphya, zzooa, zno3a 
    7272      REAL(wp) ::   znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 
    73 #if defined key_trc_diaadd 
     73#if defined key_diatrc 
    7474      REAL(wp) ::   ze3t 
    7575#endif 
    76 #if defined key_trc_diaadd && defined key_iomput 
     76#if defined key_diatrc && defined key_iomput 
    7777      REAL(wp), DIMENSION(jpi,jpj,17)     :: zw2d 
    78 # if defined key_trc_dia3d 
    7978      REAL(wp), DIMENSION(jpi,jpj,jpk,3) :: zw3d 
    80 # endif 
    8179#endif 
    8280      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrbio 
    … …  
    9189 
    9290      fbod(:,:) = 0.e0 
    93 #if defined key_trc_diaadd && ! defined key_iomput 
     91#if defined key_diatrc && ! defined key_iomput 
    9492      DO jl = jp_lob0_2d, jp_lob1_2d 
    9593         trc2d(:,:,jl) = 0.e0 
    9694      END DO  
    9795#endif 
    98 #if defined key_trc_diaadd && defined key_iomput 
     96#if defined key_diatrc && defined key_iomput 
    9997      zw2d(:,:,:) = 0.e0 
    100 # if defined key_trc_dia3d 
    10198      zw3d(:,:,:,:) = 0.e0 
    102 # endif 
    10399#endif 
    104100 
    … …  
    117113 
    118114               ! negative trophic variables DO not contribute to the fluxes 
    119                zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 
    120                zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 
    121                zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 
    122                zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 
    123                znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 
    124                zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 
     115               zdet = MAX( 0.e0, trn(ji,jj,jk,jp_lob_det) ) 
     116               zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) ) 
     117               zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) ) 
     118               zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) ) 
     119               znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) ) 
     120               zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) ) 
    125121 
    126122               ! Limitations 
    … …  
    194190 
    195191               ! tracer flux at totox-point added to the general trend 
    196                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
    197                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
    198                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
    199                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
    200                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
    201                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    202  
    203 #if defined key_trc_diabio 
     192               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta 
     193               tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa 
     194               tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya 
     195               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a 
     196               tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a 
     197               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma 
     198 
     199#if defined key_diabio 
    204200               trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
    205201               trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
    … …  
    238234                ENDIF 
    239235 
    240 #if defined key_trc_diaadd 
     236#if defined key_diatrc 
    241237               ! convert fluxes in per day 
    242238               ze3t = fse3t(ji,jj,jk) * 86400. 
    … …  
    282278               zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
    283279#endif 
    284 #if defined key_trc_dia3d  
     280#if defined key_diatrc  
    285281# if ! defined key_iomput 
    286282               trc3d(ji,jj,jk,jp_lob0_3d    ) = zno3phy * 86400      
    … …  
    307303               !    trophic variables( det, zoo, phy, no3, nh4, dom) 
    308304               !       negative trophic variables DO not contribute to the fluxes 
    309                zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) ) 
    310                zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) ) 
    311                zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) ) 
    312                zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) ) 
    313                znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) ) 
    314                zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) ) 
     305               zdet = MAX( 0.e0, trn(ji,jj,jk,jp_lob_det) ) 
     306               zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) ) 
     307               zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) ) 
     308               zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) ) 
     309               znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) ) 
     310               zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) ) 
    315311 
    316312               !    Limitations 
    … …  
    363359 
    364360               ! tracer flux at totox-point added to the general trend 
    365                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
    366                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
    367                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
    368                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
    369                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
    370                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
     361               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta 
     362               tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa 
     363               tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya 
     364               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a 
     365               tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a 
     366               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma 
    371367               ! 
    372 #if defined key_trc_diabio 
     368#if defined key_diabio 
    373369               trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
    374370               trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
    … …  
    406402                  !  trend number 17 in trcexp 
    407403                ENDIF 
    408 #if defined key_trc_diaadd && defined key_trc_dia3d 
     404#if defined key_diatrc 
    409405# if ! defined key_iomput 
    410406               trc3d(ji,jj,jk,jp_lob0_3d    ) =  zno3phy * 86400      
    … …  
    421417      END DO 
    422418 
    423 #if defined key_trc_diaadd 
     419#if defined key_diatrc 
    424420      ! Lateral boundary conditions  
    425421# if ! defined key_iomput 
    … …  
    452448#endif 
    453449 
    454 #if defined key_trc_diaadd && defined key_trc_dia3d 
     450#if defined key_diatrc 
    455451      ! Lateral boundary conditions  
    456452# if ! defined key_iomput 
    … …  
    469465#endif 
    470466 
    471 #if defined key_trc_diabio 
     467#if defined key_diabio 
    472468      ! Lateral boundary conditions on trcbio 
    473469      DO jl = jp_lob0_trd, jp_lob1_trd 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r1795 r2528  
    1919   USE lbclnk 
    2020   USE trc 
    21    USE trctrp_lec 
     21   USE trcnam_trp 
    2222   USE prtctl_trc      ! Print control for debbuging 
    23    USE trdmld_trc 
    24    USE trdmld_trc_oce 
     23   USE trdmod_oce 
     24   USE trdmod_trc 
    2525   USE iom 
    2626 
    … …  
    3333#  include "top_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    35    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     35   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3636   !! $Id$  
    37    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 
    3939 
    … …  
    5555      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    5656      !! 
    57       INTEGER  ::   ji, jj, jk, jl, ikbot 
    58       REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t 
     57      INTEGER  ::   ji, jj, jk, jl, ikt 
     58      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd 
    5959      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio 
    6060      CHARACTER (len=25) :: charout 
    … …  
    7575      IF( l_trdtrc )THEN 
    7676         ALLOCATE( ztrbio(jpi,jpj,jpk) ) 
    77          ztrbio(:,:,:) = tra(:,:,:,jpno3) 
     77         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) 
    7878      ENDIF 
    7979 
    … …  
    8282            DO ji = fs_2, fs_jpim1 
    8383               ze3t = 1. / fse3t(ji,jj,jk) 
    84                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj) 
     84               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj) 
    8585            END DO 
    8686         END DO 
    … …  
    9595      DO jj = 2, jpjm1 
    9696         DO ji = fs_2, fs_jpim1 
    97             ikbot = mbathy(ji,jj) - 1 
    98             tra(ji,jj,ikbot,jpno3) = tra(ji,jj,ikbot,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot)  
     97            ikt = mbkt(ji,jj)  
     98            tra(ji,jj,ikt,jp_lob_no3) = tra(ji,jj,ikt,jp_lob_no3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt)  
    9999            ! Deposition of organic matter in the sediment 
    100             zwork = vsed * trn(ji,jj,ikbot,jpdet) 
     100            zwork = vsed * trn(ji,jj,ikt,jp_lob_det) 
    101101            sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(ji,jj)   & 
    102102               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
    … …  
    107107      DO jj = 2, jpjm1 
    108108         DO ji = fs_2, fs_jpim1 
    109             tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1) 
     109            tra(ji,jj,1,jp_lob_no3) = tra(ji,jj,1,jp_lob_no3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1) 
    110110         END DO 
    111111      END DO 
    … …  
    114114  
    115115      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example 
    116 #if defined key_trc_diaadd 
     116#if defined key_diatrc 
    117117# if ! defined key_iomput 
    118118      trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) 
    … …  
    122122#endif 
    123123 
    124       ! Leap-frog scheme (only in explicit case, otherwise the  
    125       ! ----------------  time stepping is already done in trczdf) 
    126       IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 
    127          zfact = 2. * rdttra(jk) * FLOAT( ndttrc )  
    128          IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(ndttrc)  
    129          sedpoca(:,:) =  sedpocb(:,:) + zfact * sedpoca(:,:)  
    130       ENDIF 
    131  
    132124       
    133125      ! Time filter and swap of arrays 
    134126      ! ------------------------------ 
    135       IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         ! centred or tvd scheme 
    136          IF( neuler == 0 .AND. kt == nittrc000 ) THEN 
    137             DO jj = 1, jpj 
    138                DO ji = 1, jpi 
    139                   sedpocb(ji,jj) = sedpocn(ji,jj) 
    140                   sedpocn(ji,jj) = sedpoca(ji,jj) 
    141                   sedpoca(ji,jj) = 0.e0 
    142                END DO 
    143             END DO 
    144          ELSE 
    145             DO jj = 1, jpj 
    146                DO ji = 1, jpi 
    147                   sedpocb(ji,jj) = atfp  * ( sedpocb(ji,jj) + sedpoca(ji,jj) )    & 
    148                      &           + atfp1 *   sedpocn(ji,jj) 
    149                   sedpocn(ji,jj) = sedpoca(ji,jj) 
    150                   sedpoca(ji,jj) = 0.e0 
    151                END DO 
    152             END DO 
    153          ENDIF 
    154       ELSE                                                   !  case of smolar scheme or muscl 
    155          sedpocb(:,:) = sedpoca(:,:) 
    156          sedpocn(:,:) = sedpoca(:,:) 
    157          sedpoca(:,:) = 0.e0 
     127      IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
     128        !                                             ! (only swap) 
     129        sedpocn(:,:) = sedpoca(:,:) 
     130        !                                               
     131      ELSE 
     132        ! 
     133        DO jj = 1, jpj 
     134           DO ji = 1, jpi 
     135              zsedpocd = sedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers 
     136              sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn 
     137              sedpocn(ji,jj) = sedpoca(ji,jj)                                       ! sedpocn <-- sedpoca 
     138           END DO 
     139        END DO 
     140        !  
    158141      ENDIF 
     142      sedpoca(:,:) = 0.e0 
    159143      ! 
    160144      IF( l_trdtrc ) THEN 
    161          ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:) 
     145         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) - ztrbio(:,:,:) 
    162146         jl = jp_lob0_trd + 16 
    163147         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r1800 r2528  
    2020   USE oce_trc         ! ocean variables 
    2121   USE trc 
     22   USE lbclnk  
     23   USE lib_mpp  
     24   USE lib_fortran  
    2225 
    2326   IMPLICIT NONE 
    … …  
    2831#  include "top_substitute.h90" 
    2932   !!---------------------------------------------------------------------- 
    30    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     33   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3134   !! $Id$  
    32    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     35   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3336   !!---------------------------------------------------------------------- 
    3437 
    … …  
    4649      !!---------------------------------------------------------------------- 
    4750 
     51      !  Control consitency 
     52      CALL trc_ctl_lobster 
     53 
     54 
    4855      IF(lwp) WRITE(numout,*) 
    4956      IF(lwp) WRITE(numout,*) ' trc_ini_lobster :   LOBSTER biochemical model initialisation' 
    5057      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
    51  
    5258 
    5359      ! initialization of fields for optical model 
    … …  
    118124      ! Coastal mask  
    119125      ! ------------    
    120       cmask = 0.e0 
     126      cmask(:,:) = 0.e0 
    121127      DO ji = 2, jpi-1 
    122128         DO jj = 2, jpj-1 
    … …  
    128134      END DO 
    129135 
    130       cmask( 1 ,:) = cmask(jpi-1,:) 
    131       cmask(jpi,:) = cmask( 2   ,:) 
    132  
    133       !!gm BUG !!!!!   not valid in mpp and also not valid for north fold   !!!!! 
     136      CALL lbc_lnk( cmask, 'T', 1. ) 
    134137 
    135138      ! Coastal surface 
    136139      ! --------------- 
    137       areacot = 0.e0 
    138       DO ji = 2, jpi-1 
    139          DO jj = 2, jpj-1 
    140             areacot = areacot + e1t(ji,jj) * e2t(ji,jj) * cmask(ji,jj) 
    141          END DO 
    142       END DO 
    143       ! 
     140      areacot = glob_sum( e1t(:,:) * e2t(:,:) * cmask(:,:) ) 
    144141 
    145142      ! Initialization of tracer concentration in case of  no restart  
    … …  
    153150          
    154151         DO jk = 1, 7 
    155             trn(:,:,jk,jpdet) = 0.016 * tmask(:,:,jk) 
    156             trn(:,:,jk,jpzoo) = 0.018 * tmask(:,:,jk) 
    157             trn(:,:,jk,jpphy) = 0.036 * tmask(:,:,jk)  
    158             trn(:,:,jk,jpno3) = 1.e-5 * tmask(:,:,jk) 
    159             trn(:,:,jk,jpnh4) = 5.e-4 * tmask(:,:,jk) 
    160             trn(:,:,jk,jpdom) = 0.017 * tmask(:,:,jk) 
    161          END DO 
    162           
    163          trn(:,:, 8,jpdet) = 0.020   * tmask(:,:, 8) 
    164          trn(:,:, 8,jpzoo) = 0.027   * tmask(:,:, 8) 
    165          trn(:,:, 8,jpphy) = 0.041   * tmask(:,:, 8) 
    166          trn(:,:, 8,jpno3) = 0.00022 * tmask(:,:, 8) 
    167          trn(:,:, 8,jpnh4) = 0.0033  * tmask(:,:, 8) 
    168          trn(:,:, 8,jpdom) = 0.021   * tmask(:,:, 8) 
    169           
    170          trn(:,:, 9,jpdet) = 0.0556  * tmask(:,:, 9) 
    171          trn(:,:, 9,jpzoo) = 0.123   * tmask(:,:, 9) 
    172          trn(:,:, 9,jpphy) = 0.122   * tmask(:,:, 9) 
    173          trn(:,:, 9,jpno3) = 0.028   * tmask(:,:, 9) 
    174          trn(:,:, 9,jpnh4) = 0.024   * tmask(:,:, 9) 
    175          trn(:,:, 9,jpdom) = 0.06    * tmask(:,:, 9) 
    176           
    177          trn(:,:,10,jpdet) = 0.025   * tmask(:,:,10) 
    178          trn(:,:,10,jpzoo) = 0.016   * tmask(:,:,10) 
    179          trn(:,:,10,jpphy) = 0.029   * tmask(:,:,10) 
    180          trn(:,:,10,jpno3) = 2.462   * tmask(:,:,10) 
    181          trn(:,:,10,jpnh4) = 0.04    * tmask(:,:,10) 
    182          trn(:,:,10,jpdom) = 0.022   * tmask(:,:,10) 
    183           
    184          trn(:,:,11,jpdet) = 0.0057  * tmask(:,:,11) 
    185          trn(:,:,11,jpzoo) = 0.0005  * tmask(:,:,11) 
    186          trn(:,:,11,jpphy) = 0.0006  * tmask(:,:,11) 
    187          trn(:,:,11,jpno3) = 3.336   * tmask(:,:,11) 
    188          trn(:,:,11,jpnh4) = 0.005   * tmask(:,:,11) 
    189          trn(:,:,11,jpdom) = 0.004   * tmask(:,:,11) 
    190           
    191          trn(:,:,12,jpdet) = 0.002   * tmask(:,:,12) 
    192          trn(:,:,12,jpzoo) = 1.e-6   * tmask(:,:,12) 
    193          trn(:,:,12,jpphy) = 5.e-6   * tmask(:,:,12) 
    194          trn(:,:,12,jpno3) = 4.24    * tmask(:,:,12) 
    195          trn(:,:,12,jpnh4) = 0.001   * tmask(:,:,12) 
    196          trn(:,:,12,jpdom) = 3.e-5   * tmask(:,:,12) 
     152            trn(:,:,jk,jp_lob_det) = 0.016 * tmask(:,:,jk) 
     153            trn(:,:,jk,jp_lob_zoo) = 0.018 * tmask(:,:,jk) 
     154            trn(:,:,jk,jp_lob_phy) = 0.036 * tmask(:,:,jk)  
     155            trn(:,:,jk,jp_lob_no3) = 1.e-5 * tmask(:,:,jk) 
     156            trn(:,:,jk,jp_lob_nh4) = 5.e-4 * tmask(:,:,jk) 
     157            trn(:,:,jk,jp_lob_dom) = 0.017 * tmask(:,:,jk) 
     158         END DO 
     159          
     160         trn(:,:, 8,jp_lob_det) = 0.020   * tmask(:,:, 8) 
     161         trn(:,:, 8,jp_lob_zoo) = 0.027   * tmask(:,:, 8) 
     162         trn(:,:, 8,jp_lob_phy) = 0.041   * tmask(:,:, 8) 
     163         trn(:,:, 8,jp_lob_no3) = 0.00022 * tmask(:,:, 8) 
     164         trn(:,:, 8,jp_lob_nh4) = 0.0033  * tmask(:,:, 8) 
     165         trn(:,:, 8,jp_lob_dom) = 0.021   * tmask(:,:, 8) 
     166          
     167         trn(:,:, 9,jp_lob_det) = 0.0556  * tmask(:,:, 9) 
     168         trn(:,:, 9,jp_lob_zoo) = 0.123   * tmask(:,:, 9) 
     169         trn(:,:, 9,jp_lob_phy) = 0.122   * tmask(:,:, 9) 
     170         trn(:,:, 9,jp_lob_no3) = 0.028   * tmask(:,:, 9) 
     171         trn(:,:, 9,jp_lob_nh4) = 0.024   * tmask(:,:, 9) 
     172         trn(:,:, 9,jp_lob_dom) = 0.06    * tmask(:,:, 9) 
     173          
     174         trn(:,:,10,jp_lob_det) = 0.025   * tmask(:,:,10) 
     175         trn(:,:,10,jp_lob_zoo) = 0.016   * tmask(:,:,10) 
     176         trn(:,:,10,jp_lob_phy) = 0.029   * tmask(:,:,10) 
     177         trn(:,:,10,jp_lob_no3) = 2.462   * tmask(:,:,10) 
     178         trn(:,:,10,jp_lob_nh4) = 0.04    * tmask(:,:,10) 
     179         trn(:,:,10,jp_lob_dom) = 0.022   * tmask(:,:,10) 
     180          
     181         trn(:,:,11,jp_lob_det) = 0.0057  * tmask(:,:,11) 
     182         trn(:,:,11,jp_lob_zoo) = 0.0005  * tmask(:,:,11) 
     183         trn(:,:,11,jp_lob_phy) = 0.0006  * tmask(:,:,11) 
     184         trn(:,:,11,jp_lob_no3) = 3.336   * tmask(:,:,11) 
     185         trn(:,:,11,jp_lob_nh4) = 0.005   * tmask(:,:,11) 
     186         trn(:,:,11,jp_lob_dom) = 0.004   * tmask(:,:,11) 
     187          
     188         trn(:,:,12,jp_lob_det) = 0.002   * tmask(:,:,12) 
     189         trn(:,:,12,jp_lob_zoo) = 1.e-6   * tmask(:,:,12) 
     190         trn(:,:,12,jp_lob_phy) = 5.e-6   * tmask(:,:,12) 
     191         trn(:,:,12,jp_lob_no3) = 4.24    * tmask(:,:,12) 
     192         trn(:,:,12,jp_lob_nh4) = 0.001   * tmask(:,:,12) 
     193         trn(:,:,12,jp_lob_dom) = 3.e-5   * tmask(:,:,12) 
    197194          
    198195         DO jk=13,jpk 
    199             trn(:,:,jk,jpdet) = 0.e0 
    200             trn(:,:,jk,jpzoo) = 0.e0 
    201             trn(:,:,jk,jpphy) = 0.e0 
    202             trn(:,:,jk,jpnh4) = 0.e0 
    203             trn(:,:,jk,jpdom) = 0.e0 
    204          END DO 
    205           
    206          trn(:,:,13,jpno3) = 5.31  * tmask(:,:,13) 
    207          trn(:,:,14,jpno3) = 6.73  * tmask(:,:,14) 
    208          trn(:,:,15,jpno3) = 8.32  * tmask(:,:,15) 
    209          trn(:,:,16,jpno3) = 10.13 * tmask(:,:,16) 
    210          trn(:,:,17,jpno3) = 11.95 * tmask(:,:,17) 
    211          trn(:,:,18,jpno3) = 13.57 * tmask(:,:,18) 
    212          trn(:,:,19,jpno3) = 15.08 * tmask(:,:,19) 
    213          trn(:,:,20,jpno3) = 16.41 * tmask(:,:,20) 
    214          trn(:,:,21,jpno3) = 17.47 * tmask(:,:,21) 
    215          trn(:,:,22,jpno3) = 18.29 * tmask(:,:,22) 
    216          trn(:,:,23,jpno3) = 18.88 * tmask(:,:,23) 
    217          trn(:,:,24,jpno3) = 19.30 * tmask(:,:,24) 
    218          trn(:,:,25,jpno3) = 19.68 * tmask(:,:,25) 
    219          trn(:,:,26,jpno3) = 19.91 * tmask(:,:,26) 
    220          trn(:,:,27,jpno3) = 19.99 * tmask(:,:,27) 
    221          trn(:,:,28,jpno3) = 20.01 * tmask(:,:,28) 
    222          trn(:,:,29,jpno3) = 20.01 * tmask(:,:,29) 
    223          trn(:,:,30,jpno3) = 20.01 * tmask(:,:,30) 
     196            trn(:,:,jk,jp_lob_det) = 0.e0 
     197            trn(:,:,jk,jp_lob_zoo) = 0.e0 
     198            trn(:,:,jk,jp_lob_phy) = 0.e0 
     199            trn(:,:,jk,jp_lob_nh4) = 0.e0 
     200            trn(:,:,jk,jp_lob_dom) = 0.e0 
     201         END DO 
     202          
     203         trn(:,:,13,jp_lob_no3) = 5.31  * tmask(:,:,13) 
     204         trn(:,:,14,jp_lob_no3) = 6.73  * tmask(:,:,14) 
     205         trn(:,:,15,jp_lob_no3) = 8.32  * tmask(:,:,15) 
     206         trn(:,:,16,jp_lob_no3) = 10.13 * tmask(:,:,16) 
     207         trn(:,:,17,jp_lob_no3) = 11.95 * tmask(:,:,17) 
     208         trn(:,:,18,jp_lob_no3) = 13.57 * tmask(:,:,18) 
     209         trn(:,:,19,jp_lob_no3) = 15.08 * tmask(:,:,19) 
     210         trn(:,:,20,jp_lob_no3) = 16.41 * tmask(:,:,20) 
     211         trn(:,:,21,jp_lob_no3) = 17.47 * tmask(:,:,21) 
     212         trn(:,:,22,jp_lob_no3) = 18.29 * tmask(:,:,22) 
     213         trn(:,:,23,jp_lob_no3) = 18.88 * tmask(:,:,23) 
     214         trn(:,:,24,jp_lob_no3) = 19.30 * tmask(:,:,24) 
     215         trn(:,:,25,jp_lob_no3) = 19.68 * tmask(:,:,25) 
     216         trn(:,:,26,jp_lob_no3) = 19.91 * tmask(:,:,26) 
     217         trn(:,:,27,jp_lob_no3) = 19.99 * tmask(:,:,27) 
     218         trn(:,:,28,jp_lob_no3) = 20.01 * tmask(:,:,28) 
     219         trn(:,:,29,jp_lob_no3) = 20.01 * tmask(:,:,29) 
     220         trn(:,:,30,jp_lob_no3) = 20.01 * tmask(:,:,30) 
    224221 
    225222# elif defined key_gyre 
    … …  
    227224         ! ---------------------- 
    228225         ! here:  init NO3=f(density) by asklod AS Kremeur 2005-07 
    229          trn(:,:,:,jpdet) = 0.1 * tmask(:,:,:) 
    230          trn(:,:,:,jpzoo) = 0.1 * tmask(:,:,:) 
    231          trn(:,:,:,jpnh4) = 0.1 * tmask(:,:,:) 
    232          trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:) 
    233          trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:) 
     226         trn(:,:,:,jp_lob_det) = 0.1 * tmask(:,:,:) 
     227         trn(:,:,:,jp_lob_zoo) = 0.1 * tmask(:,:,:) 
     228         trn(:,:,:,jp_lob_nh4) = 0.1 * tmask(:,:,:) 
     229         trn(:,:,:,jp_lob_phy) = 0.1 * tmask(:,:,:) 
     230         trn(:,:,:,jp_lob_dom) = 1.0 * tmask(:,:,:) 
    234231         DO jk = 1, jpk 
    235232            DO jj = 1, jpj 
    236233               DO ji = 1, jpi 
    237234                  IF( rhd(ji,jj,jk) <= 24.5e-3 ) THEN 
    238                      trn(ji,jj,jk,jpno3) = 2. * tmask(ji,jj,jk) 
     235                     trn(ji,jj,jk,jp_lob_no3) = 2. * tmask(ji,jj,jk) 
    239236                  ELSE 
    240                      trn(ji,jj,jk,jpno3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk) 
     237                     trn(ji,jj,jk,jp_lob_no3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk) 
    241238                  ENDIF 
    242239               END DO 
    … …  
    259256   END SUBROUTINE trc_ini_lobster 
    260257 
     258   SUBROUTINE trc_ctl_lobster 
     259      !!---------------------------------------------------------------------- 
     260      !!                     ***  ROUTINE trc_ctl_lobster  *** 
     261      !! 
     262      !! ** Purpose :   control the cpp options, namelist and files  
     263      !!---------------------------------------------------------------------- 
     264      INTEGER :: jl, jn 
     265 
     266      IF(lwp) WRITE(numout,*) 
     267      IF(lwp) WRITE(numout,*) ' use LOBSTER biological model ' 
     268 
     269      ! Check number of tracers 
     270      ! ----------------------- 
     271      IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' ) 
     272 
     273      ! Check tracer names 
     274      ! ------------------ 
     275      IF(   ctrcnm(jp_lob_det) /= 'DET' .OR. ctrcnm(jp_lob_zoo) /= 'ZOO' .OR.   & 
     276         &  ctrcnm(jp_lob_phy) /= 'PHY' .OR. ctrcnm(jp_lob_no3) /= 'NO3' .OR.   & 
     277         &  ctrcnm(jp_lob_nh4) /= 'NH4' .OR. ctrcnm(jp_lob_dom) /= 'DOM' .OR.   & 
     278         &  ctrcnl(jp_lob_det) /= 'Detritus'                        .OR.   & 
     279         &  ctrcnl(jp_lob_zoo) /= 'Zooplankton concentration'       .OR.   & 
     280         &  ctrcnl(jp_lob_phy) /= 'Phytoplankton concentration'     .OR.   & 
     281         &  ctrcnl(jp_lob_no3) /= 'Nitrate concentration'           .OR.   & 
     282         &  ctrcnl(jp_lob_nh4) /= 'Ammonium concentration'          .OR.   & 
     283         &  ctrcnl(jp_lob_dom) /= 'Dissolved organic matter' ) THEN 
     284         ctrcnm(jp_lob_det)='DET' 
     285         ctrcnl(jp_lob_det)='Detritus' 
     286         ctrcnm(jp_lob_zoo)='ZOO' 
     287         ctrcnl(jp_lob_zoo)='Zooplankton concentration' 
     288         ctrcnm(jp_lob_phy)='PHY' 
     289         ctrcnl(jp_lob_phy)='Phytoplankton concentration' 
     290         ctrcnm(jp_lob_no3)='NO3' 
     291         ctrcnl(jp_lob_no3)='Nitrate concentration' 
     292         ctrcnm(jp_lob_nh4)='NH4' 
     293         ctrcnl(jp_lob_nh4)='Ammonium concentration' 
     294         ctrcnm(jp_lob_dom)='DOM' 
     295         ctrcnl(jp_lob_dom)='Dissolved organic matter' 
     296         IF(lwp) THEN 
     297            CALL ctl_warn( ' We force tracer names ' ) 
     298            DO jl = 1, jp_lobster 
     299               jn = jp_lob0 + jl - 1 
     300               WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 
     301            END DO 
     302            WRITE(numout,*) ' ' 
     303         ENDIF 
     304      ENDIF 
     305 
     306      ! Check tracer units 
     307      DO jl = 1, jp_lobster 
     308         jn = jp_lob0 + jl - 1 
     309         IF( ctrcun(jn) /= 'mmole-N/m3') THEN 
     310            ctrcun(jn) = 'mmole-N/m3' 
     311            IF(lwp) THEN 
     312               CALL ctl_warn( ' We force tracer units ' ) 
     313               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
     314            ENDIF 
     315         ENDIF 
     316      END DO 
     317 
     318   END SUBROUTINE trc_ctl_lobster 
     319 
    261320#else 
    262321   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r1800 r2528  
    3030#  include "top_substitute.h90" 
    3131   !!---------------------------------------------------------------------- 
    32    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     32   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3333   !! $Id$  
    34    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3535   !!---------------------------------------------------------------------- 
    3636 
    … …  
    7878      zparg  (:,:,1) = zpar0m(:,:) * 0.5 
    7979 
    80 !!gm optimisation : introduce zcoef and LOG computed once for all 
    81  
    8280      !                                          ! Photosynthetically Available Radiation (PAR) 
    8381      zcoef = 12 * redf / rcchl / rpig           ! -------------------------------------- 
    … …  
    8583         DO jj = 1, jpj 
    8684            DO ji = 1, jpi 
    87 !!gm           zpig = MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef 
    88 !!gm           zkr  = xkr0 + xkrp * EXP( xlr * LOG(zpig) ) 
    89 !!gm           zkg  = xkg0 + xkgp * EXP( xlg * LOG(zpig) ) 
    90                zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jpphy) ) * zcoef  ) 
     85               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk-1,jp_lob_phy) ) * zcoef  ) 
    9186               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    9287               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    … …  
    9691        END DO 
    9792      END DO 
    98 !!gm optimisation : suppress one division 
    9993      DO jk = 1, jpkm1                                ! mean par at t-levels 
    10094         DO jj = 1, jpj 
    10195            DO ji = 1, jpi 
    102                zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jpphy) ) * zcoef  ) 
     96               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jp_lob_phy) ) * zcoef  ) 
    10397               zkr  = xkr0 + xkrp * EXP( xlr * zpig ) 
    10498               zkg  = xkg0 + xkgp * EXP( xlg * zpig ) 
    105 !!gm           zparr(ji,jj,jk) = zparr(ji,jj,jk) / zkr / fse3t(ji,jj,jk) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 
    106 !!gm           zparg(ji,jj,jk) = zparg(ji,jj,jk) / zkg / fse3t(ji,jj,jk) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) 
    10799               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) ) 
    108100               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90

    • Property svn:keywords set to Id
    r1801 r2528  
    4343      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    4444 
    45       CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )  
    46       CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )  
     45      CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) )  
     46      CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) )  
    4747 
    4848   END SUBROUTINE trc_rst_read_lobster 
    … …  
    6464      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    6565 
    66       CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
    67       CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
     66      CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) 
     67      CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) 
    6868 
    6969   END SUBROUTINE trc_rst_wri_lobster 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r1800 r2528  
    1818   USE sms_lobster 
    1919   USE lbclnk 
    20    USE trdmld_trc 
    21    USE trdmld_trc_oce 
     20   USE trdmod_oce 
     21   USE trdmod_trc 
    2222   USE iom 
    2323   USE prtctl_trc      ! Print control for debbuging 
    … …  
    3131#  include "top_substitute.h90" 
    3232   !!---------------------------------------------------------------------- 
    33    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     33   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3434   !! $Id$  
    35    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     35   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    3737 
    … …  
    5353      !!                             tra = tra + dz(trn wn) 
    5454      !!         
    55       !!              IF 'key_trc_diabio' is defined, the now vertical advection 
     55      !!              IF 'key_diabio' is defined, the now vertical advection 
    5656      !!              trend of passive tracers is saved for futher diagnostics. 
    5757      !!--------------------------------------------------------------------- 
    … …  
    6161      REAL(wp) ::   ztra 
    6262      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork 
    63 #if defined key_trc_diaadd && defined key_iomput 
     63#if defined key_diatrc && defined key_iomput 
    6464      REAL(wp), DIMENSION(jpi,jpj) ::  zw2d 
    6565#endif 
    … …  
    7777      ! -------------------------------------------- 
    7878 
    79       ! for detritus sedimentation only - jpdet 
     79      ! for detritus sedimentation only - jp_lob_det 
    8080      zwork(:,:,1  ) = 0.e0      ! surface value set to zero 
    8181      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero 
    8282 
    83 #if defined key_trc_diaadd && defined key_iomput 
     83#if defined key_diatrc && defined key_iomput 
    8484      zw2d(:,:) = 0. 
    8585# endif 
    … …  
    8787      IF( l_trdtrc )THEN 
    8888         ALLOCATE( ztrbio(jpi,jpj,jpk) ) 
    89          ztrbio(:,:,:) = tra(:,:,:,jpdet) 
     89         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) 
    9090      ENDIF 
    9191 
    9292      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2 
    9393      DO jk = 2, jpkm1 
    94          zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet) 
     94         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jp_lob_det) 
    9595      END DO 
    9696 
    … …  
    100100            DO ji = 1,jpi 
    101101               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    102                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 
    103 #if defined key_trc_diabio 
     102               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + ztra 
     103#if defined key_diabio 
    104104               trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra 
    105105#endif 
    106 #if defined key_trc_diaadd 
     106#if defined key_diatrc 
    107107# if ! defined key_iomput 
    108108               trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400. 
    … …  
    115115      END DO 
    116116 
    117 #if defined key_trc_diabio 
     117#if defined key_diabio 
    118118      jl = jp_lob0_trd + 7 
    119119      CALL lbc_lnk (trbio(:,:,1,jl), 'T', 1. )    ! Lateral boundary conditions on trcbio 
    120120#endif 
    121 #if defined key_trc_diaadd 
     121#if defined key_diatrc 
    122122# if ! defined key_iomput 
    123123      jl = jp_lob0_2d + 7 
    … …  
    131131 
    132132      IF( l_trdtrc ) THEN 
    133          ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:) 
     133         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) - ztrbio(:,:,:) 
    134134         jl = jp_lob0_trd + 7 
    135135         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90

    r1255 r2528  
    1919   USE trcsed 
    2020   USE trcexp 
    21    USE trdmld_trc_oce 
     21   USE trdmod_oce 
     22   USE trdmod_trc_oce 
     23   USE trdmod_trc 
    2224   USE trdmld_trc 
    2325 
    … …  
    2830 
    2931   !!---------------------------------------------------------------------- 
    30    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     32   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3133   !! $Id$  
    32    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3335   !!---------------------------------------------------------------------- 
    3436 
    … …  
    5052 
    5153      CALL trc_opt( kt )      ! optical model 
    52  
    5354      CALL trc_bio( kt )      ! biological model 
    54  
    5555      CALL trc_sed( kt )      ! sedimentation model 
    56  
    5756      CALL trc_exp( kt )      ! export 
    5857 
    … …  
    6059          DO jn = jp_lob0, jp_lob1 
    6160            ztrlob(:,:,:) = tra(:,:,:,jn) 
    62             CALL trd_mod_trc( ztrlob, jn, jptrc_trd_sms, kt )   ! save trends 
     61            CALL trd_mod_trc( ztrlob, jn, jptra_trd_sms, kt )   ! save trends 
    6362          END DO 
    6463      END IF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90

    r2047 r2528  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    77   !!---------------------------------------------------------------------- 
    8    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     8   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    99   !! $Id$  
    10    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     10   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90

    r1542 r2528  
    2222 
    2323   !!---------------------------------------------------------------------- 
    24    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     24   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    2525   !! $Id$  
    26    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     26   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 
    2828 
    … …  
    3737      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    3838      !!---------------------------------------------------------------------- 
    39       !!---------------------------------------------------------------------- 
     39 
     40      !  Control consitency 
     41      CALL trc_ctl_my_trc 
    4042 
    4143      IF(lwp) WRITE(numout,*) 
    … …  
    4850   END SUBROUTINE trc_ini_my_trc 
    4951    
     52   SUBROUTINE trc_ctl_my_trc 
     53      !!---------------------------------------------------------------------- 
     54      !!                     ***  ROUTINE trc_ctl_pisces  *** 
     55      !! 
     56      !! ** Purpose :   control the cpp options, namelist and files  
     57      !!---------------------------------------------------------------------- 
     58 
     59      INTEGER :: jl, jn 
     60 
     61      IF(lwp) WRITE(numout,*) 
     62      IF(lwp) WRITE(numout,*) ' use COLOR tracer ' 
     63 
     64      DO jl = 1, jp_my_trc 
     65         jn = jp_myt0 + jl - 1 
     66         WRITE(ctrcnm(jn),'(a,i2.2)') 'CLR',jn 
     67         ctrcnl(jn)='Color concentration' 
     68         ctrcun(jn)='N/A' 
     69      END DO 
     70 
     71 
     72   END SUBROUTINE trc_ctl_my_trc 
     73 
    5074#else 
    5175   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcrst_my_trc.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r1255 r2528  
    1515   USE oce_trc         ! Ocean variables 
    1616   USE trc             ! TOP variables 
    17    USE trdmld_trc_oce 
    18    USE trdmld_trc 
     17   USE trdmod_oce 
     18   USE trdmod_trc 
    1919 
    2020   IMPLICIT NONE 
    … …  
    2424 
    2525   !!---------------------------------------------------------------------- 
    26    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     26   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    2727   !! $Id$  
    28    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     28   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2929   !!---------------------------------------------------------------------- 
    3030 
    … …  
    6464          DO jn = jp_myt0, jp_myt1 
    6565            ztrmyt(:,:,:) = tra(:,:,:,jn) 
    66             CALL trd_mod_trc( ztrmyt, jn, jptrc_trd_sms, kt )   ! save trends 
     66            CALL trd_mod_trc( ztrmyt, jn, jptra_trd_sms, kt )   ! save trends 
    6767          END DO 
    6868      END IF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    • Property svn:executable deleted
    r1800 r2528  
    4141#  include "top_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    43    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     43   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4444   !! $Id$  
    45    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     45   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    4747 
    … …  
    8484      CALL p4z_sink ( kt, jnt )     ! vertical flux of particulate organic matter 
    8585      CALL p4z_opt  ( kt, jnt )     ! Optic: PAR in the water column 
    86       CALL p4z_lim  ( kt, jnt )     ! co-limitations by the various nutrients 
     86      CALL p4z_lim  ( kt      )     ! co-limitations by the various nutrients 
    8787      CALL p4z_prod ( kt, jnt )     ! phytoplankton growth rate over the global ocean.  
    8888      !                             ! (for each element : C, Si, Fe, Chl ) 
    89       CALL p4z_rem  ( kt, jnt )     ! remineralization terms of organic matter+scavenging of Fe 
    90       CALL p4z_mort ( kt, jnt )     ! phytoplankton mortality 
     89      CALL p4z_rem  ( kt      )     ! remineralization terms of organic matter+scavenging of Fe 
     90      CALL p4z_mort ( kt      )     ! phytoplankton mortality 
    9191      !                             ! zooplankton sources/sinks routines  
    92       CALL p4z_micro( kt, jnt )           ! microzooplankton 
     92      CALL p4z_micro( kt      )           ! microzooplankton 
    9393      CALL p4z_meso ( kt, jnt )           ! mesozooplankton 
    9494 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    • Property svn:executable deleted
    r1800 r2528  
    149149#include "top_substitute.h90" 
    150150   !!---------------------------------------------------------------------- 
    151    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     151   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    152152   !! $Id$  
    153    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     153   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    154154   !!---------------------------------------------------------------------- 
    155155 
    … …  
    181181 
    182182            !                             ! SET ABSOLUTE TEMPERATURE 
    183             ztkel = tn(ji,jj,1) + 273.16 
     183            ztkel = tsn(ji,jj,1,jp_tem) + 273.16 
    184184            zqtt  = ztkel * 0.01 
    185185            zqtt2 = zqtt * zqtt 
    186             zsal  = sn(ji,jj,1) + (1.- tmask(ji,jj,1) ) * 35. 
     186            zsal  = tsn(ji,jj,1,jp_sal) + (1.- tmask(ji,jj,1) ) * 35. 
    187187            zlqtt = LOG( zqtt ) 
    188188 
    … …  
    214214 
    215215               ! SET ABSOLUTE TEMPERATURE 
    216                ztkel   = tn(ji,jj,jk) + 273.16 
     216               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.16 
    217217               zqtt    = ztkel * 0.01 
    218                zsal    = sn(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 
     218               zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 
    219219               zsqrt  = SQRT( zsal ) 
    220220               zsal15  = zsqrt * zsal 
    … …  
    224224               zis2   = zis * zis 
    225225               zisqrt = SQRT( zis ) 
    226                ztc     = tn(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 
     226               ztc     = tsn(ji,jj,jk,jp_tem) + ( 1.- tmask(ji,jj,jk) ) * 20. 
    227227 
    228228               ! CHLORINITY (WOOSTER ET AL., 1969) 
    … …  
    249249                  &    + ( cb8 + cb9 * zsqrt + cb10 * zsal ) * zlogt + cb11 * zsqrt * ztkel             & 
    250250                  &    + LOG(  ( 1.+ zst / zcks + zft / zckf ) / ( 1.+ zst / zcks )  ) 
    251 !!gm zsal**2 to be replaced by a *... 
    252                zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal**2 
     251 
     252               zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal 
    253253               zck2    = c20 * ztr + c21 + c22 * zsal   + c23 * zsal**2 
    254254 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    • Property svn:executable deleted
    r1836 r2528  
    2828#endif 
    2929   USE lib_mpp 
     30   USE lib_fortran 
    3031 
    3132   IMPLICIT NONE 
    … …  
    3334 
    3435   PUBLIC   p4z_flx   
    35  
    36    REAL(wp) :: &  ! pre-industrial atmospheric [co2] (ppm)   
    37       atcox  = 0.20946 ,    &  !: 
    38       atcco2 = 278.            !: 
    39  
    40    REAL(wp) :: & 
    41       xconv  = 0.01/3600      !: coefficients for conversion  
    42  
    43    INTEGER  ::  nspyr         !: number of timestep per year 
    44  
    45 #if defined key_cpl_carbon_cycle 
    46    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  & 
    47       oce_co2            !: ocean carbon flux 
    48    REAL(wp) :: & 
    49       t_atm_co2_flx,  &  !: Total atmospheric carbon flux per year 
    50       t_oce_co2_flx      !: Total ocean carbon flux per year 
    51 #endif 
     36   PUBLIC   p4z_flx_init   
     37 
     38   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  oce_co2            !: ocean carbon flux  
     39   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  satmco2            !: atmospheric pco2 
     40   REAL(wp)                             ::  t_oce_co2_flx      !: Total ocean carbon flux  
     41   REAL(wp)                             ::  t_atm_co2_flx      !: global mean of atmospheric pco2 
     42   REAL(wp)                             ::  area               !: ocean surface 
     43   REAL(wp)                             ::  atcco2 = 278.      !: pre-industrial atmospheric [co2] (ppm)     
     44   REAL(wp)                             ::  atcox  = 0.20946   !: 
     45   REAL(wp)                             ::  xconv  = 0.01/3600 !: coefficients for conversion  
    5246 
    5347   !!* Substitution 
    5448#  include "top_substitute.h90" 
    5549   !!---------------------------------------------------------------------- 
    56    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     50   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5751   !! $Id$  
    58    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     52   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5953   !!---------------------------------------------------------------------- 
    6054 
    … …  
    7569      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
    7670      REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3 
    77 #if defined key_trc_diaadd && defined key_iomput 
    78       REAL(wp), DIMENSION(jpi,jpj) ::  zcflx, zoflx, zkg, zdpco2, zdpo2 
     71#if defined key_diatrc && defined key_iomput 
     72      REAL(wp), DIMENSION(jpi,jpj) ::  zoflx, zkg, zdpco2, zdpo2 
    7973#endif 
    8074      CHARACTER (len=25) :: charout 
    8175 
    8276      !!--------------------------------------------------------------------- 
    83  
    84  
    85       IF( kt == nittrc000  )   CALL p4z_flx_init      ! Initialization (first time-step only) 
    8677 
    8778      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    8879      !     SURFACE LAYER); THE RESULT OF THIS CALCULATION 
    8980      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
     81 
     82#if defined key_cpl_carbon_cycle 
     83      satmco2(:,:) = atm_co2(:,:) 
     84#endif 
    9085 
    9186      DO jrorr = 1, 10 
    … …  
    128123!CDIR NOVERRCHK 
    129124         DO ji = 1, jpi 
    130             ztc  = MIN( 35., tn(ji,jj,1) ) 
     125            ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) ) 
    131126            ztc2 = ztc * ztc 
    132127            ztc3 = ztc * ztc2  
    … …  
    138133            ! Compute the piston velocity for O2 and CO2 
    139134            zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 ) 
    140 # if defined key_off_degrad 
     135# if defined key_degrad 
    141136            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) * facvol(ji,jj,1) 
    142137#else 
    … …  
    152147         DO ji = 1, jpi 
    153148            ! Compute CO2 flux for the sea and air 
    154 #if ! defined key_cpl_carbon_cycle 
    155             zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
     149            zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    156150            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
    157 #else 
    158             zfld = atm_co2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    159             zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
    160             ! compute flux of carbon 
    161151            oce_co2(ji,jj) = ( zfld - zflu ) * rfact & 
    162152               &             * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    163 #endif 
     153            ! compute the trend 
    164154            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 
    165155 
    … …  
    169159            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 
    170160 
    171 #if defined key_trc_diaadd  
     161#if defined key_diatrc  
    172162            ! Save diagnostics 
    173163#  if ! defined key_iomput 
    174             trc2d(ji,jj,jp_pcs0_2d    ) = ( zfld - zflu )     * 1000. * tmask(ji,jj,1) 
     164            zfact = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) / rfact 
     165            trc2d(ji,jj,jp_pcs0_2d    ) = oce_co2(ji,jj) * zfact 
    175166            trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    176167            trc2d(ji,jj,jp_pcs0_2d + 2) = zkgco2(ji,jj) * tmask(ji,jj,1) 
    177             trc2d(ji,jj,jp_pcs0_2d + 3) = ( atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) & 
     168            trc2d(ji,jj,jp_pcs0_2d + 3) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) & 
    178169               &                            * tmask(ji,jj,1) 
    179170#  else 
    180             zcflx(ji,jj) = ( zfld - zflu ) * 1000.  * tmask(ji,jj,1) 
    181171            zoflx(ji,jj) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    182172            zkg  (ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 
    183             zdpco2(ji,jj) = ( atcco2 - zh2co3(ji,jj)      / ( chemc(ji,jj,1) + rtrn ) ) & 
    184               &             * tmask(ji,jj,1) 
    185             zdpo2 (ji,jj) = ( atcox  - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) & 
    186               &             * tmask(ji,jj,1) 
     173            zdpco2(ji,jj) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 
     174            zdpo2 (ji,jj) = ( atcox  - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) * tmask(ji,jj,1) 
    187175#  endif 
    188176#endif 
    … …  
    190178      END DO 
    191179 
    192 #if defined key_cpl_carbon_cycle 
    193       ! Total Flux of Carbon 
    194       DO jj = 1, jpj  
    195         DO ji = 1, jpi 
    196            t_atm_co2_flx = t_atm_co2_flx + atm_co2(ji,jj) * tmask_i(ji,jj) 
    197            t_oce_co2_flx = t_oce_co2_flx + oce_co2(ji,jj) * tmask_i(ji,jj) 
    198         END DO 
    199       END DO 
    200  
    201       IF( MOD( kt, nspyr ) == 0 ) THEN 
    202         IF( lk_mpp ) THEN 
    203           CALL mpp_sum( t_atm_co2_flx )   ! sum over the global domain 
    204           CALL mpp_sum( t_oce_co2_flx )   ! sum over the global domain 
    205         ENDIF 
    206         ! Conversion in GtC/yr ; negative for outgoing from ocean 
    207         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15 
    208         ! 
    209         WRITE(numout,*) ' Atmospheric pCO2    :' 
    210         WRITE(numout,*) '-------------------- : ',kt,'  ',t_atm_co2_flx 
    211         WRITE(numout,*) '(ppm)' 
    212         WRITE(numout,*) 'Total Flux of Carbon out of the ocean :' 
    213         WRITE(numout,*) '-------------------- : ',t_oce_co2_flx 
    214         WRITE(numout,*) '(GtC/yr)' 
    215         t_atm_co2_flx = 0. 
    216         t_oce_co2_flx = 0. 
    217 # if defined key_iomput 
    218         CALL iom_put( "tatpco2" , t_atm_co2_flx  ) 
    219         CALL iom_put( "tco2flx" , t_oce_co2_flx  ) 
    220 #endif 
     180      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )                     ! Cumulative Total Flux of Carbon 
     181      IF( kt == nitend ) THEN 
     182         t_atm_co2_flx = glob_sum( satmco2(:,:) * e1t(:,:) * e2t(:,:) )            ! Total atmospheric pCO2 
     183         ! 
     184         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15                      ! Conversion in PgC ; negative for out of the ocean 
     185         t_atm_co2_flx = t_atm_co2_flx  / area                                     ! global mean of atmospheric pCO2 
     186         ! 
     187         IF( lwp) THEN 
     188            WRITE(numout,*) 
     189            WRITE(numout,*) ' Global mean of atmospheric pCO2 (ppm) at it= ', kt, ' date= ', ndastp 
     190            WRITE(numout,*) '------------------------------------------------------- :  ',t_atm_co2_flx 
     191            WRITE(numout,*) 
     192            WRITE(numout,*) ' Cumulative total Flux of Carbon out of the ocean (PgC) :' 
     193            WRITE(numout,*) '-------------------------------------------------------  ',t_oce_co2_flx 
     194         ENDIF 
     195         ! 
    221196      ENDIF 
    222 #endif 
    223197 
    224198      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    228202      ENDIF 
    229203 
    230 # if defined key_trc_diaadd && defined key_iomput 
    231       CALL iom_put( "Cflx" , zcflx  ) 
     204# if defined key_diatrc && defined key_iomput 
     205      CALL iom_put( "Cflx" , oce_co2(:,:) / ( e1t(:,:) * e2t(:,:) ) / rfact  ) 
    232206      CALL iom_put( "Oflx" , zoflx  ) 
    233207      CALL iom_put( "Kg"   , zkg    ) 
    … …  
    246220      !! 
    247221      !! ** Method  :   Read the nampisext namelist and check the parameters 
    248       !!      called at the first timestep (nittrc000) 
     222      !!      called at the first timestep (nit000) 
    249223      !! ** input   :   Namelist nampisext 
    250224      !! 
    … …  
    263237      ENDIF 
    264238 
    265       ! number of time step per year   
    266       nspyr = INT( nyear_len(1) * rday / rdt ) 
    267  
    268 #if defined key_cpl_carbon_cycle 
     239      ! interior global domain surface 
     240      area = glob_sum( e1t(:,:) * e2t(:,:) )   
     241 
    269242      ! Initialization of Flux of Carbon 
    270       oce_co2(:,:) = 0. 
    271       t_atm_co2_flx = 0. 
    272       t_oce_co2_flx = 0. 
    273 #endif 
     243      oce_co2(:,:)  = 0._wp 
     244      t_atm_co2_flx = 0._wp 
     245      ! Initialisation of atmospheric pco2 
     246      satmco2(:,:)  = atcco2 
     247      t_oce_co2_flx = 0._wp 
    274248 
    275249   END SUBROUTINE p4z_flx_init 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

    • Property svn:executable deleted
    r1753 r2528  
    3232 
    3333   !!---------------------------------------------------------------------- 
    34    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     34   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3535   !! $Id$  
    36    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 
    3838 
    … …  
    5555      ! ------------------------------------------- 
    5656 
    57       tgfunc (:,:,:) = EXP( 0.063913 * tn(:,:,:) ) 
    58       tgfunc2(:,:,:) = EXP( 0.07608  * tn(:,:,:) ) 
     57      tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 
     58      tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) ) 
    5959 
    6060      ! Computation of the silicon dependant half saturation 
    … …  
    6969      END DO 
    7070 
    71       IF( nday_year == 365 ) THEN 
     71      IF( nday_year == nyear_len(1) ) THEN 
    7272         xksi    = xksimax 
    7373         xksimax = 0.e0 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r1800 r2528  
    2323 
    2424   PUBLIC p4z_lim     
     25   PUBLIC p4z_lim_init     
    2526 
    2627   !! * Shared module variables 
    … …  
    4344#  include "top_substitute.h90" 
    4445   !!---------------------------------------------------------------------- 
    45    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     46   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4647   !! $Id$  
    47    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4849   !!---------------------------------------------------------------------- 
    4950 
    5051CONTAINS 
    5152 
    52    SUBROUTINE p4z_lim( kt, jnt ) 
     53   SUBROUTINE p4z_lim( kt ) 
    5354      !!--------------------------------------------------------------------- 
    5455      !!                     ***  ROUTINE p4z_lim  *** 
    … …  
    5960      !! ** Method  : - ??? 
    6061      !!--------------------------------------------------------------------- 
    61       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     62      INTEGER, INTENT(in)  :: kt 
    6263      INTEGER  ::   ji, jj, jk 
    6364      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim 
    … …  
    6768 
    6869 
    69       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_lim_init      ! Initialization (first time-step only) 
    70  
    71  
    72 !  Tuning of the iron concentration to a minimum 
    73 !  level that is set to the detection limit 
    74 !  ------------------------------------- 
     70      !  Tuning of the iron concentration to a minimum 
     71      !  level that is set to the detection limit 
     72      !  ------------------------------------- 
    7573 
    7674      DO jk = 1, jpkm1 
    … …  
    8583      END DO 
    8684 
    87 !  Computation of a variable Ks for iron on diatoms 
    88 !  taking into account that increasing biomass is 
    89 !  made of generally bigger cells 
    90 !  ------------------------------------------------ 
     85      !  Computation of a variable Ks for iron on diatoms taking into account 
     86      !  that increasing biomass is made of generally bigger cells 
     87      !  ------------------------------------------------ 
    9188 
    9289      DO jk = 1, jpkm1 
    … …  
    107104      END DO 
    108105 
    109       DO jk = 1, jpkm1 
    110          DO jj = 1, jpj 
    111             DO ji = 1, jpi 
    112      
    113 !      Michaelis-Menten Limitation term for nutrients 
    114 !      Small flagellates 
    115 !      ----------------------------------------------- 
     106     !  Michaelis-Menten Limitation term for nutrients Small flagellates 
     107     !      ----------------------------------------------- 
     108      DO jk = 1, jpkm1 
     109         DO jj = 1, jpj 
     110            DO ji = 1, jpi 
    116111              zdenom = 1. / & 
    117112                  & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 
    … …  
    132127      END DO 
    133128 
    134       DO jk = 1, jpkm1 
    135          DO jj = 1, jpj 
    136             DO ji = 1, jpi 
    137  
    138 !   Michaelis-Menten Limitation term for nutrients Diatoms 
    139 !   ---------------------------------------------- 
     129      !   Michaelis-Menten Limitation term for nutrients Diatoms 
     130      !   ---------------------------------------------- 
     131      DO jk = 1, jpkm1 
     132         DO jj = 1, jpj 
     133            DO ji = 1, jpi 
    140134              zdenom = 1. / & 
    141135                  & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) 
    … …  
    161155         DO jj = 1, jpj 
    162156            DO ji = 1, jpi 
    163                ztemp = MAX( 0., tn(ji,jj,jk) ) 
     157               ztemp = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    164158               xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk)   & 
    165159                  &                       * MAX( 0.0001, ztemp / ( 2.+ ztemp ) )   & 
    … …  
    181175      !! 
    182176      !! ** Method  :   Read the nampislim namelist and check the parameters 
    183       !!      called at the first timestep (nittrc000) 
     177      !!      called at the first timestep (nit000) 
    184178      !! 
    185179      !! ** input   :   Namelist nampislim 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    • Property svn:executable deleted
    r1836 r2528  
    2727   PRIVATE 
    2828 
    29    PUBLIC   p4z_lys    ! called in p4zprg.F90 
     29   PUBLIC   p4z_lys         ! called in trcsms_pisces.F90 
     30   PUBLIC   p4z_lys_init    ! called in trcsms_pisces.F90 
    3031 
    3132   !! * Shared module variables 
    … …  
    4243 
    4344   !!---------------------------------------------------------------------- 
    44    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     45   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4546   !! $Id$  
    46    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     47   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4748   !!---------------------------------------------------------------------- 
    4849 
    … …  
    6566      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    6667      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zco3 
    67 #if defined key_trc_dia3d && defined key_iomput 
     68#if defined key_diatrc && defined key_iomput 
    6869      REAL(wp) ::   zrfact2 
    6970      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss 
    … …  
    7273      !!--------------------------------------------------------------------- 
    7374 
    74       IF( kt == nittrc000  )   CALL p4z_lys_init      ! Initialization (first time-step only) 
    75  
    7675      zco3(:,:,:) = 0. 
    7776 
    78 # if defined key_trc_dia3d && defined key_iomput 
     77# if defined key_diatrc && defined key_iomput 
    7978      zcaldiss(:,:,:) = 0. 
    8079# endif 
    … …  
    146145               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    147146               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    148 # if defined key_off_degrad 
     147# if defined key_degrad 
    149148              zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) * facvol(ji,jj,jk) 
    150149# else 
    … …  
    160159              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zremco3 
    161160 
    162 # if defined key_trc_dia3d && defined key_iomput 
     161# if defined key_diatrc && defined key_iomput 
    163162              zcaldiss(ji,jj,jk) = zremco3  ! calcite dissolution 
    164163# endif 
    … …  
    167166      END DO 
    168167 
    169 # if defined key_trc_diaadd &&  defined key_trc_dia3d 
     168# if defined key_diatrc 
    170169#  if ! defined key_iomput 
    171170      trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
    … …  
    197196      !! 
    198197      !! ** Method  :   Read the nampiscal namelist and check the parameters 
    199       !!      called at the first timestep (nittrc000) 
     198      !!      called at the first timestep (nit000) 
    200199      !! 
    201200      !! ** input   :   Namelist nampiscal 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    • Property svn:executable deleted
    r1836 r2528  
    2626   PRIVATE 
    2727 
    28    PUBLIC   p4z_meso         ! called in p4zbio.F90 
     28   PUBLIC   p4z_meso              ! called in p4zbio.F90 
     29   PUBLIC   p4z_meso_init         ! called in trcsms_pisces.F90 
    2930 
    3031   !! * Shared module variables 
    … …  
    4748#  include "top_substitute.h90" 
    4849   !!---------------------------------------------------------------------- 
    49    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     50   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5051   !! $Id$  
    51    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     52   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5253   !!---------------------------------------------------------------------- 
    5354 
    5455CONTAINS 
    5556 
    56    SUBROUTINE p4z_meso( kt,jnt ) 
     57   SUBROUTINE p4z_meso( kt, jnt ) 
    5758      !!--------------------------------------------------------------------- 
    5859      !!                     ***  ROUTINE p4z_meso  *** 
    … …  
    6566      INTEGER  :: ji, jj, jk 
    6667      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 
    67       REAL(wp) :: zfact, zstep, zcompam, zdenom, zgraze2 
     68      REAL(wp) :: zfact, zcompam, zdenom, zgraze2, zstep 
    6869      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 
    6970#if defined key_kriest 
    7071      REAL znumpoc 
    7172#endif 
    72       REAL(wp),DIMENSION(jpi,jpj,jpk) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 
    73       REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazn,zgrazpoc,zgraznf,zgrazf 
    74       REAL(wp),DIMENSION(jpi,jpj,jpk) :: zgrazfff,zgrazffe 
     73      REAL(wp) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 
     74      REAL(wp) :: zgrazn,zgrazpoc,zgraznf,zgrazf 
     75      REAL(wp) :: zgrazfff,zgrazffe 
    7576      CHARACTER (len=25) :: charout 
    76 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     77#if defined key_diatrc && defined key_iomput 
    7778      REAL(wp) :: zrfact2 
    7879#endif 
    7980 
    8081      !!--------------------------------------------------------------------- 
    81  
    82  
    83       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_meso_init      ! Initialization (first time-step only) 
    84  
    85       zrespz2 (:,:,:) = 0. 
    86       ztortz2 (:,:,:) = 0. 
    87       zgrazd  (:,:,:) = 0. 
    88       zgrazz  (:,:,:) = 0. 
    89       zgrazpof(:,:,:) = 0. 
    90       zgrazn  (:,:,:) = 0. 
    91       zgrazpoc(:,:,:) = 0. 
    92       zgraznf (:,:,:) = 0. 
    93       zgrazf  (:,:,:) = 0. 
    94       zgrazfff(:,:,:) = 0. 
    95       zgrazffe(:,:,:) = 0. 
    96  
    97       zstep = rfact2 / rday      ! Time step duration for biology 
    9882 
    9983      DO jk = 1, jpkm1 
    … …  
    10286 
    10387               zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    104 # if defined key_off_degrad 
    105                zfact   = zstep * tgfunc(ji,jj,jk) * zcompam * facvol(ji,jj,jk) 
     88# if defined key_degrad 
     89               zstep   = xstep * facvol(ji,jj,jk) 
    10690# else 
     91               zstep   = xstep 
     92# endif 
    10793               zfact   = zstep * tgfunc(ji,jj,jk) * zcompam 
    108 # endif 
    109  
    110 !     Respiration rates of both zooplankton 
    111 !     ------------------------------------- 
    112                zrespz2(ji,jj,jk)  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
     94 
     95               !  Respiration rates of both zooplankton 
     96               !  ------------------------------------- 
     97               zrespz2  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
    11398                  &     * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 
    11499 
    115 !     Zooplankton mortality. A square function has been selected with 
    116 !     no real reason except that it seems to be more stable and may 
    117 !     mimic predation. 
    118 !     --------------------------------------------------------------- 
    119                ztortz2(ji,jj,jk) = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
     100               !  Zooplankton mortality. A square function has been selected with 
     101               !  no real reason except that it seems to be more stable and may mimic predation 
     102               !  --------------------------------------------------------------- 
     103               ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
    120104               ! 
    121             END DO 
    122          END DO 
    123       END DO 
    124  
    125  
    126       DO jk = 1,jpkm1 
    127          DO jj = 1,jpj 
    128             DO ji = 1,jpi 
     105 
    129106               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    130107               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
    … …  
    132109               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
    133110 
    134 !     Microzooplankton grazing 
    135 !     ------------------------ 
     111               !  Microzooplankton grazing 
     112               !     ------------------------ 
    136113               zdenom = 1. / (  xkgraz2 + xprefc   * trn(ji,jj,jk,jpdia)   & 
    137114                  &                     + xprefz   * trn(ji,jj,jk,jpzoo)   & 
    … …  
    139116                  &                     + xprefpoc * trn(ji,jj,jk,jppoc)  ) 
    140117 
    141                zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom    & 
    142 # if defined key_off_degrad 
    143                   &     * facvol(ji,jj,jk)          & 
     118               zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom * trn(ji,jj,jk,jpmes)  
     119 
     120               zgrazd   = zgraze2  * xprefc   * zcompadi 
     121               zgrazz   = zgraze2  * xprefz   * zcompaz 
     122               zgrazn   = zgraze2  * xprefp   * zcompaph 
     123               zgrazpoc = zgraze2  * xprefpoc * zcompapoc 
     124 
     125               zgraznf  = zgrazn   * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
     126               zgrazf   = zgrazd   * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     127               zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     128                
     129               !  Mesozooplankton flux feeding on GOC 
     130               !  ---------------------------------- 
     131# if ! defined key_kriest 
     132               zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk)          & 
     133                  &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
     134               zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
     135# else 
     136               !!--------------------------- KRIEST3 ------------------------------------------- 
     137               !!               zgrazffe = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
     138               !!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    & 
     139               !! #  if defined key_degrad 
     140               !!                  &     * facvol(ji,jj,jk)          & 
     141               !! #  endif 
     142               !!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 
     143               !!--------------------------- KRIEST3 ------------------------------------------- 
     144 
     145              zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
     146                  &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
     147              zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    144148# endif 
    145                   &     * trn(ji,jj,jk,jpmes) 
    146  
    147                zgrazd(ji,jj,jk)   = zgraze2 * xprefc   * zcompadi 
    148                zgrazz(ji,jj,jk)   = zgraze2 * xprefz   * zcompaz 
    149                zgrazn(ji,jj,jk)   = zgraze2 * xprefp   * zcompaph 
    150                zgrazpoc(ji,jj,jk) = zgraze2 * xprefpoc * zcompapoc 
    151  
    152                zgraznf(ji,jj,jk)  = zgrazn(ji,jj,jk)   * trn(ji,jj,jk,jpnfe) & 
    153                   &                                     / (trn(ji,jj,jk,jpphy) + rtrn) 
    154                zgrazf(ji,jj,jk)   = zgrazd(ji,jj,jk)   * trn(ji,jj,jk,jpdfe) & 
    155                   &                                    / (trn(ji,jj,jk,jpdia) + rtrn) 
    156                zgrazpof(ji,jj,jk) = zgrazpoc(ji,jj,jk) * trn(ji,jj,jk,jpsfe) & 
    157                   &                                   / (trn(ji,jj,jk,jppoc) + rtrn) 
    158             END DO 
    159          END DO 
    160       END DO 
    161149       
    162        
    163       DO jk = 1,jpkm1 
    164          DO jj = 1,jpj 
    165             DO ji = 1,jpi 
    166                 
    167 !    Mesozooplankton flux feeding on GOC 
    168 !    ---------------------------------- 
    169 # if ! defined key_kriest 
    170 #   if ! defined key_off_degrad 
    171                zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk)          & 
    172                   &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    173 #   else 
    174                zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk) * facvol(ji,jj,jk)         & 
    175                   &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    176 #  endif 
    177                zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk)       & 
    178                   &                 * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
    179 # else 
    180 !!--------------------------- KRIEST3 ------------------------------------------- 
    181 !!               zgrazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
    182 !!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    & 
    183 #  if defined key_off_degrad 
    184 !!                  &     * facvol(ji,jj,jk)          & 
    185 #  endif 
    186 !!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 
    187 !!--------------------------- KRIEST3 ------------------------------------------- 
    188  
    189 #  if ! defined key_off_degrad 
    190               zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk)     & 
    191                   &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    192 #  else 
    193               zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk) * facvol(ji,jj,jk)    & 
    194                   &               * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    195 #  endif 
    196  
    197                zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk)      & 
    198                   &                * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    199 # endif 
    200             END DO 
    201          END DO 
    202       END DO 
    203        
    204 #if defined key_trc_dia3d 
    205       ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
    206       grazing(:,:,:) = grazing(:,:,:) + (  zgrazd  (:,:,:) + zgrazz  (:,:,:) + zgrazn(:,:,:) & 
    207                      &                   + zgrazpoc(:,:,:) + zgrazffe(:,:,:)  ) 
    208 #endif 
    209  
    210  
    211       DO jk = 1,jpkm1 
    212          DO jj = 1,jpj 
    213             DO ji = 1,jpi 
    214  
    215 !    Mesozooplankton efficiency 
    216 !    -------------------------- 
    217                zgrarem2 = ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 
    218                   &     + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) )   & 
    219                   &     * ( 1. - epsher2 - unass2 ) 
     150#if defined key_diatrc 
     151              ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
     152              grazing(ji,jj,jk) = grazing(ji,jj,jk) + (  zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) 
     153#endif 
     154 
     155              !    Mesozooplankton efficiency 
     156              !    -------------------------- 
     157              zgrarem2 = ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) * ( 1. - epsher2 - unass2 ) 
    220158#if ! defined key_kriest 
    221                zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 
    222                   &     * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff (ji,jj,jk))*(1.-epsher2-unass2) & 
    223                   &     + epsher2 * ( & 
    224                   &      zgrazd(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    225                   &     + zgrazn(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    226                   &    + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    227                   &    + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  ) 
     159              zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1.- epsher2 - unass2 ) &  
     160                  &     + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
     161                  &                 + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
     162                  &                 + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
     163                  &                 + zgrazffe * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  ) 
    228164#else 
    229                zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 
    230                   &    * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) )*(1.-epsher2-unass2) & 
    231                   &    + epsher2 * ( & 
    232                   &    zgrazd(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    233                   &    + zgrazn(ji,jj,jk)   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    234                   &    + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    235                   &    + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  ) 
    236  
    237 #endif 
    238                zgrapoc2 = (zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk)  + zgrazn(ji,jj,jk) & 
    239                   &    + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk)) * unass2 
     165              zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1. - epsher2 - unass2 ) & 
     166                  &    + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
     167                  &                + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
     168                  &                + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
     169                  &                + zgrazffe * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  ) 
     170 
     171#endif 
     172               !   Update the arrays TRA which contain the biological sources and sinks 
     173 
     174               zgrapoc2 =  zgrazd + zgrazz  + zgrazn + zgrazpoc + zgrazffe 
    240175 
    241176               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 
    242177               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 
    243                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * (1.-sigma2) 
     178               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1. - sigma2 ) 
    244179               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 
    245180               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    … …  
    247182                
    248183#if defined key_kriest 
    249                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 
    250                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso 
     184               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 * unass2 
     185               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * unass2 * xkr_dmeso 
    251186#else 
    252                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 
    253 #endif 
    254             END DO 
    255          END DO 
    256       END DO 
    257  
    258       DO jk = 1, jpkm1 
    259          DO jj = 1, jpj 
    260             DO ji = 1, jpi 
    261                ! 
    262                !   Update the arrays TRA which contain the biological sources and sinks 
    263                !   -------------------------------------------------------------------- 
    264                zmortz2 = ztortz2(ji,jj,jk) + zrespz2(ji,jj,jk) 
    265                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2  & 
    266                   &    + epsher2 * ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 
    267                   &    + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) ) 
    268                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd(ji,jj,jk) 
    269                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz(ji,jj,jk) 
    270                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn(ji,jj,jk) 
    271                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn(ji,jj,jk) * trn(ji,jj,jk,jpnch)  & 
    272                   &    / ( trn(ji,jj,jk,jpphy) + rtrn ) 
    273                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 
    274                   &    / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    275                tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 
    276                   &    / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    277                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) +  zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 
    278                   &    / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    279                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) -  zgraznf(ji,jj,jk) 
    280                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) -  zgrazf(ji,jj,jk) 
    281  
    282                zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn(ji,jj,jk) 
    283 #if defined key_trc_dia3d 
     187               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 * unass2 
     188#endif 
     189               zmortz2 = ztortz2 + zrespz2 
     190               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2 
     191               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
     192               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
     193               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 
     194               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trn(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     195               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     196               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd * trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     197               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazd * trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     198               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 
     199               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
     200 
     201               zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn 
     202#if defined key_diatrc 
    284203               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    285204#endif 
    … …  
    290209#if defined key_kriest 
    291210               znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    292                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2  & 
    293                   &    - zgrazpoc(ji,jj,jk) - zgrazffe(ji,jj,jk)     
    294                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc(ji,jj,jk) * znumpoc & 
    295                   &    + zmortz2  * xkr_dmeso & 
    296                   &    - zgrazffe(ji,jj,jk)   * znumpoc * wsbio4(ji,jj,jk) & 
    297                   &    / ( wsbio3(ji,jj,jk) + rtrn ) 
     211               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2 - zgrazpoc - zgrazffe 
     212               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc & 
     213                  &    + zmortz2  * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 
    298214               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 
    299                &       + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 
    300                &       + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 
    301                &       - zgrazfff(ji,jj,jk) - zgrazpof(ji,jj,jk) 
     215               &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff - zgrazpof 
    302216#else 
    303                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc(ji,jj,jk) 
    304                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe(ji,jj,jk) 
    305                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof(ji,jj,jk) 
     217               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc 
     218               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe 
     219               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof 
    306220               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 
    307                &       + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 
    308                &       + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 
    309                &       - zgrazfff(ji,jj,jk) 
     221               &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff 
    310222#endif 
    311223 
    … …  
    314226      END DO 
    315227      ! 
    316 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     228#if defined key_diatrc && defined key_iomput 
    317229      zrfact2 = 1.e3 * rfact2r 
    318230      ! Total grazing of phyto by zoo 
    … …  
    342254      !! 
    343255      !! ** Method  :   Read the nampismes namelist and check the parameters 
    344       !!      called at the first timestep (nittrc000) 
     256      !!      called at the first timestep (nit000) 
    345257      !! 
    346258      !! ** input   :   Namelist nampismes 
    … …  
    373285      ENDIF 
    374286 
     287 
    375288   END SUBROUTINE p4z_meso_init 
    376289 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    • Property svn:executable deleted
    r1836 r2528  
    2626   PRIVATE 
    2727 
    28    PUBLIC   p4z_micro    ! called in p4zbio.F90 
     28   PUBLIC   p4z_micro         ! called in p4zbio.F90 
     29   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90 
    2930 
    3031   !! * Shared module variables 
    … …  
    4546#  include "top_substitute.h90" 
    4647   !!---------------------------------------------------------------------- 
    47    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     48   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4849   !! $Id$  
    49    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     50   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5051   !!---------------------------------------------------------------------- 
    5152 
    5253CONTAINS 
    5354 
    54    SUBROUTINE p4z_micro( kt,jnt ) 
     55   SUBROUTINE p4z_micro( kt ) 
    5556      !!--------------------------------------------------------------------- 
    5657      !!                     ***  ROUTINE p4z_micro  *** 
    … …  
    6061      !! ** Method  : - ??? 
    6162      !!--------------------------------------------------------------------- 
    62       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     63      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6364      INTEGER  :: ji, jj, jk 
    6465      REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 
    65       REAL(wp) :: zgraze  , zdenom  , zdenom2 
    66       REAL(wp) :: zfact   , zstep   , zinano , zidiat, zipoc 
     66      REAL(wp) :: zgraze  , zdenom  , zdenom2, zstep 
     67      REAL(wp) :: zfact   , zinano , zidiat, zipoc 
    6768      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    68       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespz,ztortz 
    69       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazp, zgrazm, zgrazsd 
    70       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf 
     69      REAL(wp) :: zrespz, ztortz 
     70      REAL(wp) :: zgrazp, zgrazm, zgrazsd 
     71      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 
    7172      CHARACTER (len=25) :: charout 
    7273 
    7374      !!--------------------------------------------------------------------- 
    7475 
    75       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_micro_init      ! Initialization (first time-step only) 
    76  
    77       zrespz (:,:,:) = 0. 
    78       ztortz (:,:,:) = 0. 
    79       zgrazp (:,:,:) = 0. 
    80       zgrazm (:,:,:) = 0. 
    81       zgrazsd(:,:,:) = 0. 
    82       zgrazmf(:,:,:) = 0. 
    83       zgrazsf(:,:,:) = 0. 
    84       zgrazpf(:,:,:) = 0. 
    85  
    86 #if defined key_trc_dia3d 
     76 
     77#if defined key_diatrc 
    8778      grazing(:,:,:) = 0.  !: Initialisation of  grazing 
    8879#endif 
    … …  
    9384         DO jj = 1, jpj 
    9485            DO ji = 1, jpi 
    95  
    9686               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    97 # if defined key_off_degrad 
    98                zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz *facvol(ji,jj,jk) 
     87# if defined key_degrad 
     88               zstep   = xstep * facvol(ji,jj,jk) 
    9989# else 
     90               zstep   = xstep 
     91# endif 
    10092               zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz 
    101 # endif 
    102  
    103 !     Respiration rates of both zooplankton 
    104 !     ------------------------------------- 
    105  
    106                zrespz(ji,jj,jk) = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
     93 
     94               !  Respiration rates of both zooplankton 
     95               !  ------------------------------------- 
     96               zrespz = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
    10797                  &            * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 
    10898 
    109 !     Zooplankton mortality. A square function has been selected with 
    110 !     no real reason except that it seems to be more stable and may 
    111 !     mimic predation. 
    112 !     --------------------------------------------------------------- 
    113                ztortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
    114  
    115             END DO 
    116          END DO 
    117       END DO 
    118  
    119  
    120   
    121       DO jk = 1,jpkm1 
    122          DO jj = 1,jpj 
    123             DO ji = 1,jpi 
     99               !  Zooplankton mortality. A square function has been selected with 
     100               !  no real reason except that it seems to be more stable and may mimic predation. 
     101               !  --------------------------------------------------------------- 
     102               ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
     103 
    124104               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    125105               zcompadi2 = MIN( zcompadi, 5.e-7 ) 
    … …  
    131111               zdenom2 = 1./ ( xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi2 + rtrn ) 
    132112 
    133                zgraze = grazrat * zstep * tgfunc(ji,jj,jk)     & 
    134 # if defined key_off_degrad 
    135                   &      * facvol(ji,jj,jk)         & 
    136 # endif 
    137                   &      * trn(ji,jj,jk,jpzoo) 
     113               zgraze = grazrat * zstep * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 
    138114 
    139115               zinano = xpref2p * zcompaph  * zdenom2 
    … …  
    143119               zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 
    144120 
    145                zgrazp(ji,jj,jk)  = zgraze * zinano * zcompaph * zdenom 
    146                zgrazm(ji,jj,jk)  = zgraze * zipoc  * zcompapoc * zdenom 
    147                zgrazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 
    148  
    149                zgrazpf (ji,jj,jk) = zgrazp(ji,jj,jk)  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    150                zgrazmf(ji,jj,jk)  = zgrazm(ji,jj,jk)  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    151                zgrazsf(ji,jj,jk)  = zgrazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    152  
    153             END DO 
    154          END DO 
    155       END DO 
    156        
    157 #if defined key_trc_dia3d 
    158       ! Grazing by microzooplankton 
    159       grazing(:,:,:) = grazing(:,:,:) + zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:)  
    160 #endif 
    161  
    162       DO jk = 1,jpkm1 
    163          DO jj = 1,jpj 
    164             DO ji = 1,jpi 
    165 !    Various remineralization and excretion terms 
    166 !    -------------------------------------------- 
    167  
    168                zgrarem = (  zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk)  + zgrazsd(ji,jj,jk)  ) & 
    169                   &          * ( 1.- epsher - unass ) 
    170                zgrafer = (  zgrazpf(ji,jj,jk) + zgrazsf(ji,jj,jk)  + zgrazmf(ji,jj,jk)  ) & 
    171                   &        * ( 1.- epsher - unass ) + epsher *  & 
    172                   &  ( zgrazm(ji,jj,jk)  * MAX((trn(ji,jj,jk,jpsfe) /(trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 
    173                   &   + zgrazp(ji,jj,jk)  * MAX((trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 
    174                   &   + zgrazsd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  ) 
    175                zgrapoc = (  zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)  ) * unass 
     121               zgrazp  = zgraze * zinano * zcompaph * zdenom 
     122               zgrazm  = zgraze * zipoc  * zcompapoc * zdenom 
     123               zgrazsd = zgraze * zidiat * zcompadi2 * zdenom 
     124 
     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) 
     128#if defined key_diatrc 
     129               ! Grazing by microzooplankton 
     130               grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd  
     131#endif 
     132 
     133               !    Various remineralization and excretion terms 
     134               !    -------------------------------------------- 
     135               zgrarem = ( zgrazp + zgrazm + zgrazsd ) * ( 1.- epsher - unass ) 
     136               zgrafer = ( zgrazpf + zgrazsf + zgrazmf ) * ( 1.- epsher - unass ) & 
     137                  &      + epsher * ( zgrazm  * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) &  
     138                  &                 + zgrazp  * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 
     139                  &                 + zgrazsd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  ) 
     140 
     141               zgrapoc = (  zgrazp + zgrazm + zgrazsd )  
    176142 
    177143               !  Update of the TRA arrays 
    … …  
    183149               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 
    184150               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    185                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     151               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc * unass 
    186152               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 
    187153#if defined key_kriest 
    188                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat 
    189 #endif 
    190             END DO 
    191          END DO 
    192       END DO 
    193  
    194 ! 
    195 !   Update the arrays TRA which contain the biological sources and sinks 
    196 !   -------------------------------------------------------------------- 
    197  
    198       DO jk = 1, jpkm1 
    199          DO jj = 1, jpj 
    200             DO ji = 1, jpi 
    201  
    202                zmortz = ztortz(ji,jj,jk) + zrespz(ji,jj,jk) 
    203                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz  & 
    204                  &     + epsher * ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)) 
    205                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp(ji,jj,jk) 
    206                tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd(ji,jj,jk) 
    207                tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp(ji,jj,jk)  & 
    208                  &     * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 
    209                tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd(ji,jj,jk) & 
    210                  &     * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 
    211                tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd(ji,jj,jk) & 
    212                  &     * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
    213                tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd(ji,jj,jk) & 
    214                  &     * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
    215                tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf(ji,jj,jk) 
    216                tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf(ji,jj,jk) 
    217                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm(ji,jj,jk) 
    218                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz   & 
    219                  &     + unass * ( zgrazpf(ji,jj,jk) + zgrazsf (ji,jj,jk)) & 
    220                  &     - (1.-unass) * zgrazmf(ji,jj,jk) 
    221                zprcaca = xfracal(ji,jj,jk) * unass * zgrazp(ji,jj,jk) 
    222 #if defined key_trc_dia3d 
     154               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass * xkr_ddiat 
     155#endif 
     156 
     157               ! 
     158               !   Update the arrays TRA which contain the biological sources and sinks 
     159               !   -------------------------------------------------------------------- 
     160 
     161               zmortz = ztortz + zrespz 
     162               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc  
     163               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
     164               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
     165               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp  * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 
     166               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 
     167               tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
     168               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 
     169               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 
     170               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
     171               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
     172               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz + unass * ( zgrazpf + zgrazsf ) - (1.-unass) * zgrazmf 
     173               zprcaca = xfracal(ji,jj,jk) * unass * zgrazp 
     174#if defined key_diatrc 
    223175               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    224176#endif 
    … …  
    228180               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    229181#if defined key_kriest 
    230                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm(ji,jj,jk) ) * xkr_ddiat 
     182               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm ) * xkr_ddiat 
    231183#endif 
    232184            END DO 
    … …  
    251203      !! 
    252204      !! ** Method  :   Read the nampiszoo namelist and check the parameters 
    253       !!      called at the first timestep (nittrc000) 
     205      !!      called at the first timestep (nit000) 
    254206      !! 
    255207      !! ** input   :   Namelist nampiszoo 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90

    • Property svn:executable deleted
    r1800 r2528  
    2525 
    2626   PUBLIC   p4z_mort     
     27   PUBLIC   p4z_mort_init     
    2728 
    2829 
    … …  
    3536     mpratm = 0.01_wp           !: 
    3637 
    37    !! * Module variables 
    38    REAL(wp) :: zstep 
    39  
    40  
    4138 
    4239   !!* Substitution 
    4340#  include "top_substitute.h90" 
    4441   !!---------------------------------------------------------------------- 
    45    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     42   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4643   !! $Id$  
    47    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4845   !!---------------------------------------------------------------------- 
    4946 
    5047CONTAINS 
    5148 
    52    SUBROUTINE p4z_mort( kt, jnt ) 
     49   SUBROUTINE p4z_mort( kt ) 
    5350      !!--------------------------------------------------------------------- 
    5451      !!                     ***  ROUTINE p4z_mort  *** 
    … …  
    5956      !! ** Method  : - ??? 
    6057      !!--------------------------------------------------------------------- 
    61       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    62       !!--------------------------------------------------------------------- 
    63  
    64       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_mort_init      ! Initialization (first time-step only) 
    65  
    66       zstep = rfact2 / rday      ! Time step duration for biology 
     58      INTEGER, INTENT(in) ::   kt ! ocean time step 
     59      !!--------------------------------------------------------------------- 
    6760 
    6861      CALL p4z_nano            ! nanophytoplankton 
    … …  
    8376      INTEGER  :: ji, jj, jk 
    8477      REAL(wp) :: zcompaph 
    85       REAL(wp) :: zfactfe,zfactch,zprcaca,zfracal 
    86       REAL(wp) :: ztortp,zrespp,zmortp 
     78      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 
     79      REAL(wp) :: ztortp , zrespp , zmortp , zstep 
    8780      CHARACTER (len=25) :: charout 
    8881      !!--------------------------------------------------------------------- 
    8982 
    9083 
    91 #if defined key_trc_dia3d 
     84#if defined key_diatrc 
    9285     prodcal(:,:,:) = 0.  !: Initialisation of calcite production variable 
    9386#endif 
    … …  
    9992               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    10093 
    101 !     Squared mortality of Phyto similar to a sedimentation term during 
    102 !     blooms (Doney et al. 1996) 
    103 !     ----------------------------------------------------------------- 
    104                zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk)   & 
    105 # if defined key_off_degrad 
    106                   &        * facvol(ji,jj,jk)     & 
     94# if defined key_degrad 
     95               zstep =  xstep * facvol(ji,jj,jk)   
     96# else 
     97               zstep =  xstep   
    10798# endif 
    108                   &        * zcompaph * trn(ji,jj,jk,jpphy) 
    109  
    110 !     Phytoplankton mortality. This mortality loss is slightly 
    111 !     increased when nutrients are limiting phytoplankton growth 
    112 !     as observed for instance in case of iron limitation. 
    113 !     ---------------------------------------------------------- 
    114                ztortp = mprat * zstep * trn(ji,jj,jk,jpphy)          & 
    115 # if defined key_off_degrad 
    116                   &          * facvol(ji,jj,jk)     & 
    117 # endif 
    118                   &   / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 
    119  
     99               !     Squared mortality of Phyto similar to a sedimentation term during 
     100               !     blooms (Doney et al. 1996) 
     101               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jpphy)  
     102 
     103               !     Phytoplankton mortality. This mortality loss is slightly 
     104               !     increased when nutrients are limiting phytoplankton growth 
     105               !     as observed for instance in case of iron limitation. 
     106               ztortp = mprat * xstep * trn(ji,jj,jk,jpphy) / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 
    120107 
    121108               zmortp = zrespp + ztortp 
    … …  
    130117               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
    131118               zprcaca = xfracal(ji,jj,jk) * zmortp 
    132 #if defined key_trc_dia3d 
     119#if defined key_diatrc 
    133120               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    134121#endif 
    … …  
    169156      INTEGER  ::  ji, jj, jk 
    170157      REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi 
    171       REAL(wp) ::  zrespp2, ztortp2, zmortp2 
     158      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep 
    172159      CHARACTER (len=25) :: charout 
    173160  
    … …  
    175162 
    176163 
    177 !    Aggregation term for diatoms is increased in case of nutrient 
    178 !    stress as observed in reality. The stressed cells become more 
    179 !    sticky and coagulate to sink quickly out of the euphotic zone 
    180 !     ------------------------------------------------------------ 
     164      !    Aggregation term for diatoms is increased in case of nutrient 
     165      !    stress as observed in reality. The stressed cells become more 
     166      !    sticky and coagulate to sink quickly out of the euphotic zone 
     167      !     ------------------------------------------------------------ 
    181168 
    182169      DO jk = 1, jpkm1 
    … …  
    186173               zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. ) 
    187174 
    188 !    Aggregation term for diatoms is increased in case of nutrient 
    189 !    stress as observed in reality. The stressed cells become more 
    190 !    sticky and coagulate to sink quickly out of the euphotic zone 
    191 !     ------------------------------------------------------------ 
    192  
     175               !    Aggregation term for diatoms is increased in case of nutrient 
     176               !    stress as observed in reality. The stressed cells become more 
     177               !    sticky and coagulate to sink quickly out of the euphotic zone 
     178               !     ------------------------------------------------------------ 
     179 
     180# if defined key_degrad 
     181               zstep =  xstep * facvol(ji,jj,jk)   
     182# else 
     183               zstep =  xstep   
     184# endif 
     185               !  Phytoplankton respiration  
     186               !     ------------------------ 
    193187               zrespp2  = 1.e6 * zstep * (  wchl + wchld * ( 1.- xlimdia(ji,jj,jk) )  )    & 
    194 # if defined key_off_degrad 
    195                   &       * facvol(ji,jj,jk)       & 
    196 # endif 
    197188                  &       * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 
    198                                                                                 
    199  
    200 !     Phytoplankton mortality.  
    201 !     ------------------------ 
    202                ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)     & 
    203 # if defined key_off_degrad 
    204                   &        * facvol(ji,jj,jk)       & 
    205 # endif 
    206                   &      / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
    207  
    208                 zmortp2 = zrespp2 + ztortp2 
    209  
    210 !   Update the arrays tra which contains the biological sources and sinks 
    211 !   --------------------------------------------------------------------- 
     189 
     190               !     Phytoplankton mortality.  
     191               !     ------------------------ 
     192               ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi  
     193 
     194               zmortp2 = zrespp2 + ztortp2 
     195 
     196               !   Update the arrays tra which contains the biological sources and sinks 
     197               !   --------------------------------------------------------------------- 
    212198               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    213199               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    … …  
    249235      !! 
    250236      !! ** Method  :   Read the nampismort namelist and check the parameters 
    251       !!      called at the first timestep (nittrc000) 
     237      !!      called at the first timestep 
    252238      !! 
    253239      !! ** input   :   Namelist nampismort 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    • Property svn:executable deleted
    r1836 r2528  
    1616   USE trc            ! tracer variables 
    1717   USE oce_trc        ! tracer-ocean share variables 
    18    USE trc_oce        ! ocean-tracer share variables 
    1918   USE sms_pisces     ! Source Minus Sink of PISCES 
    2019   USE iom 
    … …  
    2322   PRIVATE 
    2423 
    25    PUBLIC   p4z_opt   ! called in p4zbio.F90 module 
     24   PUBLIC   p4z_opt        ! called in p4zbio.F90 module 
     25   PUBLIC   p4z_opt_init   ! called in trcsms_pisces.F90 module 
    2626 
    2727   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etot, enano, ediat   !: PAR for phyto, nano and diat  
    2828   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   emoy                 !: averaged PAR in the mixed layer 
    2929 
    30    INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    31    REAL(wp) ::   & 
    32       parlux = 0.43 / 3.e0 
     30   INTEGER  ::  nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     31   REAL(wp) ::  parlux = 0.43 / 3.e0 
    3332 
    3433   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb  !: tabulated attenuation coefficients for RGB absorption 
    … …  
    3736#  include "top_substitute.h90" 
    3837   !!---------------------------------------------------------------------- 
    39    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     38   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4039   !! $Id$  
    41    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     40   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4241   !!---------------------------------------------------------------------- 
    4342 
    4443CONTAINS 
    4544 
    46    SUBROUTINE p4z_opt(kt, jnt) 
     45   SUBROUTINE p4z_opt( kt, jnt ) 
    4746      !!--------------------------------------------------------------------- 
    4847      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    5453      !!--------------------------------------------------------------------- 
    5554      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    56       INTEGER  ::   ji, jj, jk, jc 
     55      INTEGER  ::   ji, jj, jk 
    5756      INTEGER  ::   irgb 
    5857      REAL(wp) ::   zchl, zxsi0r 
    … …  
    6463 
    6564 
    66       !                                        !* tabulated attenuation coef.  
    67       IF( kt * jnt == nittrc000 ) THEN 
    68          !                                ! level of light extinction 
    69          nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 
    70          IF(lwp) THEN 
    71            WRITE(numout,*) 
    72            WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
    73          ENDIF 
    74 !!         CALL trc_oce_rgb( xkrgb )     ! tabulated attenuation coefficients 
    75          CALL trc_oce_rgb_read( xkrgb )     ! tabulated attenuation coefficients 
    76          etot (:,:,:) = 0.e0 
    77          enano(:,:,:) = 0.e0 
    78          ediat(:,:,:) = 0.e0 
    79          IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 
    80       ENDIF 
    81  
    82  
    83 !     Initialisation of variables used to compute PAR 
    84 !     ----------------------------------------------- 
     65      !     Initialisation of variables used to compute PAR 
     66      !     ----------------------------------------------- 
    8567      ze1 (:,:,jpk) = 0.e0 
    8668      ze2 (:,:,jpk) = 0.e0 
    … …  
    227209      END DO 
    228210 
    229 #if defined key_trc_diaadd 
     211#if defined key_diatrc 
    230212# if ! defined key_iomput 
    231213      ! save for outputs 
    … …  
    243225   END SUBROUTINE p4z_opt 
    244226 
     227   SUBROUTINE p4z_opt_init 
     228      !!---------------------------------------------------------------------- 
     229      !!                  ***  ROUTINE p4z_opt_init  *** 
     230      !! 
     231      !! ** Purpose :   Initialization of tabulated attenuation coef 
     232      !! 
     233      !! 
     234      !!---------------------------------------------------------------------- 
     235 
     236      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
     237!!      CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients 
     238      nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01) 
     239      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
     240      ! 
     241                         etot (:,:,:) = 0.e0 
     242                         enano(:,:,:) = 0.e0 
     243                         ediat(:,:,:) = 0.e0 
     244      IF( ln_qsr_bio )   etot3(:,:,:) = 0.e0 
     245      !  
     246   END SUBROUTINE p4z_opt_init 
    245247#else 
    246248   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    • Property svn:executable deleted
    r1836 r2528  
    2323 
    2424   USE lib_mpp 
     25   USE lib_fortran 
    2526 
    2627   IMPLICIT NONE 
    2728   PRIVATE 
    2829 
    29    PUBLIC   p4z_prod    ! called in p4zbio.F90 
     30   PUBLIC   p4z_prod         ! called in p4zbio.F90 
     31   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90 
    3032 
    3133   !! * Shared module variables 
    … …  
    4143     grosip    = 0.151_wp 
    4244 
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::        & 
    44      &                   prmax 
     45   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::  prmax  
    4546    
    4647   REAL(wp) ::   & 
     48      rday1                      ,  &  !: 0.6 / rday 
    4749      texcret                    ,  &  !: 1 - excret  
    4850      texcret2                   ,  &  !: 1 - excret2         
    49       rpis180                    ,  &  !: rpi / 180 
    5051      tpp                              !: Total primary production 
    51  
    52    INTEGER  ::  nspyr                  !: number of timesteps per year 
    5352 
    5453   !!* Substitution 
    5554#  include "top_substitute.h90" 
    5655   !!---------------------------------------------------------------------- 
    57    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     56   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5857   !! $Id$  
    59    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     58   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6059   !!---------------------------------------------------------------------- 
    6160 
    … …  
    7877      REAL(wp) ::   zmxltst, zmxlday, zlim1 
    7978      REAL(wp) ::   zpislopen  , zpislope2n 
    80       REAL(wp) ::   zrum, zcodel, zargu, zvol 
    81 #if defined key_trc_diaadd && defined key_trc_dia3d 
     79      REAL(wp) ::   zrum, zcodel, zargu, zval, zvol 
     80#if defined key_diatrc 
    8281      REAL(wp) ::   zrfact2 
    8382#endif 
    … …  
    9089      CHARACTER (len=25) :: charout 
    9190      !!--------------------------------------------------------------------- 
    92  
    93  
    94       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_prod_init      ! Initialization (first time-step only) 
    95  
    9691 
    9792      zprorca (:,:,:) = 0.0 
    … …  
    109104      ! Computation of the optimal production 
    110105 
    111 # if defined key_off_degrad 
    112       prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:) * facvol(:,:,:) 
     106# if defined key_degrad 
     107      prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 
    113108# else 
    114       prmax(:,:,:) = 0.6 / rday * tgfunc(:,:,:) 
     109      prmax(:,:,:) = rday1 * tgfunc(:,:,:) 
    115110# endif 
    116111 
    117112      ! compute the day length depending on latitude and the day 
    118       IF(lwp) write(numout,*) 
    119       IF(lwp) write(numout,*) 'p4zday : - Julian day ', nday_year 
    120       IF(lwp) write(numout,*) '~~~~~~' 
    121  
    122       IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    123          zrum = FLOAT( nday_year - 80 ) / 366. 
    124       ELSE 
    125          zrum = FLOAT( nday_year - 80 ) / 365. 
    126       ENDIF 
    127       zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rpis180 * 23.5 )  ) 
     113      zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp) 
     114      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  ) 
    128115 
    129116      ! day length in hours 
    … …  
    131118      DO jj = 1, jpj 
    132119         DO ji = 1, jpi 
    133             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rpis180 ) 
     120            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    134121            zargu = MAX( -1., MIN(  1., zargu ) ) 
    135             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rpis180 / 15. ) 
     122            zval  = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     123            IF( zval < 1.e0 )   zval = 24. 
     124            zstrn(ji,jj) = 24. / zval 
    136125         END DO 
    137126      END DO 
    … …  
    147136               ! Computation of the P-I slope for nanos and diatoms 
    148137               IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    149                    ztn    = MAX( 0., tn(ji,jj,jk) - 15. ) 
     138                   ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    150139                   zadap  = 0.+ 1.* ztn / ( 2.+ ztn ) 
    151140                   zadap2 = 0.e0 
    … …  
    227216      END DO 
    228217 
    229  
    230       WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    231       zstrn(:,:) = 24. / zstrn(:,:) 
    232218 
    233219!CDIR NOVERRCHK 
    … …  
    331317 
    332318     ! Total primary production per year 
    333      DO jk = 1, jpkm1 
    334         DO jj = 1, jpj 
    335           DO ji = 1, jpi 
    336              zvol = cvol(ji,jj,jk) 
    337 #if defined key_off_degrad 
    338              zvol = zvol * facvol(ji,jj,jk) 
     319 
     320#if defined key_degrad 
     321     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) ) 
     322#else 
     323     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    339324#endif 
    340              tpp  = tpp + ( zprorca(ji,jj,jk) + zprorcad(ji,jj,jk) ) & 
    341                           * zvol * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    342           END DO 
    343         END DO 
    344       END DO 
    345  
    346  
    347       IF( MOD( kt, nspyr ) == 0 .AND. jnt == nrdttrc ) THEN 
    348         IF( lk_mpp ) CALL mpp_sum( tpp ) 
    349         WRITE(numout,*) 'Total PP :' 
     325 
     326     IF( kt == nitend .AND. jnt == nrdttrc ) THEN 
     327        WRITE(numout,*) 'Total PP (Gtc) :' 
    350328        WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 
    351         WRITE(numout,*) '(GtC/yr)' 
    352         tpp = 0. 
     329        WRITE(numout,*)  
    353330      ENDIF 
    354331 
    355 #if defined key_trc_diaadd && defined key_trc_dia3d && ! defined key_iomput 
     332#if defined key_diatrc && ! defined key_iomput 
    356333      !   Supplementary diagnostics 
    357334      zrfact2 = 1.e3 * rfact2r 
    … …  
    367344#endif 
    368345 
    369 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     346#if defined key_diatrc && defined key_iomput 
    370347      zrfact2 = 1.e3 * rfact2r 
    371348      IF ( jnt == nrdttrc ) then 
    … …  
    396373      !! 
    397374      !! ** Method  :   Read the nampisprod namelist and check the parameters 
    398       !!      called at the first timestep (nittrc000) 
     375      !!      called at the first timestep (nit000) 
    399376      !! 
    400377      !! ** input   :   Namelist nampisprod 
    … …  
    423400      ENDIF 
    424401 
    425       ! number of timesteps per year 
    426       nspyr  = INT( nyear_len(1) * rday / rdt ) 
    427  
    428       rpis180   = rpi / 180. 
     402      rday1     = 0.6 / rday  
    429403      texcret   = 1.0 - excret 
    430404      texcret2  = 1.0 - excret2 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    • Property svn:executable deleted
    r1800 r2528  
    2727   PRIVATE 
    2828 
    29    PUBLIC   p4z_rem    ! called in p4zbio.F90 
     29   PUBLIC   p4z_rem         ! called in p4zbio.F90 
     30   PUBLIC   p4z_rem_init    ! called in trcsms_pisces.F90 
    3031 
    3132   !! * Shared module variables 
    … …  
    4142     &                   denitr                     !: denitrification array 
    4243 
    43    REAL(wp) ::   & 
    44      xstep            !: Time step duration for biology 
    4544 
    4645   !!* Substitution 
    4746#  include "top_substitute.h90" 
    4847   !!---------------------------------------------------------------------- 
    49    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     48   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5049   !! $Id$  
    51    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     50   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5251   !!---------------------------------------------------------------------- 
    5352 
    5453CONTAINS 
    5554 
    56    SUBROUTINE p4z_rem(kt, jnt) 
     55   SUBROUTINE p4z_rem( kt ) 
    5756      !!--------------------------------------------------------------------- 
    5857      !!                     ***  ROUTINE p4z_rem  *** 
    … …  
    6261      !! ** Method  : - ??? 
    6362      !!--------------------------------------------------------------------- 
    64       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     63      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6564      INTEGER  ::   ji, jj, jk 
    6665      REAL(wp) ::   zremip, zremik , zlam1b 
    … …  
    7271      REAL(wp) ::   zofer2, zdenom, zdenom2 
    7372#endif 
    74       REAL(wp) ::   zlamfac, zonitr 
     73      REAL(wp) ::   zlamfac, zonitr, zstep 
    7574      REAL(wp), DIMENSION(jpi,jpj)     ::   ztempbac 
    7675      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur, zolimi 
    … …  
    7877 
    7978      !!--------------------------------------------------------------------- 
    80  
    81  
    82       IF( ( kt * jnt ) == nittrc000  )  THEN 
    83          CALL p4z_rem_init                ! Initialization (first time-step only) 
    84          xstep = rfact2 / rday            ! Time step duration for the biology 
    85          nitrfac(:,:,:) = 0.0 
    86          denitr (:,:,:) = 0.0   
    87       ENDIF 
    8879 
    8980 
    … …  
    9485       ztempbac(:,:)   = 0.0 
    9586 
    96 !      Computation of the mean phytoplankton concentration as 
    97 !      a crude estimate of the bacterial biomass 
    98 !      -------------------------------------------------- 
     87      !  Computation of the mean phytoplankton concentration as 
     88      !  a crude estimate of the bacterial biomass 
     89      !   -------------------------------------------------- 
    9990 
    10091      DO jk = 1, jpkm1 
    … …  
    114105         DO jj = 1, jpj 
    115106            DO ji = 1, jpi 
    116  
    117 !    DENITRIFICATION FACTOR COMPUTED FROM O2 LEVELS 
    118 !    ---------------------------------------------- 
    119  
     107               ! denitrification factor computed from O2 levels 
    120108               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trn(ji,jj,jk,jpoxy) )    & 
    121109                  &                                / ( oxymin + trn(ji,jj,jk,jpoxy) )  ) 
    122             END DO 
    123          END DO 
    124       END DO 
    125  
    126       nitrfac(:,:,:) = MIN( 1., nitrfac(:,:,:) ) 
    127  
    128  
    129       DO jk = 1, jpkm1 
    130          DO jj = 1, jpj 
    131             DO ji = 1, jpi 
    132  
    133 !     DOC ammonification. Depends on depth, phytoplankton biomass 
    134 !     and a limitation term which is supposed to be a parameterization 
    135 !     of the bacterial activity.  
    136 !     ---------------------------------------------------------------- 
    137                zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk)         & 
    138 # if defined key_off_degrad 
    139                   &            * facvol(ji,jj,jk)              & 
     110               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
     111            END DO 
     112         END DO 
     113      END DO 
     114 
     115      DO jk = 1, jpkm1 
     116         DO jj = 1, jpj 
     117            DO ji = 1, jpi 
     118# if defined key_degrad 
     119               zstep = xstep * facvol(ji,jj,jk) 
     120# else 
     121               zstep = xstep 
    140122# endif 
    141                   &            * zdepbac(ji,jj,jk) 
     123               ! DOC ammonification. Depends on depth, phytoplankton biomass 
     124               !     and a limitation term which is supposed to be a parameterization 
     125               !     of the bacterial activity.  
     126               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    142127               zremik = MAX( zremik, 5.5e-4 * xstep ) 
    143128 
    144 !     Ammonification in oxic waters with oxygen consumption 
    145 !     ----------------------------------------------------- 
     129               !     Ammonification in oxic waters with oxygen consumption 
     130               !     ----------------------------------------------------- 
    146131               zolimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,  & 
    147132                  &                    zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  )  
    148133 
    149 !     Ammonification in suboxic waters with denitrification 
    150 !     ------------------------------------------------------- 
     134               !     Ammonification in suboxic waters with denitrification 
     135               !     ------------------------------------------------------- 
    151136               denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    152137                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  ) 
    … …  
    167152         DO jj = 1, jpj 
    168153            DO ji = 1, jpi 
    169  
    170 !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
    171 !    below 2 umol/L. Inhibited at strong light  
    172 !    ---------------------------------------------------------- 
    173                zonitr  = nitrif * xstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) )     & 
    174 # if defined key_off_degrad 
    175                   &      * facvol(ji,jj,jk)              & 
     154# if defined key_degrad 
     155               zstep = xstep * facvol(ji,jj,jk) 
     156# else 
     157               zstep = xstep 
    176158# endif 
    177                   &      * ( 1.- nitrfac(ji,jj,jk) ) 
    178  
    179 ! 
    180 !   Update of the tracers trends 
    181 !   ---------------------------- 
    182  
    183               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
    184               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
    185               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    186               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
     159               !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
     160               !    below 2 umol/L. Inhibited at strong light  
     161               !    ---------------------------------------------------------- 
     162               zonitr  = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
     163 
     164               !   Update of the tracers trends 
     165               !   ---------------------------- 
     166 
     167               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
     168               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
     169               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
     170               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
    187171 
    188172            END DO 
    … …  
    200184            DO ji = 1, jpi 
    201185 
    202 !    Bacterial uptake of iron. No iron is available in DOC. So 
    203 !    Bacteries are obliged to take up iron from the water. Some 
    204 !    studies (especially at Papa) have shown this uptake to be 
    205 !    significant 
    206 !    ---------------------------------------------------------- 
     186               !    Bacterial uptake of iron. No iron is available in DOC. So 
     187               !    Bacteries are obliged to take up iron from the water. Some 
     188               !    studies (especially at Papa) have shown this uptake to be significant 
     189               !    ---------------------------------------------------------- 
    207190               zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           & 
    208                   &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))**2           & 
     191                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
     192                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
    209193                  &                  / ( xkgraz2 + zdepbac(ji,jj,jk) )                    & 
    210194                  &                  * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
    … …  
    216200               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer 
    217201#endif 
    218  
    219202            END DO 
    220203         END DO 
    … …  
    230213         DO jj = 1, jpj 
    231214            DO ji = 1, jpi 
    232  
    233 !    POC disaggregation by turbulence and bacterial activity.  
    234 !    ------------------------------------------------------------- 
    235                zremip = xremip * xstep * tgfunc(ji,jj,jk)   & 
    236 # if defined key_off_degrad 
    237                   &            * facvol(ji,jj,jk)              & 
     215# if defined key_degrad 
     216               zstep = xstep * facvol(ji,jj,jk) 
     217# else 
     218               zstep = xstep 
    238219# endif 
    239                   &            * ( 1.- 0.5 * nitrfac(ji,jj,jk) ) 
    240  
    241 !    POC disaggregation rate is reduced in anoxic zone as shown by 
    242 !    sediment traps data. In oxic area, the exponent of the martin s 
    243 !    law is around -0.87. In anoxic zone, it is around -0.35. This 
    244 !    means a disaggregation constant about 0.5 the value in oxic zones 
    245 !    ----------------------------------------------------------------- 
     220               !    POC disaggregation by turbulence and bacterial activity.  
     221               !    ------------------------------------------------------------- 
     222               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) )  
     223 
     224               !    POC disaggregation rate is reduced in anoxic zone as shown by 
     225               !    sediment traps data. In oxic area, the exponent of the martin s 
     226               !    law is around -0.87. In anoxic zone, it is around -0.35. This 
     227               !    means a disaggregation constant about 0.5 the value in oxic zones 
     228               !    ----------------------------------------------------------------- 
    246229               zorem  = zremip * trn(ji,jj,jk,jppoc) 
    247230               zofer  = zremip * trn(ji,jj,jk,jpsfe) 
    … …  
    253236#endif 
    254237 
    255 !  Update the appropriate tracers trends 
    256 !  ------------------------------------- 
     238               !  Update the appropriate tracers trends 
     239               !  ------------------------------------- 
    257240 
    258241               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
    … …  
    282265         DO jj = 1, jpj 
    283266            DO ji = 1, jpi 
    284  
    285 !     Remineralization rate of BSi depedant on T and saturation 
    286 !     --------------------------------------------------------- 
     267# if defined key_degrad 
     268               zstep = xstep * facvol(ji,jj,jk) 
     269# else 
     270               zstep = xstep 
     271# endif 
     272               !     Remineralization rate of BSi depedant on T and saturation 
     273               !     --------------------------------------------------------- 
    287274               zsatur  = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
    288275               zsatur  = MAX( rtrn, zsatur ) 
    289276               zsatur2 = zsatur * ( 1. + tn(ji,jj,jk) / 400.)**4 
    290277               znusil  = 0.225  * ( 1. + tn(ji,jj,jk) / 15.) * zsatur + 0.775 * zsatur2**9 
    291 #    if defined key_off_degrad 
    292                zsiremin = xsirem * xstep * znusil * facvol(ji,jj,jk) 
    293 # else 
    294                zsiremin = xsirem * xstep * znusil 
    295 #    endif 
     278               zsiremin = xsirem * zstep * znusil 
    296279               zosil = zsiremin * trn(ji,jj,jk,jpdsi) 
    297280 
    298281               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 
    299282               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
    300  
    301283               ! 
    302284            END DO 
    … …  
    317299!CDIR NOVERRCHK 
    318300            DO ji = 1, jpi 
    319 ! 
    320 !      Compute de different ratios for scavenging of iron 
    321 !      -------------------------------------------------- 
     301# if defined key_degrad 
     302               zstep = xstep * facvol(ji,jj,jk) 
     303# else 
     304               zstep = xstep 
     305# endif 
     306               !  Compute de different ratios for scavenging of iron 
     307               !  -------------------------------------------------- 
    322308 
    323309#if  defined key_kriest 
    324                 zdenom1 = trn(ji,jj,jk,jppoc) / & 
     310               zdenom1 = trn(ji,jj,jk,jppoc) / & 
    325311           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    326312#else 
    327                 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
     313               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
    328314           &            + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    329315 
    330                 zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
    331                 zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
    332 #endif 
    333  
    334  
    335 !     scavenging rate of iron. this scavenging rate depends on the 
    336 !     load in particles on which they are adsorbed. The 
    337 !     parameterization has been taken from studies on Th 
    338 !     ------------------------------------------------------------ 
     316               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
     317               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
     318#endif 
     319               !  scavenging rate of iron. this scavenging rate depends on the load in particles 
     320               !  on which they are adsorbed. The  parameterization has been taken from studies on Th 
     321               !     ------------------------------------------------------------ 
    339322               zkeq = fekeq(ji,jj,jk) 
    340323               zfeequi = ( -( 1. + zfesatur(ji,jj,jk) * zkeq - zkeq * trn(ji,jj,jk,jpfer) )               & 
    … …  
    349332                  &                      + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpdsi)  ) * 1.e6 
    350333#endif 
    351  
    352 # if defined key_off_degrad 
    353                zscave = zfeequi * zlam1b * xstep  * facvol(ji,jj,jk) 
    354 # else 
    355                zscave = zfeequi * zlam1b * xstep 
    356 # endif 
    357  
    358 !  Increased scavenging for very high iron concentrations 
    359 !  found near the coasts due to increased lithogenic particles 
    360 !  and let s say it unknown processes (precipitation, ...) 
    361 !  ----------------------------------------------------------- 
     334               zscave = zfeequi * zlam1b * zstep 
     335 
     336               !  Increased scavenging for very high iron concentrations 
     337               !  found near the coasts due to increased lithogenic particles 
     338               !  and let s say it unknown processes (precipitation, ...) 
     339               !  ----------------------------------------------------------- 
    362340               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    363341               zlamfac = MIN( 1.  , zlamfac ) 
    … …  
    374352#endif 
    375353 
    376 # if defined key_off_degrad 
    377                zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk) 
    378 # else 
    379                zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    380 # endif 
     354               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    381355 
    382356               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 
    … …  
    400374       ENDIF 
    401375 
    402 !     Update the arrays TRA which contain the biological sources and sinks 
    403 !     -------------------------------------------------------------------- 
     376       !     Update the arrays TRA which contain the biological sources and sinks 
     377       !     -------------------------------------------------------------------- 
    404378 
    405379      DO jk = 1, jpkm1 
    … …  
    429403      !! 
    430404      !! ** Method  :   Read the nampisrem namelist and check the parameters 
    431       !!      called at the first timestep (nittrc000) 
     405      !!      called at the first timestep 
    432406      !! 
    433407      !! ** input   :   Namelist nampisrem 
    … …  
    452426      ENDIF 
    453427 
     428      nitrfac(:,:,:) = 0.0 
     429      denitr (:,:,:) = 0.0   
     430 
    454431   END SUBROUTINE p4z_rem_init 
    455  
    456  
    457  
    458  
    459432 
    460433#else 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    • Property svn:executable deleted
    r1836 r2528  
    1919   USE sms_pisces 
    2020   USE lib_mpp 
     21   USE lib_fortran 
    2122   USE prtctl_trc 
    2223   USE p4zbio 
    … …  
    3435 
    3536   PUBLIC   p4z_sed    
     37   PUBLIC   p4z_sed_init    
    3638 
    3739   !! * Shared module variables 
    … …  
    4749 
    4850   !! * Module variables 
    49    INTEGER ::                   & 
    50      ryyss,                     &  !: number of seconds per year 
    51      rmtss                         !: number of seconds per month 
    52  
     51   REAL(wp) :: ryyss               !: number of seconds per year  
     52   REAL(wp) :: ryyss1              !: inverse of ryyss 
     53   REAL(wp) :: rmtss               !: number of seconds per month 
     54   REAL(wp) :: rday1               !: inverse of rday 
     55 
     56   INTEGER , PARAMETER :: & 
     57        jpmth = 12, jpyr = 1 
    5358   INTEGER ::                   & 
    5459      numdust,                  &  !: logical unit for surface fluxes data 
    5560      nflx1 , nflx2,            &  !: first and second record used 
    5661      nflx11, nflx12      ! ??? 
    57    REAL(wp), DIMENSION(jpi,jpj,2) ::    &  !: 
    58      dustmo                                !: 2 consecutive set of dust fields  
    59    REAL(wp), DIMENSION(jpi,jpj)   ::    & 
    60      rivinp, cotdep, nitdep, dust 
    61    REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   & 
    62      ironsed 
     62   REAL(wp), DIMENSION(jpi,jpj,jpmth) ::  dustmo    !: set of dust fields 
     63   REAL(wp), DIMENSION(jpi,jpj)      ::  rivinp, cotdep, nitdep, dust  
     64   REAL(wp), DIMENSION(jpi,jpj)      ::  e1e2t 
     65   REAL(wp), DIMENSION(jpi,jpj,jpk)  ::  ironsed  
    6366   REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput 
    6467 
    … …  
    6669#  include "top_substitute.h90" 
    6770   !!---------------------------------------------------------------------- 
    68    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     71   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    6972   !! $Header:$  
    70    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     73   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    7174   !!---------------------------------------------------------------------- 
    7275 
    7376CONTAINS 
    7477 
    75    SUBROUTINE p4z_sed(kt, jnt) 
     78   SUBROUTINE p4z_sed( kt, jnt ) 
    7679      !!--------------------------------------------------------------------- 
    7780      !!                     ***  ROUTINE p4z_sed  *** 
    … …  
    8487      !!--------------------------------------------------------------------- 
    8588      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    86       INTEGER  ::   ji, jj, jk 
    87       INTEGER  ::   ikt 
     89      INTEGER  ::   ji, jj, jk, ikt 
    8890#if ! defined key_sed 
    8991      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal 
     92      REAL(wp) ::   zrivalk, zrivsil, zrivpo4 
    9093#endif 
    91       REAL(wp) ::   zconctmp , zdenitot  , znitrpottot 
    92       REAL(wp) ::   zlim, zconctmp2, zstep, zfact 
     94      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact 
     95      REAL(wp) ::   zwsbio3, zwsbio4, zwscal 
    9396      REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep 
     97      REAL(wp), DIMENSION(jpi,jpj)     ::   zwork, zwork1 
    9498      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep 
    95 #if defined key_diaadd || defined key_trc_dia3d  
    96       REAL(wp) :: zrfact2 
    97 # if defined key_iomput 
    98      REAL(wp), DIMENSION(jpi,jpj)    ::    zw2d  
    99 # endif 
    100 #endif 
    10199      CHARACTER (len=25) :: charout 
    102100      !!--------------------------------------------------------------------- 
    103101 
    104  
    105       IF( ( kt * jnt ) == nittrc000   )   CALL p4z_sed_init      ! Initialization (first time-step only) 
    106       IF( (jnt == 1) .and. ( ln_dustfer ) )  CALL p4z_sbc( kt ) 
    107  
    108       zstep = rfact2 / rday      ! Time step duration for the biology 
    109  
    110       zirondep(:,:,:) = 0.e0          ! Initialisation of variables used to compute deposition 
    111       zsidep  (:,:)   = 0.e0 
     102      IF( jnt == 1  .AND.  ln_dustfer  )  CALL p4z_sbc( kt ) 
    112103 
    113104      ! Iron and Si deposition at the surface 
    … …  
    116107      DO jj = 1, jpj 
    117108         DO ji = 1, jpi 
    118             zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 / ryyss )   & 
     109            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 )   & 
    119110               &             * rfact2 / fse3t(ji,jj,1) 
    120111            zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss ) 
    … …  
    150141 
    151142#if ! defined key_sed 
    152       ! Initialisation of variables used to compute Sinking Speed 
    153       zsumsedsi  = 0.e0 
    154       zsumsedpo4 = 0.e0 
    155       zsumsedcal = 0.e0 
    156  
    157143      ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.  
    158144      ! First, the total loss is computed. 
    … …  
    161147      DO jj = 1, jpj 
    162148         DO ji = 1, jpi 
    163             ikt = MAX( mbathy(ji,jj)-1, 1 ) 
    164             zfact = e1t(ji,jj) * e2t(ji,jj) / rday * tmask_i(ji,jj) 
     149            ikt = mbkt(ji,jj)  
    165150# if defined key_kriest 
    166             zsumsedsi  = zsumsedsi  + zfact * trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
    167             zsumsedpo4 = zsumsedpo4 + zfact * trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
     151            zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
     152            zwork1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
    168153# else 
    169             zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
    170             zsumsedpo4 = zsumsedpo4 + zfact *( trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt)   & 
    171                &       + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) ) 
     154            zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
     155            zwork1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)  
    172156# endif 
    173             zsumsedcal = zsumsedcal + zfact *  trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 
    174          END DO 
    175       END DO 
    176  
    177       IF( lk_mpp ) THEN 
    178          CALL mpp_sum( zsumsedsi  )   ! sums over the global domain 
    179          CALL mpp_sum( zsumsedcal )   ! sums over the global domain 
    180          CALL mpp_sum( zsumsedpo4 )   ! sums over the global domain 
    181       ENDIF 
    182  
     157         END DO 
     158      END DO 
     159      zsumsedsi  = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1 
     160      zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1 
     161      DO jj = 1, jpj 
     162         DO ji = 1, jpi 
     163            ikt = mbkt(ji,jj)  
     164            zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) 
     165         END DO 
     166      END DO 
     167      zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1 
    183168#endif 
    184169 
    … …  
    191176      DO jj = 1, jpj 
    192177         DO ji = 1, jpi 
    193             ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    194             zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt)   & 
    195 # if ! defined key_kriest 
    196      &             * wscal (ji,jj,ikt) 
     178            ikt = mbkt(ji,jj) 
     179            zfact = xstep / fse3t(ji,jj,ikt) 
     180            zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt) 
     181            zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt) 
     182            zwscal  = 1._wp - zfact * wscal (ji,jj,ikt) 
     183            ! 
     184# if defined key_kriest 
     185            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4 
     186            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4 
     187            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 
     188            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 
    197189# else 
    198      &             * wsbio4(ji,jj,ikt) 
     190            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal  
     191            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4 
     192            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 
     193            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4 
     194            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 
    199195# endif 
    200             trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp 
     196            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal 
     197         END DO 
     198      END DO 
    201199 
    202200#if ! defined key_sed 
    203             trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp   & 
    204             &      * ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) 
    205 #endif 
    206          END DO 
    207       END DO 
    208  
     201      zrivsil =  1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi  
     202      zrivalk =  1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal  
     203      zrivpo4 =  1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4  
    209204      DO jj = 1, jpj 
    210205         DO ji = 1, jpi 
    211             ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    212             zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt) 
    213             trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp 
    214  
    215 #if ! defined key_sed 
    216             trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp   & 
    217                &   * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) * 2.e0 
    218             trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp   & 
    219                &   * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) 
    220 #endif 
    221          END DO 
    222       END DO 
    223  
    224       DO jj = 1, jpj 
    225          DO ji = 1, jpi 
    226             ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    227             zfact = zstep / fse3t(ji,jj,ikt) 
    228 # if ! defined key_kriest 
    229             zconctmp  = trn(ji,jj,ikt,jpgoc) 
    230             zconctmp2 = trn(ji,jj,ikt,jppoc) 
    231             trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - zconctmp  * wsbio4(ji,jj,ikt) * zfact 
    232             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 
    233 #if ! defined key_sed 
    234             trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    & 
    235             &      + ( zconctmp  * wsbio4(ji,jj,ikt) + zconctmp2 * wsbio3(ji,jj,ikt) ) * zfact   & 
    236             &      * ( 1.- rivpo4input / (ryyss * zsumsedpo4 ) ) 
    237 #endif 
    238             trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * wsbio4(ji,jj,ikt) * zfact 
    239             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 
    240  
     206            ikt = mbkt(ji,jj) 
     207            zfact = xstep / fse3t(ji,jj,ikt) 
     208            zwsbio3 = zfact * wsbio3(ji,jj,ikt) 
     209            zwsbio4 = zfact * wsbio4(ji,jj,ikt) 
     210            zwscal  = zfact * wscal (ji,jj,ikt) 
     211            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk * 2.0 
     212            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk 
     213# if defined key_kriest 
     214            trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil  
     215            trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4  
    241216# else 
    242             zconctmp  = trn(ji,jj,ikt,jpnum) 
    243             zconctmp2 = trn(ji,jj,ikt,jppoc) 
    244             trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum)   & 
    245             &      - zconctmp  * wsbio4(ji,jj,ikt) * zfact 
    246             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc)   & 
    247             &      - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 
    248 #if ! defined key_sed 
    249             trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    & 
    250             &      + ( zconctmp2 * wsbio3(ji,jj,ikt) )   & 
    251             &      * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) 
    252 #endif 
    253             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe)   & 
    254             &      - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 
    255  
     217            trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal  * zrivsil  
     218            trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc)   & 
     219            &                     + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4 
    256220# endif 
    257221         END DO 
    258222      END DO 
     223# endif 
    259224 
    260225      ! Nitrogen fixation (simple parameterization). The total gain 
    … …  
    263228      ! ------------------------------------------------------------- 
    264229 
    265       zdenitot = 0.e0 
    266       DO jk = 1, jpkm1 
    267          DO jj = 1,jpj 
    268             DO ji = 1,jpi 
    269                zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * cvol(ji,jj,jk) * xnegtr(ji,jj,jk) 
    270             END DO 
    271          END DO 
    272       END DO 
    273  
    274       IF( lk_mpp )   CALL mpp_sum( zdenitot )      ! sum over the global domain 
     230      zdenitot = glob_sum( denitr(:,:,:)  * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit 
    275231 
    276232      ! Potential nitrogen fixation dependant on temperature and iron 
    … …  
    285241               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 
    286242               IF( zlim <= 0.2 )   zlim = 0.01 
    287                znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) / rday )   & 
    288 # if defined key_off_degrad 
     243               znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 )   & 
     244# if defined key_degrad 
    289245               &                  * facvol(ji,jj,jk)   & 
    290246# endif 
    … …  
    295251      END DO 
    296252 
    297       znitrpottot = 0.e0 
    298       DO jk = 1, jpkm1 
    299          DO jj = 1, jpj 
    300             DO ji = 1, jpi 
    301                znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * cvol(ji,jj,jk) 
    302             END DO 
    303          END DO 
    304       END DO 
    305  
    306       IF( lk_mpp )   CALL mpp_sum( znitrpottot )  ! sum over the global domain 
     253      znitrpottot = glob_sum( znitrpot(:,:,:) * cvol(:,:,:) ) 
    307254 
    308255      ! Nitrogen change due to nitrogen fixation 
    … …  
    312259         DO jj = 1, jpj 
    313260            DO ji = 1, jpi 
    314 # if ! defined key_c1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 
    315 !!             zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot 
    316261               zfact = znitrpot(ji,jj,jk) * 1.e-7 
    317 # else 
    318                zfact = znitrpot(ji,jj,jk) * 1.e-7 
    319 # endif 
    320262               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact 
    321263               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit 
    … …  
    325267      END DO 
    326268 
    327 #if defined key_trc_diaadd || defined key_trc_dia3d 
    328       zrfact2 = 1.e+3 * rfact2r 
     269#if defined key_diatrc 
     270      zfact = 1.e+3 * rfact2r 
    329271#  if  ! defined key_iomput 
    330       trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 
    331       trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 
    332 # else 
    333       ! surface downward net flux of iron 
    334       zw2d(:,:)   =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)  
    335       IF( jnt == nrdttrc ) CALL iom_put( "Irondep", zw2d ) 
    336       ! nitrogen fixation at surface 
    337       zw2d(:,:)   =  znitrpot(:,:,1) * 1.e-7 * zrfact2  * fse3t(:,:,1) * tmask(:,:,1) 
    338       IF( jnt == nrdttrc ) CALL iom_put( "Nfix" , zw2d ) 
    339 # endif 
    340 # endif 
     272      trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     273      trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     274#  else 
     275      zwork (:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1)  
     276      zwork1(:,:)  =  znitrpot(:,:,1) * 1.e-7                       * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     277      IF( jnt == nrdttrc ) THEN 
     278         CALL iom_put( "Irondep", zwork  )  ! surface downward net flux of iron 
     279         CALL iom_put( "Nfix"   , zwork1 )  ! nitrogen fixation at surface 
     280      ENDIF 
     281#  endif 
     282#endif 
    341283      ! 
    342284       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    348290   END SUBROUTINE p4z_sed 
    349291 
    350    SUBROUTINE p4z_sbc(kt) 
     292   SUBROUTINE p4z_sbc( kt ) 
    351293 
    352294      !!---------------------------------------------------------------------- 
    … …  
    365307 
    366308      !! * Local declarations 
    367       INTEGER ::   & 
    368          imois, imois2,       &  ! temporary integers 
    369          i15  , iman             !    "          " 
    370       REAL(wp) ::   & 
    371          zxy                     !    "         " 
    372  
     309      INTEGER :: imois, i15, iman  
     310      REAL(wp) :: zxy 
    373311 
    374312      !!--------------------------------------------------------------------- 
    … …  
    381319      imois = nmonth + i15 - 1 
    382320      IF( imois == 0 ) imois = iman 
    383       imois2 = nmonth 
    384  
    385       ! 1. first call kt=nit000 
    386       ! ----------------------- 
    387  
    388       IF( kt == nit000 ) THEN 
    389          ! initializations 
    390          nflx1  = 0 
    391          nflx11 = 0 
    392          ! open the file 
    393          IF(lwp) THEN 
    394             WRITE(numout,*) ' ' 
    395             WRITE(numout,*) ' **** Routine p4z_sbc' 
    396          ENDIF 
    397          CALL iom_open ( 'dust.orca.nc', numdust ) 
    398       ENDIF 
    399  
    400  
    401      ! Read monthly file 
    402       ! ---------------- 
    403  
     321 
     322      ! Calendar computation 
    404323      IF( kt == nit000 .OR. imois /= nflx1 ) THEN 
    405324 
    406          ! Calendar computation 
     325         IF( kt == nit000 )  nflx1  = 0 
    407326 
    408327         ! nflx1 number of the first file record used in the simulation 
    … …  
    410329 
    411330         nflx1 = imois 
    412          nflx2 = nflx1+1 
     331         nflx2 = nflx1 + 1 
    413332         nflx1 = MOD( nflx1, iman ) 
    414333         nflx2 = MOD( nflx2, iman ) 
    415334         IF( nflx1 == 0 )   nflx1 = iman 
    416335         IF( nflx2 == 0 )   nflx2 = iman 
    417          IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1 
    418          IF(lwp) WRITE(numout,*) 'last  record file used nflx2 ',nflx2 
    419  
    420          ! Read monthly fluxes data 
    421  
    422          ! humidity 
    423          CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) 
    424          CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) 
    425  
    426          IF(lwp .AND. nitend-nit000 <= 100 ) THEN 
    427             WRITE(numout,*) 
    428             WRITE(numout,*) ' read clio flx ok' 
    429             WRITE(numout,*) 
    430                WRITE(numout,*) 
    431                WRITE(numout,*) 'Clio month: ',nflx1,'  field: dust' 
    432                CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout ) 
    433          ENDIF 
     336         IF(lwp) WRITE(numout,*)  
     337         IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1 
     338         IF(lwp) WRITE(numout,*) ' p4z_sbc : last  record file used nflx2 ',nflx2 
    434339 
    435340      ENDIF 
    436341 
    437      ! 3. at every time step interpolation of fluxes 
     342      ! 3. at every time step interpolation of fluxes 
    438343      ! --------------------------------------------- 
    439344 
    440345      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 
    441       dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) ) 
    442  
    443       IF( kt == nitend ) CALL iom_close (numdust) 
     346      dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) ) 
    444347 
    445348   END SUBROUTINE p4z_sbc 
    … …  
    454357      !! 
    455358      !! ** Method  :   Read the files and compute the budget 
    456       !!      called at the first timestep (nittrc000) 
     359      !!      called at the first timestep (nit000) 
    457360      !! 
    458361      !! ** input   :   external netcdf files 
    … …  
    460363      !!---------------------------------------------------------------------- 
    461364 
    462       INTEGER ::   ji, jj, jk, jm 
    463       INTEGER , PARAMETER ::   jpmois = 12, jpan = 1 
     365      INTEGER :: ji, jj, jk, jm 
    464366      INTEGER :: numriv, numbath, numdep 
    465367 
    … …  
    469371      REAL(wp) , DIMENSION (jpi,jpj)     ::   riverdoc, river, ndepo 
    470372      REAL(wp) , DIMENSION (jpi,jpj,jpk) ::   cmask 
    471       REAL(wp) , DIMENSION(jpi,jpj,12)    ::   zdustmo 
    472373 
    473374      NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub 
    … …  
    495396         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
    496397         CALL iom_open ( 'dust.orca.nc', numdust ) 
    497          DO jm = 1, jpmois 
    498             CALL iom_get( numdust, jpdom_data, 'dust', zdustmo(:,:,jm), jm ) 
     398         DO jm = 1, jpmth 
     399            CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 
    499400         END DO 
    500401         CALL iom_close( numdust ) 
    501402      ELSE 
    502          zdustmo(:,:,:) = 0.e0 
     403         dustmo(:,:,:) = 0.e0 
    503404         dust(:,:) = 0.0 
    504405      ENDIF 
    … …  
    510411         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    511412         CALL iom_open ( 'river.orca.nc', numriv ) 
    512          CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpan ) 
    513          CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpan ) 
     413         CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpyr ) 
     414         CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpyr ) 
    514415         CALL iom_close( numriv ) 
    515416      ELSE 
    … …  
    524425         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    525426         CALL iom_open ( 'ndeposition.orca.nc', numdep ) 
    526          CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan ) 
     427         CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpyr ) 
    527428         CALL iom_close( numdep ) 
    528429      ELSE 
    … …  
    537438         IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file ' 
    538439         CALL iom_open ( 'bathy.orca.nc', numbath ) 
    539          CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan ) 
     440         CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpyr ) 
    540441         CALL iom_close( numbath ) 
    541442         ! 
    … …  
    546447                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    & 
    547448                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 
    548                      IF( zmaskt == 0. )   cmask(ji,jj,jk ) = 0.1 
     449                     IF( zmaskt == 0. )   cmask(ji,jj,jk ) = MAX( 0.1, cmask(ji,jj,jk) )  
    549450                  ENDIF 
    550451               END DO 
    … …  
    567468 
    568469 
    569       ! Number of seconds per year and per month 
    570       ryyss = nyear_len(1) * rday 
    571       rmtss = ryyss / raamo 
     470      !                                    ! Number of seconds per year and per month 
     471      ryyss  = nyear_len(1) * rday 
     472      rmtss  = ryyss / raamo 
     473      rday1  = 1. / rday 
     474      ryyss1 = 1. / ryyss 
     475      !                                    ! ocean surface cell 
     476      e1e2t(:,:) = e1t(:,:) * e2t(:,:) 
    572477 
    573478      ! total atmospheric supply of Si 
    574479      ! ------------------------------ 
    575480      sumdepsi = 0.e0 
    576       DO jm = 1, jpmois 
    577          DO jj = 2, jpjm1 
    578             DO ji = fs_2, fs_jpim1 
    579                sumdepsi = sumdepsi + zdustmo(ji,jj,jm) / (12.*rmtss) * 8.8        & 
    580                   &     * 0.075/28.1 * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * tmask_i(ji,jj) 
    581             END DO 
    582          END DO 
    583       END DO 
    584       IF( lk_mpp )  CALL mpp_sum( sumdepsi )  ! sum over the global domain 
     481      DO jm = 1, jpmth 
     482         zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1         
     483         sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef 
     484      ENDDO 
    585485 
    586486      ! N/P and Si releases due to coastal rivers 
    … …  
    588488      DO jj = 1, jpj 
    589489         DO ji = 1, jpi 
    590             zcoef = ryyss * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) * tmask_i(ji,jj) 
     490            zcoef = ryyss * e1e2t(ji,jj)  * fse3t(ji,jj,1) * tmask(ji,jj,1)  
    591491            cotdep(ji,jj) =  river(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn ) 
    592492            rivinp(ji,jj) = (river(ji,jj)+riverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) 
    … …  
    597497      CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. ) 
    598498 
    599       rivpo4input = 0.e0 
    600       rivalkinput = 0.e0 
    601       nitdepinput = 0.e0 
    602       DO jj = 2 , jpjm1 
    603          DO ji = fs_2, fs_jpim1 
    604             zcoef = cvol(ji,jj,1) * ryyss 
    605             rivpo4input = rivpo4input + rivinp(ji,jj) * zcoef 
    606             rivalkinput = rivalkinput + cotdep(ji,jj) * zcoef 
    607             nitdepinput = nitdepinput + nitdep(ji,jj) * zcoef 
    608          END DO 
    609      END DO 
    610       IF( lk_mpp ) THEN 
    611          CALL mpp_sum( rivpo4input )  ! sum over the global domain 
    612          CALL mpp_sum( rivalkinput )  ! sum over the global domain 
    613          CALL mpp_sum( nitdepinput )  ! sum over the global domain 
    614       ENDIF 
     499      rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss 
     500      rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss 
     501      nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss 
    615502 
    616503 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    • Property svn:executable deleted
    r1836 r2528  
    1919   PRIVATE 
    2020 
    21    PUBLIC   p4z_sink    ! called in p4zbio.F90 
     21   PUBLIC   p4z_sink         ! called in p4zbio.F90 
     22   PUBLIC   p4z_sink_init    ! called in trcsms_pisces.F90 
    2223 
    2324   !! * Shared module variables 
    … …  
    3132     sinkcal, sinksil,    &    !: CaCO3 and BSi sinking fluxes 
    3233     sinkfer                   !: Small BFe sinking flux 
    33  
    34    REAL(wp) ::   & 
    35      xstep , xstep2            !: Time step duration for biology 
    3634 
    3735   INTEGER  :: & 
    … …  
    7169#  include "top_substitute.h90" 
    7270   !!---------------------------------------------------------------------- 
    73    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     71   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    7472   !! $Id$  
    75    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     73   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    7674   !!---------------------------------------------------------------------- 
    7775 
    … …  
    9795      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
    9896      REAL(wp) :: zval1, zval2, zval3, zval4 
    99 #if defined key_trc_diaadd 
     97#if defined key_diatrc 
    10098      REAL(wp) :: zrfact2 
    10199      INTEGER  :: ik1 
    … …  
    106104      !!--------------------------------------------------------------------- 
    107105 
    108       IF( ( kt * jnt ) == nittrc000  )  THEN  
    109           CALL p4z_sink_init   ! Initialization (first time-step only) 
    110           xstep  = rfact2 / rday      ! Time step duration for biology 
    111           xstep2 = rfact2 /  2. 
    112       ENDIF 
    113  
    114 !     Initialisation of variables used to compute Sinking Speed 
    115 !     --------------------------------------------------------- 
     106      !     Initialisation of variables used to compute Sinking Speed 
     107      !     --------------------------------------------------------- 
    116108 
    117109       znum3d(:,:,:) = 0.e0 
    … …  
    120112       zval3 = 1. + xkr_eta 
    121113 
    122 !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
    123 !     ----------------------------------------------------------------- 
     114     !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
     115     !     ----------------------------------------------------------------- 
    124116 
    125117      DO jk = 1, jpkm1 
    … …  
    128120               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 
    129121                  znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp 
    130 ! -------------- To avoid sinking speed over 50 m/day ------- 
     122                  ! -------------- To avoid sinking speed over 50 m/day ------- 
    131123                  znum  = MIN( xnumm(jk), znum ) 
    132124                  znum  = MAX( 1.1      , znum ) 
    133125                  znum3d(ji,jj,jk) = znum 
    134 !------------------------------------------------------------ 
     126                  !------------------------------------------------------------ 
    135127                  zeps  = ( zval1 * znum - 1. )/ ( znum - 1. ) 
    136128                  zfm   = xkr_frac**( 1. - zeps ) 
    … …  
    150142      wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. ) 
    151143 
    152  
    153 !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    154 !   ----------------------------------------- 
     144      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
     145      !   ----------------------------------------- 
    155146 
    156147      sinking (:,:,:) = 0.e0 
    … …  
    160151      sinksil (:,:,:) = 0.e0 
    161152 
    162 !   Compute the sedimentation term using p4zsink2 for all 
    163 !   the sinking particles 
    164 !   ----------------------------------------------------- 
     153     !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
     154     !   ----------------------------------------------------- 
    165155 
    166156      CALL p4z_sink2( wsbio3, sinking , jppoc ) 
    … …  
    170160      CALL p4z_sink2( wscal , sinkcal , jpcal ) 
    171161 
    172 !  Exchange between organic matter compartments due to 
    173 !  coagulation/disaggregation 
    174 !  --------------------------------------------------- 
     162     !  Exchange between organic matter compartments due to coagulation/disaggregation 
     163     !  --------------------------------------------------- 
    175164 
    176165      zval1 = 1. + xkr_zeta 
    … …  
    185174 
    186175                  znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp 
    187 ! -------------- To avoid sinking speed over 50 m/day ------- 
     176                  !-------------- To avoid sinking speed over 50 m/day ------- 
    188177                  znum  = min(xnumm(jk),znum) 
    189178                  znum  = MAX( 1.1,znum) 
    190 !------------------------------------------------------------ 
     179                  !------------------------------------------------------------ 
    191180                  zeps  = ( zval1 * znum - 1.) / ( znum - 1.) 
    192181                  zdiv  = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 ) 
    … …  
    199188                  zsm   = xkr_frac**xkr_eta 
    200189 
    201 !    Part I : Coagulation dependant on turbulence 
    202 !    ---------------------------------------------- 
     190                  !    Part I : Coagulation dependant on turbulence 
     191                  !    ---------------------------------------------- 
    203192 
    204193                  zagg1 = ( 0.163 * trn(ji,jj,jk,jpnum)**2               & 
    … …  
    207196                     &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  & 
    208197                     &            * (zeps-1.)**2/(zdiv2*zdiv3))            & 
    209 # if defined key_off_degrad 
     198# if defined key_degrad 
    210199                     &                 *facvol(ji,jj,jk)       & 
    211200# endif 
    … …  
    219208                     &                    -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/           & 
    220209                     &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))      & 
    221 #    if defined key_off_degrad 
     210#    if defined key_degrad 
    222211                     &                 *facvol(ji,jj,jk)             & 
    223212#    endif 
    … …  
    225214 
    226215                  zagg3 = (  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   & 
    227 #    if defined key_off_degrad 
     216#    if defined key_degrad 
    228217                     &                 *facvol(ji,jj,jk)             & 
    229218#    endif 
    … …  
    232221                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
    233222 
    234 !    Aggregation of small into large particles 
    235 !    Part II : Differential settling 
    236 !    ---------------------------------------------- 
     223                 !    Aggregation of small into large particles 
     224                 !    Part II : Differential settling 
     225                 !    ---------------------------------------------- 
    237226 
    238227                  zagg4 = (  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
    … …  
    242231                     &                 ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2)     & 
    243232                     &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )                     & 
    244 # if defined key_off_degrad 
     233# if defined key_degrad 
    245234                     &                 *facvol(ji,jj,jk)        & 
    246235# endif 
    … …  
    252241                     &                 /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2)    & 
    253242                     &                 /zdiv)                   & 
    254 # if defined key_off_degrad 
     243# if defined key_degrad 
    255244                     &                 *facvol(ji,jj,jk)        & 
    256245# endif 
    … …  
    261250                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
    262251 
    263 !     Aggregation of DOC to small particles 
    264 !     -------------------------------------- 
     252                  !     Aggregation of DOC to small particles 
     253                  !     -------------------------------------- 
    265254 
    266255                  zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               & 
    267256                     &        + 1018.  * trn(ji,jj,jk,jppoc)  ) * xstep    & 
    268 # if defined key_off_degrad 
     257# if defined key_degrad 
    269258                     &        * facvol(ji,jj,jk)                              & 
    270259# endif 
    … …  
    281270      END DO 
    282271 
    283 #if defined key_trc_diaadd 
     272#if defined key_diatrc 
    284273      zrfact2 = 1.e3 * rfact2r 
    285274      ik1 = iksed + 1 
    … …  
    332321      !! 
    333322      !! ** Method  :   Read the nampiskrs namelist and check the parameters 
    334       !!      called at the first timestep (nittrc000) 
     323      !!      called at the first timestep  
    335324      !! 
    336325      !! ** input   :   Namelist nampiskrs 
    … …  
    473462      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    474463      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    475       REAL(wp) ::   zfact, zwsmax 
    476 #if defined key_trc_dia3d 
     464      REAL(wp) ::   zfact, zwsmax, zstep 
     465#if defined key_diatrc 
    477466      REAL(wp) ::   zrfact2 
    478467      INTEGER  ::   ik1 
    … …  
    481470      !!--------------------------------------------------------------------- 
    482471 
    483       IF( ( kt * jnt ) == nittrc000  )  THEN 
    484           xstep  = rfact2 / rday      ! Timestep duration for biology 
    485           xstep2 = rfact2 /  2. 
    486       ENDIF 
    487  
    488 !    Sinking speeds of detritus is increased with depth as shown 
    489 !    by data and from the coagulation theory 
    490 !    ----------------------------------------------------------- 
     472      !    Sinking speeds of detritus is increased with depth as shown 
     473      !    by data and from the coagulation theory 
     474      !    ----------------------------------------------------------- 
    491475      DO jk = 1, jpkm1 
    492476         DO jj = 1, jpj 
    493477            DO ji=1,jpi 
    494                zfact = MAX( 0., fsdepw(ji,jj,jk+1)-hmld(ji,jj) ) / 4000. 
     478               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000. 
    495479               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    496480            END DO 
    … …  
    498482      END DO 
    499483 
    500 !      LIMIT THE VALUES OF THE SINKING SPEEDS  
    501 !      TO AVOID NUMERICAL INSTABILITIES 
    502  
     484      ! limit the values of the sinking speeds to avoid numerical instabilities   
    503485      wsbio3(:,:,:) = wsbio 
    504 ! 
    505 ! OA Below, this is garbage. the ideal would be to find a time-splitting 
    506 ! OA algorithm that does not increase the computing cost by too much 
    507 ! OA In ROMS, I have included a time-splitting procedure. But it is  
    508 ! OA too expensive as the loop is computed globally. Thus, a small e3t 
    509 ! OA at one place determines the number of subtimesteps globally 
    510 ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !! 
     486      ! 
     487      ! OA Below, this is garbage. the ideal would be to find a time-splitting  
     488      ! OA algorithm that does not increase the computing cost by too much 
     489      ! OA In ROMS, I have included a time-splitting procedure. But it is  
     490      ! OA too expensive as the loop is computed globally. Thus, a small e3t 
     491      ! OA at one place determines the number of subtimesteps globally 
     492      ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !! 
    511493 
    512494      DO jk = 1,jpkm1 
    … …  
    522504      wscal(:,:,:) = wsbio4(:,:,:) 
    523505 
    524 !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    525 !   ----------------------------------------- 
     506      !  Initializa to zero all the sinking arrays  
     507      !   ----------------------------------------- 
    526508 
    527509      sinking (:,:,:) = 0.e0 
    … …  
    532514      sinkfer2(:,:,:) = 0.e0 
    533515 
    534 !   Compute the sedimentation term using p4zsink2 for all 
    535 !   the sinking particles 
    536 !   ----------------------------------------------------- 
     516      !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
     517      !   ----------------------------------------------------- 
    537518 
    538519      CALL p4z_sink2( wsbio3, sinking , jppoc ) 
    … …  
    543524      CALL p4z_sink2( wscal , sinkcal , jpcal ) 
    544525 
    545 !  Exchange between organic matter compartments due to 
    546 !  coagulation/disaggregation 
    547 !  --------------------------------------------------- 
     526      !  Exchange between organic matter compartments due to coagulation/disaggregation 
     527      !  --------------------------------------------------- 
    548528 
    549529      DO jk = 1, jpkm1 
    550530         DO jj = 1, jpj 
    551531            DO ji = 1, jpi 
    552                zfact = xstep * xdiss(ji,jj,jk) 
     532# if defined key_degrad 
     533               zstep = xstep * facvol(ji,jj,jk) 
     534# else 
     535               zstep = xstep  
     536# endif 
     537               zfact = zstep * xdiss(ji,jj,jk) 
    553538               !  Part I : Coagulation dependent on turbulence 
    554 # if defined key_off_degrad 
    555                zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
    556                zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
    557 # else 
    558539               zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    559540               zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    560 # endif 
    561541 
    562542               ! Part II : Differential settling 
    563543 
    564544               !  Aggregation of small into large particles 
    565 # if defined key_off_degrad 
    566                zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
    567                zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
    568 # else 
    569                zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    570                zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    571 # endif 
     545               zagg3 = 0.66 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     546               zagg4 = 0.e0 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     547 
    572548               zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    573549               zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    574550 
    575551               ! Aggregation of DOC to small particles 
    576 #if defined key_off_degrad 
    577                zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )       & 
    578                   &      * facvol(ji,jj,jk)  * zfact * trn(ji,jj,jk,jpdoc) 
    579                zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc)   & 
    580                   &      * facvol(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
    581 #else 
    582                zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )    & 
    583                   &      *  zfact * trn(ji,jj,jk,jpdoc) 
     552               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) *  zfact * trn(ji,jj,jk,jpdoc)  
    584553               zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
    585 #endif 
     554 
    586555               !  Update the trends 
    587556               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 
    … …  
    595564      END DO 
    596565 
    597 #if defined key_trc_diaadd 
     566#if defined key_diatrc 
    598567      zrfact2 = 1.e3 * rfact2r 
    599568      ik1  = iksed + 1 
    … …  
    623592   END SUBROUTINE p4z_sink 
    624593 
     594   SUBROUTINE p4z_sink_init 
     595      !!---------------------------------------------------------------------- 
     596      !!                  ***  ROUTINE p4z_sink_init  *** 
     597      !!---------------------------------------------------------------------- 
     598   END SUBROUTINE p4z_sink_init 
     599 
    625600#endif 
    626601 
    … …  
    641616      !! 
    642617      INTEGER  ::   ji, jj, jk, jn 
    643       REAL(wp) ::   zigma,zew,zign, zflx 
     618      REAL(wp) ::   zigma,zew,zign, zflx, zstep 
    644619      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztraz, zakz 
    645620      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwsink2 
    … …  
    647622 
    648623 
     624      zstep = rfact2 / 2. 
     625 
    649626      ztraz(:,:,:) = 0.e0 
    650627      zakz (:,:,:) = 0.e0 
    651628 
    652629      DO jk = 1, jpkm1 
    653 # if defined key_off_degrad 
     630# if defined key_degrad 
    654631         zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) * facvol(:,:,jk) 
    655632# else 
    … …  
    693670            DO jj = 1, jpj       
    694671               DO ji = 1, jpi     
    695                   zigma = zwsink2(ji,jj,jk+1) * xstep2 / fse3w(ji,jj,jk+1) 
     672                  zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1) 
    696673                  zew   = zwsink2(ji,jj,jk+1) 
    697                   psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * xstep2 
     674                  psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
    698675               END DO 
    699676            END DO 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r2049 r2528  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    77   !!---------------------------------------------------------------------- 
    8    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     8   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    99   !! $Id$  
    10    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     10   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 
    … …  
    1717   IMPLICIT NONE 
    1818 
    19    INTEGER, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC 
    20    INTEGER, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !: 
    21    INTEGER, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !: 
    22    INTEGER, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !: 
     19   INTEGER, PUBLIC, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC 
     20   INTEGER, PUBLIC, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !: 
     21   INTEGER, PUBLIC, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !: 
     22   INTEGER, PUBLIC, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !: 
    2323 
    2424#if defined key_pisces  &&  defined key_kriest 
    … …  
    2929   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag  
    3030   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers 
    31    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output ('key_trc_diaadd') 
    32    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output ('key_trc_diaadd') 
     31   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output ('key_diatrc') 
     32   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output ('key_diatrc') 
    3333   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   1     !: number of sms trends for PISCES 
    3434 
    … …  
    6767   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag  
    6868   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers 
    69    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output ('key_trc_diaadd') 
    70    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output ('key_trc_diaadd') 
     69   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output ('key_diatrc') 
     70   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output ('key_diatrc') 
    7171   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  1      !: number of sms trends for PISCES 
    7272 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r1836 r2528  
    2323   REAL(wp) ::   rfact , rfactr    !: ??? 
    2424   REAL(wp) ::   rfact2, rfact2r   !: ??? 
     25   REAL(wp) ::   xstep             !: Time step duration for biology 
    2526 
    2627   !!*  Biological parameters  
    … …  
    6263   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimbac    !: ?? 
    6364   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiss      !: ?? 
    64 #if defined key_trc_dia3d 
     65#if defined key_diatrc 
    6566   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prodcal    !: Calcite production 
    6667   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazing    !: Total zooplankton grazing 
    … …  
    9192    
    9293   !!---------------------------------------------------------------------- 
    93    !! NEMO/TOP 3.2 , LOCEAN-IPSL (2009)  
     94   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    9495   !! $Id$  
    95    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     96   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    9697   !!======================================================================    
    9798END MODULE sms_pisces     

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r1800 r2528  
    4040#  include "top_substitute.h90" 
    4141   !!---------------------------------------------------------------------- 
    42    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     42   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4343   !! $Id$  
    44    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4545   !!---------------------------------------------------------------------- 
    4646 
    … …  
    5555 
    5656 
     57      !  Control consitency 
     58      CALL trc_ctl_pisces 
     59 
     60 
    5761      IF(lwp) WRITE(numout,*) 
    5862      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
    5963      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    6064 
    61  
    6265      !                                            ! Time-step 
    63       rfact   = rdttra(1) * float(ndttrc)          ! --------- 
     66      rfact   = rdttrc(1)                          ! --------- 
    6467      rfactr  = 1. / rfact 
    65       rfact2  = rfact / float(nrdttrc) 
     68      rfact2  = rfact / FLOAT( nrdttrc ) 
    6669      rfact2r = 1. / rfact2 
    6770 
    68       IF(lwp) WRITE(numout,*) '    Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt 
    69       IF(lwp) write(numout,*) '    Biology time step    rfact2 = ', rfact2 
     71      IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1) 
     72      IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2 
    7073 
    7174 
    … …  
    8083 
    8184      CALL p4z_che        ! initialize the chemical constants 
    82  
    83       ndayflxtr = 0      !  Initialize a counter for the computation of chemistry 
    8485 
    8586      ! Initialization of tracer concentration in case of  no restart  
    … …  
    128129      ! 
    129130   END SUBROUTINE trc_ini_pisces 
    130     
     131  
     132   SUBROUTINE trc_ctl_pisces 
     133      !!---------------------------------------------------------------------- 
     134      !!                     ***  ROUTINE trc_ctl_pisces  *** 
     135      !! 
     136      !! ** Purpose :   control the cpp options, namelist and files  
     137      !!---------------------------------------------------------------------- 
     138 
     139      IF(lwp) WRITE(numout,*) 
     140      IF(lwp) WRITE(numout,*) ' use PISCES biological model ' 
     141 
     142   ! Check number of tracers 
     143   ! ----------------------- 
     144#if  defined key_kriest 
     145      IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' ) 
     146#else 
     147      IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' ) 
     148#endif 
     149 
     150   END SUBROUTINE trc_ctl_pisces 
     151   
    131152#else 
    132153   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    • Property svn:keywords set to Id
    r1836 r2528  
    2121   USE iom 
    2222   USE trcdta 
     23   USE lib_mpp 
     24   USE lib_fortran 
    2325 
    2426   IMPLICIT NONE 
    … …  
    118120      IF(lwp)  WRITE(numout,*) 
    119121 
    120       IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
     122      IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
    121123         !                                                    ! --------------------------- ! 
    122124         ! set total alkalinity, phosphate, nitrate & silicate 
    123125 
    124          zalksum = 0.e0 
    125          zpo4sum = 0.e0 
    126          zno3sum = 0.e0 
    127          zsilsum = 0.e0 
    128          DO jk = 1, jpk 
    129             DO jj = 1, jpj 
    130                DO ji = 1, jpi 
    131                   zvol = cvol(ji,jj,jk) 
    132 #  if defined key_off_degrad 
    133                   zvol = zvol * facvol(ji,jj,jk) 
    134 #  endif 
    135                   zalksum = zalksum + trn(ji,jj,jk,jptal) * zvol 
    136                   zpo4sum = zpo4sum + trn(ji,jj,jk,jppo4) * zvol 
    137                   zno3sum = zno3sum + trn(ji,jj,jk,jpno3) * zvol 
    138                   zsilsum = zsilsum + trn(ji,jj,jk,jpsil) * zvol 
    139                END DO 
    140             END DO 
    141          END DO 
    142          IF( lk_mpp )   CALL mpp_sum( zalksum )     ! sum over the global domain 
    143          IF( lk_mpp )   CALL mpp_sum( zpo4sum )     ! sum over the global domain 
    144          IF( lk_mpp )   CALL mpp_sum( zno3sum )     ! sum over the global domain 
    145          IF( lk_mpp )   CALL mpp_sum( zsilsum )     ! sum over the global domain 
    146126         zarea   = 1. / areatot * 1.e6 
    147          zalksum = zalksum * zarea 
    148          zpo4sum = zpo4sum * zarea / 122. 
    149          zno3sum = zno3sum * zarea / 7.6 
    150          zsilsum = zsilsum * zarea 
     127# if defined key_degrad 
     128         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) * facvol(:,:,:) ) * zarea 
     129         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 122. 
     130         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 7.6 
     131         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) * facvol(:,:,:) ) * zarea 
     132# else 
     133         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
     134         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122. 
     135         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6 
     136         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     137# endif 
    151138 
    152139         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum 
    … …  
    263250#if defined key_dtatrc 
    264251      ! Restore close seas values to initial data 
    265       CALL trc_dta( nittrc000 )  
     252      CALL trc_dta( nit000 )  
    266253      DO jn = 1, jptra 
    267254         IF( lutini(jn) ) THEN 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    • Property svn:executable deleted
    r1753 r2528  
    2222   USE p4zche          !  
    2323   USE p4zbio          !  
     24   USE p4zsink         !  
     25   USE p4zopt          !  
     26   USE p4zlim          !  
     27   USE p4zprod         ! 
     28   USE p4zmort         ! 
     29   USE p4zmicro        !  
     30   USE p4zmeso         !  
     31   USE p4zrem          !  
    2432   USE p4zsed          !  
    2533   USE p4zlys          !  
    2634   USE p4zflx          !  
    2735 
    28    USE trdmld_trc_oce 
    29    USE trdmld_trc 
     36   USE prtctl_trc 
     37 
     38   USE trdmod_oce 
     39   USE trdmod_trc 
    3040 
    3141   USE sedmodel 
    … …  
    3747 
    3848   !!---------------------------------------------------------------------- 
    39    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     49   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4050   !! $Id$  
    41    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     51   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4252   !!---------------------------------------------------------------------- 
    4353 
    … …  
    5969      INTEGER ::   jnt, jn 
    6070      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrpis   ! used for pisces sms trends 
     71      CHARACTER (len=25) :: charout 
    6172      !!--------------------------------------------------------------------- 
    6273 
    63       IF( kt == nittrc000  .AND. .NOT. ln_rsttr )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
     74      IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
    6475 
    65       IF( ndayflxtr /= nday ) THEN      ! New days 
     76      IF( ndayflxtr /= nday_year ) THEN      ! New days 
    6677         ! 
    67          ndayflxtr = nday 
     78         ndayflxtr = nday_year 
     79 
     80         IF(lwp) write(numout,*) 
     81         IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year 
     82         IF(lwp) write(numout,*) '~~~~~~' 
    6883 
    6984         CALL p4z_che          ! computation of chemical constants 
    … …  
    7186         ! 
    7287      ENDIF 
    73  
    7488 
    7589      DO jnt = 1, nrdttrc          ! Potential time splitting if requested 
    … …  
    91105      END DO 
    92106 
     107 
    93108      IF( l_trdtrc ) THEN 
    94109          DO jn = jp_pcs0, jp_pcs1 
    95110            ztrpis(:,:,:) = tra(:,:,:,jn) 
    96             CALL trd_mod_trc( ztrpis, jn, jptrc_trd_sms, kt )   ! save trends 
     111            CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends 
    97112          END DO 
    98113      END IF 
    … …  
    121136      REAL(wp) ::  ztmas, ztmas1 
    122137 
    123       ! Initialization of chemical variables of the carbon cycle 
    124       ! -------------------------------------------------------- 
    125       DO jk = 1, jpk 
    126          DO jj = 1, jpj 
    127             DO ji = 1, jpi 
    128                ztmas   = tmask(ji,jj,jk) 
    129                ztmas1  = 1. - tmask(ji,jj,jk) 
    130                zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    131                zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    132                zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    133                hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     138      IF( .NOT. ln_rsttr ) THEN 
     139         ! Initialization of chemical variables of the carbon cycle 
     140         ! -------------------------------------------------------- 
     141         DO jk = 1, jpk 
     142            DO jj = 1, jpj 
     143               DO ji = 1, jpi 
     144                  ztmas   = tmask(ji,jj,jk) 
     145                  ztmas1  = 1. - tmask(ji,jj,jk) 
     146                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     147                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
     148                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
     149                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     150               END DO 
    134151            END DO 
    135152         END DO 
    136       END DO 
     153         ! 
     154      END IF 
     155 
     156      ! Time step duration for biology 
     157      xstep = rfact2 / rday 
     158 
     159      CALL p4z_sink_init      ! vertical flux of particulate organic matter 
     160      CALL p4z_opt_init       ! Optic: PAR in the water column 
     161      CALL p4z_lim_init       ! co-limitations by the various nutrients 
     162      CALL p4z_prod_init      ! phytoplankton growth rate over the global ocean.  
     163      CALL p4z_rem_init       ! remineralisation 
     164      CALL p4z_mort_init      ! phytoplankton mortality 
     165      CALL p4z_micro_init     ! microzooplankton 
     166      CALL p4z_meso_init      ! mesozooplankton 
     167      CALL p4z_sed_init       ! sedimentation 
     168      CALL p4z_lys_init       ! calcite saturation 
     169      CALL p4z_flx_init       ! gas exchange 
     170 
     171      ndayflxtr = 0 
    137172 
    138173   END SUBROUTINE trc_sms_pisces_init 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/par_sed.F90

    • Property svn:keywords set to Id
    r1250 r2528  
    1616      jpjm1    =>   jpjm1 ,  & !: jpj - 1 
    1717      jpij     =>   jpij       !: jpi x jpj 
     18      jp_tem   =>   jp_tem     !: indice of temperature 
     19      jp_sal   =>   jp_sal     !: indice of salintity 
    1820 
    1921#if ! defined key_sed_off 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sed.F90

    • Property svn:keywords set to Id
    r1715 r2528  
    1717      gphit    =>   gphit  ,  & !: latitude  of t-point (degre) 
    1818      e3t_0    =>   e3t_0  ,  & !: reference depth of t-points (m) 
    19       mbathy   =>   mbathy ,  & !: bathymetry 
     19      mbkt     =>   mbkt   ,  & !: vertical index of the bottom last T- ocean level 
    2020      tmask    =>   tmask  ,  & !: land/ocean mask at t-points 
    2121      rdt      =>   rdt         !: time step for the dynamics 
    … …  
    3434 
    3535   USE oce , ONLY :            & 
    36       tn      =>    tn    ,  & !: pot. temperature (celsius) 
    37       sn      =>    sn         !: salinity (psu) 
     36      tsn      =>    tsn       & !: pot. temperature (celsius) and salinity (psu) 
    3837 
    3938   USE trc, ONLY :  & 
    4039      trn        , & !: tracer  
    41       nittrc000  , & !: 1st time step of tracer model 
    4240      nwritetrc      !: outputs frequency of tracer model 
    4341 
    … …  
    215213   INTEGER, PUBLIC :: & 
    216214     numsed = 27 
    217     
    218215#else 
    219216   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedadv.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedarr.F90

    • Property svn:keywords set to Id
    r1250 r2528  
    2828 
    2929   !!---------------------------------------------------------------------- 
    30    !!   LIM 2.0,  UCL-LOCEAN-IPSL (2005)  
     30   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3131   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp $  
    32    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     32   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 
    3434CONTAINS 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedbtb.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90

    • Property svn:keywords set to Id
    r1250 r2528  
    216216      DO jj = 1,jpj 
    217217         DO ji = 1, jpi 
    218             ikt = MAX( mbathy(ji,jj)-1, 1 ) 
     218            ikt = mbkt(ji,jj)  
    219219            IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    220220               zchem_data(ji,jj,1) = ak13 (ji,jj,ikt) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedco3.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/seddsr.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/seddta.F90

    • Property svn:keywords set to Id
    r1264 r2528  
    118118         DO jj = 1,jpj 
    119119            DO ji = 1, jpi 
    120                ikt = MAX( mbathy(ji,jj)-1, 1 ) 
     120               ikt = mbkt(ji,jj) 
    121121               IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    122122                  trc_data(ji,jj,1)  = trn  (ji,jj,ikt,jptal) 
    … …  
    131131                  trc_data(ji,jj,9 ) = sinking2(ji,jj,ikt) 
    132132                  trc_data(ji,jj,10) = sinkcal (ji,jj,ikt) 
    133                   trc_data(ji,jj,11) = tn      (ji,jj,ikt) 
    134                   trc_data(ji,jj,12) = sn      (ji,jj,ikt) 
     133                  trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_tem) 
     134                  trc_data(ji,jj,12) = tsn     (ji,jj,ikt,jp_sal) 
    135135#   else 
    136136                  trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt) 
    137137                  trc_data(ji,jj,8 ) = sinking (ji,jj,ikt) 
    138138                  trc_data(ji,jj,9 ) = sinkcal (ji,jj,ikt) 
    139                   trc_data(ji,jj,10) = tn      (ji,jj,ikt) 
    140                   trc_data(ji,jj,11) = sn      (ji,jj,ikt)        
     139                  trc_data(ji,jj,10) = tsn     (ji,jj,ikt,jp_tem) 
     140                  trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_sal)        
    141141#   endif 
    142142               ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90

    • Property svn:keywords set to Id
    r1581 r2528  
    123123      DO jj = 1, jpj 
    124124         DO ji = 1, jpi 
    125             ikt = MAX( INT( sbathy(ji,jj) )  - 1, 1 ) 
     125            ikt = MAX( INT( sbathy(ji,jj) ), 1 ) 
    126126            IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = zdta(ji,jj) 
    127127         ENDDO 
    … …  
    135135      DO jj = 1, jpj 
    136136         DO ji = 1, jpi 
    137             ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
     137            ikt = mbkt(ji,jj)  
    138138            IF( tmask(ji,jj,ikt) == 1 ) epkbot(ji,jj) = e3t_0(ikt) 
    139139         ENDDO 
    … …  
    443443 
    444444      dtsed = rdt 
     445      nitsed000 = nit000 
     446      nitsedend = nitend 
    445447#if ! defined key_sed_off 
    446       nitsed000 = nittrc000 
    447       nitsedend = nitend 
    448448      nwrised   = nwritetrc 
    449449#else 
    450       nitsed000 = nit000 
    451       nitsedend = nitend 
    452450      nwrised   = nwrite 
    453451#endif 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedmat.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedmbc.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedmodel.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedrst.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedsfc.F90

    • Property svn:keywords set to Id
    r1250 r2528  
    5252      DO jj = 1,jpj 
    5353         DO ji = 1, jpi 
    54             ikt = MAX( mbathy(ji,jj)-1, 1 ) 
     54            ikt = mbkt(ji,jj) 
    5555            IF ( tmask(ji,jj,ikt) == 1 ) THEN 
    5656               trn(ji,jj,ikt,jptal) = trc_data(ji,jj,1) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedstp.F90

    • Property svn:keywords set to Id

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90

    • Property svn:keywords set to Id
    r1334 r2528  
    186186         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,     & 
    187187            &             iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    188             &             nitsed000-1, zjulian, zdt,  nhorised, nised , domain_id=nidom ) 
     188            &             nitsed000-1, zjulian, zdt,  nhorised, nised , domain_id=nidom, snc4chunks=snc4set ) 
    189189         CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed, 'down' ) 
    190190         CALL wheneq  ( jpi*jpj*ipk, tmasksed, 1, 1., ndext52, ndimt52 ) 
    … …  
    223223 
    224224 
    225          CALL histend( nised ) 
     225         CALL histend( nised, snc4set ) 
    226226 
    227227         WRITE(numsed,*) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    • Property svn:executable deleted
    r1606 r2528  
    11MODULE trcbbl 
    2    !!====================================================================== 
     2  !!====================================================================== 
    33   !!                       ***  MODULE  trcbbl  *** 
    44   !! Ocean passive tracers physics :  advective and/or diffusive bottom boundary  
    55   !!                                  layer scheme 
    66   !!====================================================================== 
    7    !! History :  8.0  !  96-06  (L. Mortier)  Original code 
    8    !!            8.0  !  97-11  (G. Madec)  Optimization 
    9    !!            8.5  !  02-08  (G. Madec)  free form + modules 
    10    !!            9.0  !  04-03  (C. Ethe)   Adaptation for passive tracers 
    11    !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     7   !!============================================================================== 
     8   !! History :  OPA  !  1996-06  (L. Mortier)  Original code 
     9   !!            8.0  !  1997-11  (G. Madec)    Optimization 
     10   !!   NEMO     1.0  !  2002-08  (G. Madec)  free form + modules 
     11   !!             -   !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ) add advective bbl 
     12   !!            3.3  !  2009-11  (G. Madec)  merge trabbl and trabbl_adv + style + optimization  
     13   !!             -   !  2010-04  (G. Madec)  Campin & Goosse advective bbl  
     14   !!             -   !  2010-06  (C. Ethe, G. Madec)  merge TRA-TRC 
    1215   !!---------------------------------------------------------------------- 
    13 #if  defined key_top && ( defined key_trcbbl_dif   ||   defined key_trcbbl_adv ) && ! defined key_c1d 
     16#if  defined key_top &&  defined key_trabbl  
    1417   !!---------------------------------------------------------------------- 
    15    !!   'key_trcbbl_dif'   or            diffusive bottom boundary layer 
    16    !!   'key_trcbbl_adv'                 advective bottom boundary layer 
     18   !!   'key_trabbl                      diffusive or/and adevective bottom boundary layer 
    1719   !!---------------------------------------------------------------------- 
    18    !!   trc_bbl_dif  : update the passive tracer trends due to the bottom 
    19    !!                  boundary layer (diffusive only) 
    20    !!   trc_bbl_adv  : update the passive tracer trends due to the bottom 
    21    !!                  boundary layer (advective and/or diffusive) 
     20   !!    trc_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 
    2221   !!---------------------------------------------------------------------- 
    2322   USE oce_trc             ! ocean dynamics and active tracers variables 
    2423   USE trc                 ! ocean passive tracers variables 
    25    USE trctrp_lec          ! passive tracers transport 
     24   USE trcnam_trp      ! passive tracers transport namelist variables 
     25   USE trabbl              !  
    2626   USE prtctl_trc          ! Print control for debbuging 
    27    USE eosbn2 
    28    USE lbclnk 
    29    USE trdmld_trc 
    30    USE trdmld_trc_oce      
     27   USE trdmod_oce 
     28   USE trdtra 
    3129 
    32    IMPLICIT NONE 
    33    PRIVATE 
     30   PUBLIC   trc_bbl       !  routine called by step.F90 
    3431 
    35    PUBLIC trc_bbl_dif    ! routine called by step.F90 
    36    PUBLIC trc_bbl_adv    ! routine called by step.F90 
    37  
    38 # if defined key_trcbbl_dif 
    39    LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .TRUE.   !: diffusive bottom boundary layer flag 
    40 # else 
    41    LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .FALSE.  !: diffusive bottom boundary layer flag 
    42 # endif 
    43  
    44 # if defined key_trcbbl_adv 
    45    LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .TRUE.   !: advective bottom boundary layer flag 
    46    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_trc_bbl  !: veloc. involved in the advective BBL 
    47    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   v_trc_bbl  !: veloc. involved in the advective BBL 
    48    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   w_trc_bbl  !: vertic. increment of veloc. due to adv. BBL 
    49    !                                                        !  only affect tracer vertical advection 
    50 # else 
    51    LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .FALSE.  !: advective bottom boundary layer flag 
    52 # endif 
    53  
    54    INTEGER, DIMENSION(jpi,jpj) ::   mbkt, mbku, mbkv 
    5532 
    5633   !! * Substitutions 
    5734#  include "top_substitute.h90" 
    5835   !!---------------------------------------------------------------------- 
    59    !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    60    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcbbl.F90,v 1.12 2006/09/12 11:10:13 opalod Exp $  
    61    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     37   !! $Id$  
     38   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6239   !!---------------------------------------------------------------------- 
    6340 
    6441CONTAINS 
    6542 
    66    SUBROUTINE trc_bbl_dif( kt ) 
     43 
     44   SUBROUTINE trc_bbl( kt ) 
    6745      !!---------------------------------------------------------------------- 
    68       !!                   ***  ROUTINE trc_bbl_dif  *** 
     46      !!                  ***  ROUTINE bbl  *** 
     47      !!                    
     48      !! ** Purpose :   Compute the before tracer (t & s) trend associated  
     49      !!     with the bottom boundary layer and add it to the general trend 
     50      !!     of tracer equations. 
    6951      !! 
    70       !! ** Purpose :   Compute the before tracer trend associated  
    71       !!      with the bottom boundary layer and add it to the general trend  
    72       !!      of tracer equations. The bottom boundary layer is supposed to be 
    73       !!      a purely diffusive bottom boundary layer. 
    74       !! 
    75       !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad  
    76       !!      is an along bottom slope gradient) an additional lateral diffu- 
    77       !!      sive trend along the bottom slope is added to the general tracer 
    78       !!      trend, otherwise nothing is done. 
    79       !!      Second order operator (laplacian type) with variable coefficient 
    80       !!      computed as follow for temperature (idem on s):  
    81       !!         difft = 1/(e1t*e2t*e3t) { di-1[ ahbt e2u*e3u/e1u di[ztb] ] 
    82       !!                                 + dj-1[ ahbt e1v*e3v/e2v dj[ztb] ] } 
    83       !!      where ztb is a 2D array: the bottom ocean temperature and ahtb 
    84       !!      is a time and space varying diffusive coefficient defined by: 
    85       !!         ahbt = zahbp    if grad(rho).grad(h) < 0 
    86       !!              = 0.       otherwise. 
    87       !!      Note that grad(.) is the along bottom slope gradient. grad(rho) 
    88       !!      is evaluated using the local density (i.e. referenced at the 
    89       !!      local depth). Typical value of ahbt is 2000 m2/s (equivalent to 
    90       !!      a downslope velocity of 20 cm/s if the condition for slope 
    91       !!      convection is satified) 
    92       !!      Add this before trend to the general trend tra of the  
    93       !!      botton ocean tracer point: 
    94       !!         tra = tra + difft 
    95       !! 
    96       !! ** Action  : - update tra at the bottom level with the bottom 
    97       !!                boundary layer trend 
    98       !! 
    99       !! References : 
    100       !!     Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    101       !!---------------------------------------------------------------------- 
    102       USE oce, ONLY :   ztrtrd => ua                      ! use ua as 3D workspace    
    103       !! 
    104       INTEGER, INTENT( in ) ::   kt                         ! ocean time-step 
    105       INTEGER ::   ji, jj, jn                               ! dummy loop indices 
    106       INTEGER ::   ik, iku, ikv 
    107       INTEGER ::   ii0, ii1, ij0, ij1                       ! temporary integers 
    108       INTEGER ::   iku1, iku2, ikv1, ikv2                   ! temporary intergers 
    109       REAL(wp) ::  ze3u, ze3v                              ! temporary scalars 
    110       REAL(wp) ::  zbtr, ztra 
    111 #if ! defined key_off_tra 
    112       REAL(wp) ::   zgdrho, zalbet, zsign, zt, zs, zh 
    113       REAL(wp), DIMENSION(jpi,jpj) ::   zki, zkj 
    114 #endif 
    115       REAL(wp), DIMENSION(jpi,jpj) ::   zkx, zky  ! temporary workspace arrays 
    116       REAL(wp), DIMENSION(jpi,jpj) ::   ztnb, zsnb, zdep 
    117       REAL(wp), DIMENSION(jpi,jpj) ::   ztrb, zahu, zahv 
    118  
     52      !!----------------------------------------------------------------------   
     53      INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
    11954      CHARACTER (len=22) :: charout 
    120       REAL(wp) ::   fsalbt, pft, pfs, pfh                   ! statement function 
    121       !!---------------------------------------------------------------------- 
    122       ! ratio alpha/beta 
    123       ! ================ 
    124       !  fsalbt: ratio of thermal over saline expension coefficients 
    125       !       pft :  potential temperature in degrees celcius 
    126       !       pfs :  salinity anomaly (s-35) in psu 
    127       !       pfh :  depth in meters 
    128  
    129       fsalbt( pft, pfs, pfh ) =                                              & 
    130          ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    & 
    131                                    - 0.203814e-03 ) * pft                    & 
    132                                    + 0.170907e-01 ) * pft                    & 
    133                                    + 0.665157e-01                            & 
    134          +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   & 
    135          +  ( ( - 0.302285e-13 * pfh                                         & 
    136                 - 0.251520e-11 * pfs                                         & 
    137                 + 0.512857e-12 * pft * pft          ) * pfh                  & 
    138                                      - 0.164759e-06   * pfs                  & 
    139              +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  & 
    140                                      + 0.380374e-04 ) * pfh    
     55      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd 
    14156      !!---------------------------------------------------------------------- 
    14257 
    143  
    144       IF( kt == nittrc000 )   CALL trc_bbl_init 
    145  
    146  
    147       ! 0. 2D fields of bottom temperature and salinity, and bottom slope 
    148       ! ----------------------------------------------------------------- 
    149       ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 
    150  
    151 #  if defined key_vectopt_loop 
    152       jj = 1 
    153       DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    154 #  else 
    155       DO jj = 1, jpj 
    156          DO ji = 1, jpi 
    157 #  endif 
    158             ik = mbkt(ji,jj)                              ! index of the bottom ocean T-level 
    159             ztnb(ji,jj) = tn(ji,jj,ik) * tmask(ji,jj,1)   ! masked now T and S at ocean bottom  
    160             zsnb(ji,jj) = sn(ji,jj,ik) * tmask(ji,jj,1) 
    161             zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level 
    162 #  if ! defined key_vectopt_loop 
    163          END DO 
    164 #  endif 
    165       END DO 
    166  
    167       IF( ln_zps ) THEN      ! partial steps correction 
    168  
    169 #   if defined key_vectopt_loop 
    170          jj = 1 
    171          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    172 #   else 
    173          DO jj = 1, jpjm1 
    174             DO ji = 1, jpim1 
    175 #   endif 
    176                iku1 = MAX( mbathy(ji+1,jj  )-1, 1 ) 
    177                iku2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
    178                ikv1 = MAX( mbathy(ji  ,jj+1)-1, 1 ) 
    179                ikv2 = MAX( mbathy(ji  ,jj  )-1, 1 ) 
    180                ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
    181                ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
    182                zahu(ji,jj) = atrcbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 
    183                zahv(ji,jj) = atrcbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 
    184 #   if ! defined key_vectopt_loop 
    185             END DO 
    186 #   endif 
    187          END DO 
    188       ELSE                  ! z-coordinate - full steps or s-coordinate 
    189 #   if defined key_vectopt_loop 
    190          jj = 1 
    191          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    192 #   else 
    193          DO jj = 1, jpjm1 
    194             DO ji = 1, jpim1 
    195 #   endif 
    196                iku = mbku(ji,jj) 
    197                ikv = mbkv(ji,jj) 
    198                zahu(ji,jj) = atrcbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 
    199                zahv(ji,jj) = atrcbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 
    200 #   if ! defined key_vectopt_loop 
    201             END DO 
    202 #   endif 
    203          END DO 
     58      IF( .NOT. lk_offline ) THEN 
     59         CALL bbl( kt, 'TRC' )         ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
     60         l_bbl = .FALSE.               ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
    20461      ENDIF 
    20562 
    206 #if defined key_off_tra 
    207       !!===================================================================== 
    208       !!                I. OFFLINE VERSION OF DIFFUSIVE BBL 
    209       !!===================================================================== 
    210        
    211       ! 1. Criteria of additional bottom diffusivity : grad(rho).grad(h) < 0 
    212       ! -------------------------------------------------------------------- 
    213        
    214       !    Only used in the online version of diffusive BBL (see below) 
    215        
    216       ! 2. Additional second order diffusive trends 
    217       ! ------------------------------------------- 
    218       !                                                          ! =========== 
    219       DO jn = 1, jptra                                           ! tracer loop 
    220          !                                                       ! ===========        
    221  
    222          IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) 
    223       
    224          ! first derivative (gradient)          
    225 #  if defined key_vectopt_loop 
    226          jj = 1 
    227          DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    228 #  else 
    229          DO jj = 1, jpj 
    230             DO ji = 1, jpi 
    231 #  endif 
    232                ik = mbkt(ji,jj)  
    233                ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1) 
    234 #  if ! defined key_vectopt_loop 
    235             END DO 
    236 #  endif 
    237          END DO 
    238  
    239 #  if defined key_vectopt_loop 
    240          jj = 1 
    241          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    242 #  else 
    243          DO jj = 1, jpjm1 
    244             DO ji = 1, jpim1 
    245 #  endif 
    246                zkx(ji,jj) = bblx(ji,jj) * zahu(ji,jj) * ( ztrb(ji+1,jj) - ztrb(ji,jj) ) 
    247                zky(ji,jj) = bbly(ji,jj) * zahv(ji,jj) * ( ztrb(ji,jj+1) - ztrb(ji,jj) ) 
    248 #  if ! defined key_vectopt_loop 
    249             END DO 
    250 #  endif 
    251          END DO 
    252  
    253 #else 
    254       !!===================================================================== 
    255       !!               II. ONLINE VERSION OF DIFFUSIVE BBL 
    256       !!===================================================================== 
    257  
    258       ! 1. Criteria of additional bottom diffusivity : grad(rho).grad(h) < 0 
    259       ! -------------------------------------------------------------------- 
    260       ! Sign of the local density gradient along the i- and j-slopes 
    261       ! multiplied by the slope of the ocean bottom 
    262       SELECT CASE ( nn_eos ) 
    263  
    264       CASE ( 0 )                 ! Jackett and McDougall (1994) formulation 
    265           
    266 #  if defined key_vectopt_loop 
    267       jj = 1 
    268       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    269 #  else 
    270       DO jj = 1, jpjm1 
    271          DO ji = 1, jpim1 
    272 #  endif 
    273             ! temperature, salinity anomalie and depth 
    274             zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
    275             zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
    276             zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    277             ! masked ratio alpha/beta 
    278             zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1) 
    279             ! local density gradient along i-bathymetric slope 
    280             zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
    281                    -          ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
    282             ! sign of local i-gradient of density multiplied by the i-slope 
    283             zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    284             zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    285 #  if ! defined key_vectopt_loop 
    286          END DO 
    287 #  endif 
    288       END DO 
    289  
    290 #  if defined key_vectopt_loop 
    291       jj = 1 
    292       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    293 #  else 
    294       DO jj = 1, jpjm1 
    295          DO ji = 1, jpim1 
    296 #  endif 
    297             ! temperature, salinity anomalie and depth 
    298             zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
    299             zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
    300             zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    301             ! masked ratio alpha/beta 
    302             zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1) 
    303             ! local density gradient along j-bathymetric slope 
    304             zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
    305                    -          ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    306             ! sign of local j-gradient of density multiplied by the j-slope 
    307             zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    308             zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    309 #  if ! defined key_vectopt_loop 
    310          END DO 
    311 #  endif 
    312       END DO 
    313        
    314       CASE ( 1 )                 ! Linear formulation function of temperature only 
    315  
    316 #  if defined key_vectopt_loop 
    317       jj = 1 
    318       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    319 #  else 
    320       DO jj = 1, jpjm1 
    321          DO ji = 1, jpim1 
    322 #  endif 
    323             ! local density gradient along i-bathymetric slope 
    324             zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 
    325             ! sign of local i-gradient of density multiplied by the i-slope 
    326             zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    327             zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    328 #  if ! defined key_vectopt_loop 
    329          END DO 
    330 #  endif 
    331       END DO 
    332  
    333 #  if defined key_vectopt_loop 
    334       jj = 1 
    335       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    336 #  else 
    337       DO jj = 1, jpjm1 
    338          DO ji = 1, jpim1 
    339 #  endif 
    340             ! local density gradient along j-bathymetric slope 
    341             zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 
    342             ! sign of local j-gradient of density multiplied by the j-slope 
    343             zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    344             zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    345  
    346 #  if ! defined key_vectopt_loop 
    347          END DO 
    348 #  endif 
    349       END DO 
    350  
    351       CASE ( 2 )                 ! Linear formulation function of temperature and salinity 
    352  
    353       DO jj = 1, jpjm1 
    354         DO ji = 1, fs_jpim1   ! vector opt. 
    355             ! local density gradient along i-bathymetric slope 
    356             zgdrho = - ( rn_beta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
    357                      -  rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
    358             ! sign of local i-gradient of density multiplied by the i-slope 
    359             zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    360        zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    361         END DO 
    362       END DO 
    363  
    364       DO jj = 1, jpjm1 
    365         DO ji = 1, fs_jpim1   ! vector opt. 
    366             ! local density gradient along j-bathymetric slope 
    367             zgdrho = - ( rn_beta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
    368                      -  rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 
    369             ! sign of local j-gradient of density multiplied by the j-slope 
    370             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    371             zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    372          END DO 
    373       END DO 
    374  
    375       CASE DEFAULT 
    376  
    377          WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos 
    378          CALL ctl_stop( ctmp1 ) 
    379  
    380       END SELECT 
    381        
    382       ! 2. Additional second order diffusive trends 
    383       ! ------------------------------------------- 
    384       !                                                          ! =========== 
    385       DO jn = 1, jptra                                           ! tracer loop 
    386          !                                                       ! =========== 
    387          IF( l_trdtrc )   ztrtrd(:,:,:) = tra(:,:,:,jn) 
    388  
    389          ! first derivative (gradient) 
    390 #  if defined key_vectopt_loop 
    391          jj = 1 
    392          DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    393 #  else 
    394          DO jj = 1, jpj 
    395             DO ji = 1, jpi 
    396 #  endif 
    397                ik = mbkt(ji,jj) 
    398                ztrb(ji,jj) = trb(ji,jj,ik,jn) * tmask(ji,jj,1) 
    399 #  if ! defined key_vectopt_loop 
    400             END DO 
    401 #  endif 
    402          END DO 
    403 #  if defined key_vectopt_loop 
    404          jj = 1 
    405          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    406 #  else 
    407          DO jj = 1, jpjm1 
    408             DO ji = 1, jpim1 
    409 #  endif 
    410                zkx(ji,jj) = zki(ji,jj) * ( ztrb(ji+1,jj) - ztrb(ji,jj) ) 
    411                zky(ji,jj) = zkj(ji,jj) * ( ztrb(ji,jj+1) - ztrb(ji,jj) ) 
    412 #  if ! defined key_vectopt_loop 
    413             END DO 
    414 #  endif 
    415          END DO 
    416 #endif 
    417  
    418       !!===================================================================== 
    419       !!     III. COMMON CODE FOR OFFLINE/ONLINE VERSIONS OF DIFFUSIVE BBL 
    420       !!===================================================================== 
    421  
    422          IF( cp_cfg == "orca" ) THEN 
    423              
    424             SELECT CASE ( jp_cfg ) 
    425                !                                        ! ======================= 
    426             CASE ( 2 )                                  !  ORCA_R2 configuration 
    427                !                                        ! ======================= 
    428                ! Gibraltar enhancement of BBL 
    429                ij0 = 102   ;   ij1 = 102 
    430                ii0 = 139   ;   ii1 = 140   
    431                zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    432                zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    433                 
    434                ! Red Sea enhancement of BBL 
    435                ij0 =  88   ;   ij1 =  88 
    436                ii0 = 161   ;   ii1 = 162 
    437                zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    438                zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 10.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    439                 
    440                !                                        ! ======================= 
    441             CASE ( 4 )                                  !  ORCA_R4 configuration 
    442                !                                        ! ======================= 
    443                ! Gibraltar enhancement of BBL 
    444                ij0 =  52   ;   ij1 =  52 
    445                ii0 =  70   ;   ii1 =  71   
    446                zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zkx( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    447                zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 4.e0 * zky( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) 
    448                 
    449             END SELECT 
    450              
    451          ENDIF 
    452           
    453          ! second derivative (divergence) and add to the general tracer trend 
    454 #  if defined key_vectopt_loop 
    455          jj = 1 
    456          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    457 #  else 
    458          DO jj = 2, jpjm1 
    459             DO ji = 2, jpim1 
    460 #  endif 
    461                ik = MAX( mbathy(ji,jj)-1, 1 ) 
    462                zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,ik) ) 
    463                ztra = (  zkx(ji,jj) - zkx(ji-1,jj  )    & 
    464                   &    + zky(ji,jj) - zky(ji  ,jj-1)  ) * zbtr 
    465                tra(ji,jj,ik,jn) = tra(ji,jj,ik,jn) + ztra 
    466 #  if ! defined key_vectopt_loop 
    467             END DO 
    468 #  endif 
    469          END DO 
    470  
    471          ! save the trends for diagnostic 
    472          IF( l_trdtrc ) THEN 
    473             ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
    474             IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_bbl, kt ) 
    475          END IF 
    476          !                                                       ! =========== 
    477       END DO                                                     ! tracer loop 
    478       !                                                          ! =========== 
    479  
    480       IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    481          WRITE(charout, FMT="('bbl - dif')") 
    482          CALL prt_ctl_trc_info(charout) 
    483          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     63      IF( l_trdtrc )  THEN 
     64         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )   ! temporary save of trends 
     65         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    48466      ENDIF 
    48567 
    486    END SUBROUTINE trc_bbl_dif 
     68      !* Diffusive bbl : 
     69      IF( nn_bbl_ldf == 1 ) THEN 
     70         ! 
     71         CALL tra_bbl_dif( trb, tra, jptra )   
     72         IF( ln_ctl )   THEN 
     73            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout) 
     74            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     75         ENDIF 
     76         ! 
     77      END IF 
    48778 
    488 # if defined key_trcbbl_adv 
    489    !!---------------------------------------------------------------------- 
    490    !!   'key_trcbbl_adv'                    advective bottom boundary layer 
    491    !!---------------------------------------------------------------------- 
    492 #  include "trcbbl_adv.h90" 
    493 # else 
    494    !!---------------------------------------------------------------------- 
    495    !!   Default option :                 NO advective bottom boundary layer 
    496    !!---------------------------------------------------------------------- 
    497    SUBROUTINE trc_bbl_adv (kt )              ! Empty routine 
    498       INTEGER, INTENT(in) :: kt 
    499       WRITE(*,*) 'trc_bbl_adv: You should not have seen this print! error?', kt 
    500    END SUBROUTINE trc_bbl_adv 
    501 # endif 
     79      !* Advective bbl : bbl upstream advective trends added to the tracer trends 
     80      IF( nn_bbl_adv /= 0 ) THEN 
     81         ! 
     82         CALL tra_bbl_adv( trb, tra, jptra )   
     83         IF( ln_ctl )   THEN 
     84            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout) 
     85            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     86         ENDIF 
     87         ! 
     88      END IF 
    50289 
    503    SUBROUTINE trc_bbl_init 
    504       !!---------------------------------------------------------------------- 
    505       !!                  ***  ROUTINE trc_bbl_init  *** 
    506       !! 
    507       !! ** Purpose :   Initialization for the bottom boundary layer scheme. 
    508       !!---------------------------------------------------------------------- 
    509       INTEGER ::   ji, jj 
    510       REAL(wp),  DIMENSION(jpi,jpj) ::   zmbk   
    511       !!---------------------------------------------------------------------- 
    512  
    513       DO jj = 1, jpj 
    514          DO ji = 1, jpi 
    515             mbkt(ji,jj) = MAX( mbathy(ji,jj) - 1, 1 )   ! vertical index of the bottom ocean T-level 
    516          END DO 
    517       END DO 
    518        
    519       DO jj = 1, jpjm1 
    520          DO ji = 1, jpim1 
    521             mbku(ji,jj) = MAX( MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) ) - 1, 1 ) 
    522             mbkv(ji,jj) = MAX( MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) ) - 1, 1 ) 
    523          END DO 
    524       END DO 
    525  
    526       zmbk(:,:) = FLOAT( mbku (:,:) )    
    527       CALL lbc_lnk(zmbk,'U',1.) 
    528       mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 )  
    529     
    530       zmbk(:,:) = FLOAT( mbkv (:,:) )    
    531       CALL lbc_lnk(zmbk,'V',1.) 
    532       mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 )  
    533  
    534 # if defined key_trcbbl_adv 
    535       w_trc_bbl(:,:,:) = 0.e0    ! initialisation of w_trc_bbl to zero 
    536 # endif 
    537  
    538    END SUBROUTINE trc_bbl_init 
     90      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     91        DO jn = 1, jptra 
     92           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
     93           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 
     94        END DO 
     95        DEALLOCATE( ztrtrd ) 
     96      ENDIF 
     97      ! 
     98   END SUBROUTINE trc_bbl 
    53999 
    540100#else 
    … …  
    542102   !!   Dummy module :                      No bottom boundary layer scheme 
    543103   !!---------------------------------------------------------------------- 
    544    LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_dif = .FALSE.   !: diff bbl flag 
    545    LOGICAL, PUBLIC, PARAMETER ::   lk_trcbbl_adv = .FALSE.   !: adv  bbl flag 
    546104CONTAINS 
    547    SUBROUTINE trc_bbl_dif (kt )              ! Empty routine 
    548       INTEGER, INTENT(in) :: kt 
    549       WRITE(*,*) 'trc_bbl_dif: You should not have seen this print! error?', kt 
    550    END SUBROUTINE trc_bbl_dif 
    551    SUBROUTINE trc_bbl_adv (kt )              ! Empty routine 
    552       INTEGER, INTENT(in) :: kt 
    553       WRITE(*,*) 'trc_bbl_adv: You should not have seen this print! error?', kt 
    554    END SUBROUTINE trc_bbl_adv 
     105   SUBROUTINE trc_bbl( kt )              ! Empty routine 
     106      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt 
     107   END SUBROUTINE trc_bbl 
    555108#endif 
    556109 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    • Property svn:executable deleted
    r1175 r2528  
    44   !! Ocean physics: internal restoring trend on passive tracers 
    55   !!====================================================================== 
    6    !! History :  7.0  !         (G. Madec)  Original code 
    7    !!                 !  96-01  (G. Madec)  
    8    !!                 !  97-05  (H. Loukos)  adapted for passive tracers 
    9    !!            8.5  !  02-08  (G. Madec )  free form + modules 
    10    !!            9.0  !  04-03  (C. Ethe)    free form + modules 
    11    !!                 !  07-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     6   !! History :  OPA  !  1991-03  (O. Marti, G. Madec)  Original code 
     7   !!                 !  1996-01  (G. Madec) statement function for e3 
     8   !!                 !  1997-05  (H. Loukos)  adapted for passive tracers 
     9   !!    NEMO    9.0  !  2004-03  (C. Ethe)    free form + modules 
     10   !!            3.2  !  2007-02  (C. Deltel)  Diagnose ML trends for passive tracers 
     11   !!            3.3  !  2010-06  (C. Ethe, G. Madec) merge TRA-TRC  
    1212   !!---------------------------------------------------------------------- 
    1313#if  defined key_top && defined key_trcdmp  
    … …  
    1717   !!   trc_dmp      : update the tracer trend with the internal damping 
    1818   !!   trc_dmp_init : initialization, namlist read, parameters control 
    19    !!   trccof_zoom  : restoring coefficient for zoom domain 
    20    !!   trccof       : restoring coefficient for global domain 
    21    !!   cofdis       : compute the distance to the coastline 
    2219   !!---------------------------------------------------------------------- 
    2320   USE oce_trc         ! ocean dynamics and tracers variables 
    2421   USE trc             ! ocean passive tracers variables 
    25    USE trctrp_lec      ! passive tracers transport 
     22   USE trcnam_trp      ! passive tracers transport namelist variables 
    2623   USE trcdta 
     24   USE tradmp 
    2725   USE prtctl_trc      ! Print control for debbuging 
    28    USE trdmld_trc 
    29    USE trdmld_trc_oce      
     26   USE trdtra 
    3027 
    3128   IMPLICIT NONE 
    … …  
    3532 
    3633   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.   !: internal damping flag 
    37    REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) ::   restotr   ! restoring coeff. on tracers (s-1) 
     34   !                             !!* Namelist namtrc_dmp : passive tracer newtonian damping * 
     35   INTEGER  ::   nn_hdmp_tr =   -1   ! = 0/-1/'latitude' for damping over passive tracer 
     36   INTEGER  ::   nn_zdmp_tr =    0   ! = 0/1/2 flag for damping in the mixed layer 
     37   REAL(wp) ::   rn_surf_tr =   50.  ! surface time scale for internal damping        [days] 
     38   REAL(wp) ::   rn_bot_tr  =  360.  ! bottom time scale for internal damping         [days] 
     39   REAL(wp) ::   rn_dep_tr  =  800.  ! depth of transition between rn_surf and rn_bot [meters] 
     40   INTEGER  ::   nn_file_tr =    2   ! = 1 create a damping.coeff NetCDF file  
     41 
     42   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   restotr   ! restoring coeff. on tracers (s-1) 
    3843 
    3944   !! * Substitutions 
    4045#  include "top_substitute.h90" 
    4146   !!---------------------------------------------------------------------- 
    42    !!   TOP 1.0 , LOCEAN-IPSL (2005)  
     47   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4348   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $  
    44    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     49   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4550   !!---------------------------------------------------------------------- 
    4651 
    … …  
    6671      !!              - save the trends ('key_trdmld_trc') 
    6772      !!---------------------------------------------------------------------- 
    68       USE oce, ONLY :   ztrtrd => ua  ! use ua as 3D workspace    
    6973      !! 
    7074      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     75      !! 
    7176      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    72       REAL(wp) ::   ztest, ztra !!!, zdt    ! temporary scalars 
     77      REAL(wp) ::   ztra                 ! temporary scalars 
    7378      CHARACTER (len=22) :: charout 
     79      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    7480      !!---------------------------------------------------------------------- 
    7581 
    7682      ! 0. Initialization (first time-step only) 
    7783      !    -------------- 
    78       IF( kt == nittrc000 ) CALL trc_dmp_init 
    79  
     84      IF( kt == nit000 ) CALL trc_dmp_init 
     85 
     86      IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) )   ! temporary save of trends 
    8087 
    8188      ! 1. Newtonian damping trends on tracer fields 
    8289      ! -------------------------------------------- 
    83       !    compute the newtonian damping trends depending on nmldmptr 
    84  
    85 !!!      zdt  = rdt * FLOAT( ndttrc ) 
    86  
    8790      ! Initialize the input fields for newtonian damping 
    88       CALL dta_trc( kt ) 
    89  
     91      CALL trc_dta( kt ) 
    9092      !                                                          ! =========== 
    9193      DO jn = 1, jptra                                           ! tracer loop 
    … …  
    9496 
    9597         IF( lutini(jn) ) THEN 
    96  
    97             SELECT CASE ( nmldmptr ) 
    98  
    99             CASE( 0 )                ! newtonian damping throughout the water column 
    100  
     98            ! 
     99            SELECT CASE ( nn_zdmp_trc ) 
     100            ! 
     101            CASE( 0 )                !==  newtonian damping throughout the water column  ==! 
    101102               DO jk = 1, jpkm1 
    102103                  DO jj = 2, jpjm1 
    103104                     DO ji = fs_2, fs_jpim1   ! vector opt. 
    104                         ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) 
    105                         ! add the trends to the general tracer trends 
    106 !!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt 
     105                        ztra = restotr(ji,jj,jk) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) 
    107106                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    108107                     END DO 
    109108                  END DO 
    110109               END DO 
    111  
    112             CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s) 
     110            ! 
     111            CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
    113112               DO jk = 1, jpkm1 
    114113                  DO jj = 2, jpjm1 
    115114                     DO ji = fs_2, fs_jpim1   ! vector opt. 
    116                         ztest = avt(ji,jj,jk) - 5.e-4 
    117                         IF( ztest < 0. ) THEN 
    118                            ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) 
    119                         ELSE 
    120                            ztra = 0.e0 
     115                        IF( avt(ji,jj,jk) <= 5.e-4 )  THEN  
     116                           ztra = restotr(ji,jj,jk) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) 
     117                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    121118                        ENDIF 
    122                         ! add the trends to the general tracer trends 
    123 !!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt 
    124                         tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra  
    125 #    if defined key_trc_diatrd 
    126                         ! save the trends for diagnostics 
    127                         IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra 
    128 #    endif 
    129  
    130119                     END DO 
    131120                  END DO 
    132121               END DO 
    133  
    134             CASE ( 2 )                ! no damping in the mixed layer  
     122            ! 
     123            CASE ( 2 )               !==  no damping in the mixed layer   ==!  
    135124               DO jk = 1, jpkm1 
    136125                  DO jj = 2, jpjm1 
    … …  
    138127                        IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    139128                           ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) ) 
    140                         ELSE 
    141                            ztra = 0.e0 
    142                         ENDIF 
    143                         ! add the trends to the general tracer trends 
    144 !!                        trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) + ztra * zdt 
    145                         tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
    146 #    if defined key_trc_diatrd 
    147                         ! save the trends for diagnostics 
    148                         IF (luttrd(jn)) trtrd(ji,jj,jk,ikeep(jn),jpdiatrc) = ztra 
    149 #    endif 
    150  
     129                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 
     130                        END IF 
    151131                     END DO 
    152132                  END DO 
    153133               END DO 
    154                 
     134            !   
    155135            END SELECT 
    156  
     136            !  
    157137         ENDIF 
    158  
     138         ! 
    159139         IF( l_trdtrc ) THEN 
    160140            ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:) 
    161             IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_dmp, kt )        ! trends diags. 
     141            CALL trd_tra( kt, 'TRC', jn, jptra_trd_dmp, ztrtrd ) 
    162142         END IF 
    163143         !                                                       ! =========== 
    164144      END DO                                                     ! tracer loop 
    165145      !                                                          ! =========== 
    166  
    167       IF( ln_ctl ) THEN    ! print mean trends (used for debugging) 
    168          WRITE(charout, FMT="('dmp')") 
    169          CALL prt_ctl_trc_info( charout ) 
    170          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd' ) 
     146      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 
     147      !                                          ! print mean trends (used for debugging) 
     148      IF( ln_ctl )   THEN 
     149         WRITE(charout, FMT="('dmp ')") ;  CALL prt_ctl_trc_info(charout) 
     150                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    171151      ENDIF 
    172    
    173       trb(:,:,:,:) = trn(:,:,:,:) 
    174     
     152      ! 
    175153   END SUBROUTINE trc_dmp 
    176154 
    … …  
    186164      !!---------------------------------------------------------------------- 
    187165 
    188       SELECT CASE ( ndmptr ) 
    189  
    190       CASE ( -1 )               ! ORCA: damping in Red & Med Seas only 
    191          IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only' 
    192  
    193       CASE ( 1:90 )             ! Damping poleward of 'ndmptr' degrees 
    194          IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmptr, ' degrees' 
    195  
     166      SELECT CASE ( nn_hdmp_tr ) 
     167      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
     168      CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp_tr, ' degrees' 
    196169      CASE DEFAULT 
    197          WRITE(ctmp1,*) '          bad flag value for ndmptr = ', ndmptr 
     170         WRITE(ctmp1,*) '          bad flag value for nn_hdmp_tr = ', nn_hdmp_tr 
    198171         CALL ctl_stop(ctmp1) 
    199  
    200172      END SELECT 
    201173 
    202  
    203       SELECT CASE ( nmldmptr ) 
    204  
    205       CASE ( 0 )                ! newtonian damping throughout the water column 
    206          IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column' 
    207  
    208       CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s) 
    209          IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline' 
    210  
    211       CASE ( 2 )                ! no damping in the mixed layer  
    212          IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer' 
    213  
     174      SELECT CASE ( nn_zdmp_tr ) 
     175      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
     176      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     177      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
    214178      CASE DEFAULT 
    215          WRITE(ctmp1,*) '          bad flag value for nmldmptr = ', nmldmptr 
     179         WRITE(ctmp1,*) 'bad flag value for nn_zdmp_tr = ', nn_zdmp_tr 
    216180         CALL ctl_stop(ctmp1) 
    217  
    218181      END SELECT 
    219182 
    220       ! Damping coefficients initialization 
    221       ! ----------------------------------- 
    222       IF( lzoom ) THEN 
    223          CALL trccof_zoom 
    224       ELSE 
    225          CALL trccof 
     183      IF( .NOT. lk_dtatrc )   & 
     184         &   CALL ctl_stop( 'no passive tracer data define key_dtatrc' ) 
     185 
     186      IF( .NOT. lk_tradmp )   & 
     187         &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' ) 
     188      ! 
     189      !                          ! Damping coefficients initialization 
     190      IF( lzoom ) THEN   ;   CALL dtacof_zoom( restotr ) 
     191      ELSE               ;   CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr,  & 
     192                             &            nn_file_tr, 'TRC'     , restotr                ) 
    226193      ENDIF 
    227   
     194      ! 
    228195   END SUBROUTINE trc_dmp_init 
    229  
    230  
    231    SUBROUTINE trccof_zoom 
    232       !!---------------------------------------------------------------------- 
    233       !!                  ***  ROUTINE trccof_zoom  *** 
    234       !! 
    235       !! ** Purpose :   Compute the damping coefficient for zoom domain 
    236       !! 
    237       !! ** Method  : - set along closed boundary due to zoom a damping over 
    238       !!      6 points with a max time scale of 5 days. 
    239       !!              - ORCA arctic/antarctic zoom: set the damping along 
    240       !!      south/north boundary over a latitude strip. 
    241       !! 
    242       !! ** Action  : - restotr, the damping coeff. passive tracers 
    243       !! 
    244       !! History : 
    245       !!   9.0  !  03-09  (G. Madec)  Original code 
    246       !!   9.0  !  04-03  (C. Ethe)   adapted for passive tracers 
    247       !!---------------------------------------------------------------------- 
    248       !! * Local declarations 
    249       INTEGER ::   ji, jj, jk, jn       ! dummy loop indices 
    250       REAL(wp) ::   & 
    251          zlat, zlat0, zlat1, zlat2     ! temporary scalar 
    252       REAL(wp), DIMENSION(6)  ::   & 
    253          zfact                         ! temporary workspace 
    254       !!---------------------------------------------------------------------- 
    255  
    256       zfact(1) =  1. 
    257       zfact(2) =  1.  
    258       zfact(3) = 11./12. 
    259       zfact(4) =  8./12. 
    260       zfact(5) =  4./12. 
    261       zfact(6) =  1./12. 
    262       zfact(:) = zfact(:) / ( 5. * rday )    ! 5 days max restoring time scale 
    263  
    264       restotr(:,:,:,:) = 0.e0 
    265  
    266       ! damping along the forced closed boundary over 6 grid-points 
    267       DO jn = 1, 6 
    268          IF( lzoom_w )   restotr( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : , : ) = zfact(jn) ! west  closed 
    269          IF( lzoom_s )   restotr( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : , : ) = zfact(jn) ! south closed  
    270          IF( lzoom_e )   restotr( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : , : ) & 
    271                        &              = zfact(jn)                                 ! east  closed  
    272          IF( lzoom_n )   restotr( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : , : ) & 
    273                        &              = zfact(jn)                                 ! north closed 
    274       END DO 
    275  
    276  
    277       IF( lzoom_arct .AND. lzoom_anta ) THEN 
    278  
    279          ! ==================================================== 
    280          !  ORCA configuration : arctic zoom or antarctic zoom 
    281          ! ==================================================== 
    282  
    283          IF(lwp) WRITE(numout,*) 
    284          IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              trccof_zoom : ORCA    Arctic zoom' 
    285          IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              trccof_zoom : ORCA Antarctic zoom' 
    286          IF(lwp) WRITE(numout,*) 
    287  
    288          ! ... Initialization :  
    289          !     zlat0 : latitude strip where resto decreases 
    290          !     zlat1 : resto = 1 before zlat1 
    291          !     zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2 
    292          restotr(:,:,:,:) = 0.e0 
    293          zlat0 = 10. 
    294          zlat1 = 30. 
    295          zlat2 = zlat1 + zlat0 
    296  
    297          ! ... Compute arrays resto ; value for internal damping : 5 days 
    298          DO jn = 1, jptra 
    299             DO jk = 2, jpkm1  
    300                DO jj = 1, jpj 
    301                   DO ji = 1, jpi 
    302                      zlat = ABS( gphit(ji,jj) ) 
    303                      IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN 
    304                         restotr(ji,jj,jk,jn) = 0.5 * ( 1./(5.*rday) ) *   & 
    305                            ( 1. - COS(rpi*(zlat2-zlat)/zlat0) )  
    306                      ELSE IF ( zlat < zlat1 ) THEN 
    307                         restotr(ji,jj,jk,jn) = 1./(5.*rday) 
    308                      ENDIF 
    309                   END DO 
    310                END DO 
    311             END DO 
    312          END DO 
    313  
    314       ENDIF 
    315  
    316       ! ... Mask resto array 
    317         DO jn = 1, jptra 
    318            restotr(:,:,:,jn) = restotr(:,:,:,jn) * tmask(:,:,:) 
    319         END DO 
    320  
    321  
    322    END SUBROUTINE trccof_zoom 
    323  
    324    SUBROUTINE trccof 
    325       !!---------------------------------------------------------------------- 
    326       !!                  ***  ROUTINE trccof  *** 
    327       !! 
    328       !! ** Purpose :   Compute the damping coefficient 
    329       !! 
    330       !! ** Method  :   Arrays defining the damping are computed for each grid 
    331       !!      point passive tracers (restotr) 
    332       !!      Damping depends on distance to coast, depth and latitude 
    333       !! 
    334       !! ** Action  : - restotr, the damping coeff. for passive tracers 
    335       !! 
    336       !! History : 
    337       !!   5.0  !  91-03  (O. Marti, G. Madec)  Original code 
    338       !!        !  92-06  (M. Imbard)  doctor norme 
    339       !!        !  96-01  (G. Madec) statement function for e3 
    340       !!        !  98-07  (M. Imbard, G. Madec) ORCA version 
    341       !!        !  00-08  (G. Madec, D. Ludicone)  
    342       !!   8.2  !  04-03  (H. Loukos) adapted for passive tracers 
    343       !!        !  04-02  (O. Aumont, C. Ethe) rewritten for debuging and update 
    344       !!---------------------------------------------------------------------- 
    345       !! * Modules used 
    346       USE iom 
    347       USE ioipsl 
    348  
    349       !! * Local declarations 
    350       INTEGER ::  ji, jj, jk, jn    ! dummy loop indices 
    351       INTEGER ::   itime 
    352       INTEGER ::  ii0, ii1, ij0, ij1  !    "          " 
    353       INTEGER ::   & 
    354          idmp,     &  ! logical unit for file restoring damping term 
    355          icot         ! logical unit for file distance to the coast 
    356  
    357       CHARACTER (len=32) ::   clname3 
    358       REAL(wp) ::   & 
    359          zdate0, zinfl, zlon,         & ! temporary scalars 
    360          zlat, zlat0, zlat1, zlat2,   & !    "         " 
    361          zsdmp, zbdmp                   !    "         " 
    362       REAL(wp), DIMENSION(jpk) ::   & 
    363          gdept, zhfac 
    364       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    365          zmrs 
    366       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    367          zdct 
    368       !!---------------------------------------------------------------------- 
    369  
    370       ! ==================================== 
    371       !  ORCA configuration : global domain 
    372       ! ==================================== 
    373  
    374       IF(lwp) WRITE(numout,*) 
    375       IF(lwp) WRITE(numout,*) '              trccof : Global domain of ORCA' 
    376       IF(lwp) WRITE(numout,*) '              ------------------------------' 
    377  
    378  
    379       ! ... Initialization :  
    380       !   zdct()      : distant to the coastline 
    381       !   resto()     : array of restoring coeff.  
    382        
    383       zdct (:,:,:) = 0.e0 
    384       restotr(:,:,:,:) = 0.e0 
    385  
    386  
    387       IF ( ndmptr > 0 ) THEN 
    388  
    389          !    ------------------------------------ 
    390          !     Damping poleward of 'ndmptr' degrees 
    391          !    ------------------------------------ 
    392  
    393          IF(lwp) WRITE(numout,*) 
    394          IF(lwp) WRITE(numout,*) '              Damping poleward of ', ndmptr,' deg.' 
    395          IF(lwp) WRITE(numout,*) 
    396  
    397          ! ... Distance to coast (zdct) 
    398  
    399          IF(lwp) WRITE(numout,*) 
    400          IF(lwp) WRITE(numout,*) ' dtacof : distance to coast file' 
    401          CALL iom_open ( 'dist.coast.trc.nc', icot ) 
    402          IF( icot > 0 ) THEN 
    403             CALL iom_get ( icot, jpdom_data, 'Tcoast', zdct ) 
    404             CALL iom_close (icot) 
    405          ELSE 
    406             !   ... Compute and save the distance-to-coast array (output in zdct) 
    407             CALL cofdis( zdct ) 
    408          ENDIF 
    409  
    410  
    411          ! ... Compute arrays resto  
    412          !      zinfl : distance of influence for damping term 
    413          !      zlat0 : latitude strip where resto decreases 
    414          !      zlat1 : resto = 0 between -zlat1 and zlat1 
    415          !      zlat2 : resto increases from 0 to 1 between |zlat1| and |zlat2| 
    416          !          and resto = 1 between |zlat2| and 90 deg. 
    417          zinfl = 1000.e3 
    418          zlat0 = 10 
    419          zlat1 = ndmptr 
    420          zlat2 = zlat1 + zlat0 
    421  
    422          DO jn = 1, jptra 
    423             DO jj = 1, jpj 
    424                DO ji = 1, jpi 
    425                   zlat = ABS( gphit(ji,jj) ) 
    426                   IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN 
    427                      restotr(ji,jj,1,jn) = 0.5 * ( 1. - COS(rpi*(zlat-zlat1)/zlat0 ) ) 
    428                   ELSEIF ( zlat > zlat2 ) THEN 
    429                      restotr(ji,jj,1,jn) = 1. 
    430                   ENDIF 
    431                END DO 
    432             END DO 
    433          END DO 
    434  
    435          !   ... North Indian ocean (20N/30N x 45E/100E) : resto=0 
    436          IF ( ndmptr == 20 ) THEN 
    437             DO jn = 1, jptra 
    438                DO jj = 1, jpj 
    439                   DO ji = 1, jpi 
    440                      zlat = gphit(ji,jj) 
    441                      zlon = MOD( glamt(ji,jj), 360. ) 
    442                      IF ( zlat1 < zlat .AND. zlat < zlat2 .AND.   & 
    443                         45.  < zlon .AND. zlon < 100. ) THEN 
    444                         restotr(ji,jj,1,jn) = 0. 
    445                      ENDIF 
    446                   END DO 
    447                END DO 
    448             END DO 
    449          ENDIF 
    450  
    451          zsdmp = 1./(sdmptr * rday) 
    452          zbdmp = 1./(bdmptr * rday) 
    453          DO jn = 1, jptra 
    454             DO jk = 2, jpkm1 
    455                DO jj = 1, jpj 
    456                   DO ji = 1, jpi 
    457                      zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) ) 
    458  
    459                      !   ... Decrease the value in the vicinity of the coast 
    460                      restotr(ji,jj,jk,jn) = restotr(ji,jj,1,jn)*0.5   & 
    461                         &                 * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) ) 
    462  
    463                      !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom) 
    464                      restotr(ji,jj,jk,jn) = restotr(ji,jj,jk,jn)   & 
    465                         &                 * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/hdmptr) ) 
    466                   END DO 
    467                END DO 
    468             END DO 
    469          END DO 
    470  
    471       ENDIF 
    472  
    473  
    474       IF( cp_cfg == "orca" .AND. ( ndmptr > 0 .OR. ndmptr == -1 ) ) THEN 
    475  
    476          !                                         ! ========================= 
    477          !                                         !  Med and Red Sea damping 
    478          !                                         ! ========================= 
    479          IF(lwp)WRITE(numout,*) 
    480          IF(lwp)WRITE(numout,*) '              ORCA configuration: Damping in Med and Red Seas' 
    481  
    482  
    483          zmrs(:,:) = 0.e0                             ! damping term on the Med or Red Sea 
    484  
    485          SELECT CASE ( jp_cfg ) 
    486             !                                           ! ======================= 
    487          CASE ( 4 )                                     !  ORCA_R4 configuration  
    488             !                                           ! ======================= 
    489  
    490             ! Mediterranean Sea 
    491             ij0 =  50   ;   ij1 =  56 
    492             ii0 =  81   ;   ii1 =  91   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    493             ij0 =  50   ;   ij1 =  55 
    494             ii0 =  75   ;   ii1 =  80   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    495             ij0 =  52   ;   ij1 =  53 
    496             ii0 =  70   ;   ii1 =  74   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    497             ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea 
    498             DO jk = 1, 17 
    499                zhfac (jk) = 0.5*( 1.- COS( rpi*(jk-1)/16. ) ) / rday 
    500             END DO 
    501             DO jk = 18, jpkm1 
    502                zhfac (jk) = 1./rday 
    503             END DO 
    504  
    505             !                                        ! ======================= 
    506          CASE ( 2 )                                  !  ORCA_R2 configuration  
    507             !                                        ! ======================= 
    508  
    509             ! Mediterranean Sea 
    510             ij0 =  96   ;   ij1 = 110 
    511             ii0 = 157   ;   ii1 = 181   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    512             ij0 = 100   ;   ij1 = 110 
    513             ii0 = 144   ;   ii1 = 156   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    514             ij0 = 100   ;   ij1 = 103 
    515             ii0 = 139   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    516             ! Decrease before Gibraltar Strait 
    517             ij0 = 101   ;   ij1 = 102 
    518             ii0 = 139   ;   ii1 = 141   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0 
    519             ii0 = 142   ;   ii1 = 142   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0 
    520             ii0 = 143   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0 
    521             ii0 = 144   ;   ii1 = 144   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75e0 
    522             ! Red Sea 
    523             ij0 =  87   ;   ij1 =  96 
    524             ii0 = 147   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    525             ! Decrease before Bab el Mandeb Strait 
    526             ij0 =  91   ;   ij1 =  91 
    527             ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80e0 
    528             ij0 =  90   ;   ij1 =  90 
    529             ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40e0 
    530             ij0 =  89   ;   ij1 =  89 
    531             ii0 = 158   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0 
    532             ij0 =  88   ;   ij1 =  88 
    533             ii0 = 160   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.e0 
    534             ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea 
    535             DO jk = 1, 17 
    536                zhfac (jk) = 0.5*( 1.- COS( rpi*(jk-1)/16. ) ) / rday 
    537             END DO 
    538             DO jk = 18, jpkm1 
    539                zhfac (jk) = 1./rday 
    540             END DO 
    541  
    542             !                                        ! ======================= 
    543          CASE ( 05 )                                 !  ORCA_R05 configuration 
    544             !                                        ! ======================= 
    545  
    546             ! Mediterranean Sea 
    547             ii0 = 568   ;   ii1 = 574  
    548             ij0 = 324   ;   ij1 = 333   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    549             ii0 = 575   ;   ii1 = 658 
    550             ij0 = 314   ;   ij1 = 366   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    551             ! Black Sea (remaining part 
    552             ii0 = 641   ;   ii1 = 651 
    553             ij0 = 367   ;   ij1 = 372   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    554             ! Decrease before Gibraltar Strait 
    555             ii0 = 324   ;   ii1 = 333 
    556             ij0 = 565   ;   ij1 = 565   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 / 90.e0 
    557             ij0 = 566   ;   ij1 = 566   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40 
    558             ij0 = 567   ;   ij1 = 567   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75 
    559             ! Red Sea 
    560             ii0 = 641   ;   ii1 = 665 
    561             ij0 = 270   ;   ij1 = 310   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1.e0 
    562             ! Decrease before Bab el Mandeb Strait 
    563             ii0 = 666   ;   ii1 = 675 
    564             ij0 = 270   ;   ij1 = 290    
    565             DO ji = mi0(ii0), mi1(ii1) 
    566                zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1 * ABS( FLOAT(ji - mi1(ii1)) ) 
    567             END DO 
    568             zsdmp = 1./(sdmptr * rday) 
    569             zbdmp = 1./(bdmptr * rday) 
    570             DO jk = 1, jpk 
    571                zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/hdmptr) ) 
    572             END DO 
    573  
    574             !                                       ! ======================== 
    575          CASE ( 025 )                               !  ORCA_R025 configuration  
    576  
    577             CALL ctl_stop( ' Not yet implemented in ORCA_R025' )  
    578  
    579          END SELECT 
    580  
    581          DO jn = 1, jptra 
    582             DO jk = 1, jpkm1 
    583                restotr(:,:,jk,jn) = zmrs(:,:) * zhfac(jk) + ( 1. - zmrs(:,:) ) * restotr(:,:,jk,jn) 
    584             END DO 
    585  
    586             ! Mask resto array and set to 0 first and last levels 
    587             restotr(:,:, : ,jn) = restotr(:,:,:,jn) * tmask(:,:,:) 
    588             restotr(:,:, 1 ,jn) = 0.e0 
    589             restotr(:,:,jpk,jn) = 0.e0 
    590          END DO 
    591  
    592       ELSE 
    593          !    ------------ 
    594          !     No damping 
    595          !    ------------ 
    596          CALL ctl_stop( 'Choose a correct value of ndmp or DO NOT defined key_tradmp' ) 
    597  
    598       ENDIF 
    599  
    600         !    ---------------------------- 
    601          !     Create Print damping array 
    602          !    ---------------------------- 
    603           
    604          ! ndmpftr   : = 1 create a damping.coeff NetCDF file 
    605  
    606       IF( ndmpftr == 1 ) THEN 
    607          DO jn = 1, jptra 
    608             IF(lwp) WRITE(numout,*) '  create damping.coeff.nc file  ',jn 
    609             itime   = 0 
    610             clname3 = 'damping.coeff'//ctrcnm(jn) 
    611             CALL ymds2ju( 0     , 1     , 1      , 0.e0 , zdate0 ) 
    612             CALL restini( 'NONE', jpi   , jpj    , glamt, gphit,    & 
    613            &              jpk   , gdept , clname3, itime, zdate0,   & 
    614            &              rdt   , idmp  , domain_id=nidom) 
    615             CALL restput( idmp, 'Resto', jpi, jpj, jpk, 0 , restotr(:,:,:,jn)  ) 
    616             CALL restclo( idmp ) 
    617          END DO 
    618       ENDIF 
    619  
    620  
    621    END SUBROUTINE trccof 
    622  
    623  
    624    SUBROUTINE cofdis ( pdct ) 
    625       !!---------------------------------------------------------------------- 
    626       !!                 ***  ROUTINE cofdis  *** 
    627       !! 
    628       !! ** Purpose :   Compute the distance between ocean T-points and the 
    629       !!      ocean model coastlines. Save the distance in a NetCDF file. 
    630       !! 
    631       !! ** Method  :   For each model level, the distance-to-coast is  
    632       !!      computed as follows :  
    633       !!       - The coastline is defined as the serie of U-,V-,F-points 
    634       !!      that are at the ocean-land bound. 
    635       !!       - For each ocean T-point, the distance-to-coast is then  
    636       !!      computed as the smallest distance (on the sphere) between the  
    637       !!      T-point and all the coastline points. 
    638       !!       - For land T-points, the distance-to-coast is set to zero. 
    639       !!      C A U T I O N : Computation not yet implemented in mpp case. 
    640       !! 
    641       !! ** Action  : - pdct, distance to the coastline (argument) 
    642       !!              - NetCDF file 'trc.dist.coast.nc'  
    643       !!         
    644       !! History : 
    645       !!   7.0  !  01-02  (M. Imbard)  Original code 
    646       !!   8.1  !  01-02  (G. Madec, E. Durand) 
    647       !!   8.5  !  02-08  (G. Madec, E. Durand)  Free form, F90 
    648       !!---------------------------------------------------------------------- 
    649       !! * Modules used 
    650       USE ioipsl 
    651  
    652       !! * Arguments 
    653       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    654          pdct                     ! distance to the coastline 
    655  
    656       !! * local declarations 
    657       INTEGER :: ji, jj, jk, jl      ! dummy loop indices 
    658       INTEGER :: iju, ijt            ! temporary integers 
    659       INTEGER :: icoast, itime 
    660       INTEGER ::   & 
    661          icot         ! logical unit for file distance to the coast 
    662       LOGICAL, DIMENSION(jpi,jpj) ::   & 
    663          llcotu, llcotv, llcotf   ! ??? 
    664       CHARACTER (len=32) ::   clname 
    665       REAL(wp) ::   zdate0 
    666       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    667          zxt, zyt, zzt,                 &  ! cartesian coordinates for T-points 
    668          zmask                              
    669       REAL(wp), DIMENSION(3*jpi*jpj) ::   & 
    670          zxc, zyc, zzc, zdis      ! temporary workspace 
    671       !!---------------------------------------------------------------------- 
    672  
    673       ! 0. Initialization 
    674       ! ----------------- 
    675       IF(lwp) WRITE(numout,*) 
    676       IF(lwp) WRITE(numout,*) 'cofdis : compute the distance to coastline' 
    677       IF(lwp) WRITE(numout,*) '~~~~~~' 
    678       IF(lwp) WRITE(numout,*) 
    679       IF( lk_mpp ) & 
    680            & CALL ctl_stop('         Computation not yet implemented with key_mpp_...', & 
    681            &               '         Rerun the code on another computer or ', & 
    682            &               '         create the "dist.coast.nc" file using IDL' ) 
    683  
    684  
    685       pdct(:,:,:) = 0.e0 
    686       zxt(:,:) = cos( rad * gphit(:,:) ) * cos( rad * glamt(:,:) ) 
    687       zyt(:,:) = cos( rad * gphit(:,:) ) * sin( rad * glamt(:,:) ) 
    688       zzt(:,:) = sin( rad * gphit(:,:) ) 
    689  
    690  
    691       ! 1. Loop on vertical levels 
    692       ! -------------------------- 
    693       !                                                ! =============== 
    694       DO jk = 1, jpkm1                                 ! Horizontal slab 
    695          !                                             ! =============== 
    696          ! Define the coastline points (U, V and F) 
    697          DO jj = 2, jpjm1 
    698             DO ji = 2, jpim1 
    699                zmask(ji,jj) =  ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 
    700                    &           + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) ) 
    701                llcotu(ji,jj) = ( tmask(ji,jj,  jk) + tmask(ji+1,jj  ,jk) == 1. )  
    702                llcotv(ji,jj) = ( tmask(ji,jj  ,jk) + tmask(ji  ,jj+1,jk) == 1. )  
    703                llcotf(ji,jj) = ( zmask(ji,jj) > 0. ) .AND. ( zmask(ji,jj) < 4. ) 
    704             END DO 
    705          END DO 
    706  
    707          ! Lateral boundaries conditions 
    708          llcotu(:, 1 ) = umask(:,  2  ,jk) == 1 
    709          llcotu(:,jpj) = umask(:,jpjm1,jk) == 1 
    710          llcotv(:, 1 ) = vmask(:,  2  ,jk) == 1 
    711          llcotv(:,jpj) = vmask(:,jpjm1,jk) == 1 
    712          llcotf(:, 1 ) = fmask(:,  2  ,jk) == 1 
    713          llcotf(:,jpj) = fmask(:,jpjm1,jk) == 1 
    714  
    715          IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 
    716             llcotu( 1 ,:) = llcotu(jpim1,:) 
    717             llcotu(jpi,:) = llcotu(  2  ,:) 
    718             llcotv( 1 ,:) = llcotv(jpim1,:) 
    719             llcotv(jpi,:) = llcotv(  2  ,:) 
    720             llcotf( 1 ,:) = llcotf(jpim1,:) 
    721             llcotf(jpi,:) = llcotf(  2  ,:) 
    722          ELSE 
    723             llcotu( 1 ,:) = umask(  2  ,:,jk) == 1 
    724             llcotu(jpi,:) = umask(jpim1,:,jk) == 1 
    725             llcotv( 1 ,:) = vmask(  2  ,:,jk) == 1 
    726             llcotv(jpi,:) = vmask(jpim1,:,jk) == 1 
    727             llcotf( 1 ,:) = fmask(  2  ,:,jk) == 1 
    728             llcotf(jpi,:) = fmask(jpim1,:,jk) == 1 
    729          ENDIF 
    730          IF( nperio == 3 .OR. nperio == 4 ) THEN 
    731             DO ji = 1, jpim1 
    732                iju = jpi - ji + 1 
    733                llcotu(ji,jpj  ) = llcotu(iju,jpj-2) 
    734                llcotf(ji,jpj-1) = llcotf(iju,jpj-2) 
    735                llcotf(ji,jpj  ) = llcotf(iju,jpj-3) 
    736             END DO 
    737             DO ji = jpi/2, jpi-1 
    738                iju = jpi - ji + 1 
    739                llcotu(ji,jpjm1) = llcotu(iju,jpjm1) 
    740             END DO 
    741             DO ji = 2, jpi 
    742                ijt = jpi - ji + 2 
    743                llcotv(ji,jpj-1) = llcotv(ijt,jpj-2) 
    744                llcotv(ji,jpj  ) = llcotv(ijt,jpj-3) 
    745             END DO 
    746          ENDIF 
    747          IF( nperio == 5 .OR. nperio == 6 ) THEN 
    748             DO ji = 1, jpim1 
    749                iju = jpi - ji 
    750                llcotu(ji,jpj  ) = llcotu(iju,jpj-1) 
    751                llcotf(ji,jpj  ) = llcotf(iju,jpj-2) 
    752             END DO 
    753             DO ji = jpi/2, jpi-1 
    754                iju = jpi - ji 
    755                llcotf(ji,jpjm1) = llcotf(iju,jpjm1) 
    756             END DO 
    757             DO ji = 1, jpi 
    758                ijt = jpi - ji + 1 
    759                llcotv(ji,jpj  ) = llcotv(ijt,jpj-1) 
    760             END DO 
    761             DO ji = jpi/2+1, jpi 
    762                ijt = jpi - ji + 1 
    763                llcotv(ji,jpjm1) = llcotv(ijt,jpjm1) 
    764             END DO 
    765          ENDIF 
    766  
    767          ! Compute cartesian coordinates of coastline points 
    768          ! and the number of coastline points 
    769  
    770          icoast = 0 
    771          DO jj = 1, jpj 
    772             DO ji = 1, jpi 
    773                IF( llcotf(ji,jj) ) THEN 
    774                   icoast = icoast + 1 
    775                   zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) ) 
    776                   zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) ) 
    777                   zzc(icoast) = SIN( rad*gphif(ji,jj) ) 
    778                ENDIF 
    779                IF( llcotu(ji,jj) ) THEN 
    780                   icoast = icoast+1 
    781                   zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) ) 
    782                   zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) ) 
    783                   zzc(icoast) = SIN( rad*gphiu(ji,jj) ) 
    784                ENDIF 
    785                IF( llcotv(ji,jj) ) THEN 
    786                   icoast = icoast+1 
    787                   zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) ) 
    788                   zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) ) 
    789                   zzc(icoast) = SIN( rad*gphiv(ji,jj) ) 
    790                ENDIF 
    791             END DO 
    792          END DO 
    793  
    794          ! Distance for the T-points 
    795  
    796          DO jj = 1, jpj 
    797             DO ji = 1, jpi 
    798                IF( tmask(ji,jj,jk) == 0. ) THEN 
    799                   pdct(ji,jj,jk) = 0. 
    800                ELSE 
    801                   DO jl = 1, icoast 
    802                      zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   & 
    803                               + ( zyt(ji,jj) - zyc(jl) )**2   & 
    804                               + ( zzt(ji,jj) - zzc(jl) )**2 
    805                   END DO 
    806                   pdct(ji,jj,jk) = ra * SQRT( MINVAL( zdis(1:icoast) ) ) 
    807                ENDIF 
    808             END DO 
    809          END DO 
    810          !                                                ! =============== 
    811       END DO                                              !   End of slab 
    812       !                                                   ! =============== 
    813  
    814  
    815       ! 2. Create the  distance to the coast file in NetCDF format 
    816       ! ----------------------------------------------------------     
    817       clname = 'trc.dist.coast' 
    818       itime = 0 
    819       CALL ymds2ju( 0     , 1     , 1     , 0.e0 , zdate0 ) 
    820       CALL restini( 'NONE', jpi   , jpj   , glamt, gphit ,   & 
    821                     jpk   , gdept , clname, itime, zdate0,   & 
    822                     rdt   , icot , domain_id=nidom         ) 
    823       CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct ) 
    824       CALL restclo( icot ) 
    825  
    826    END SUBROUTINE cofdis 
    827  
    828196#else 
    829197   !!---------------------------------------------------------------------- 
    … …  
    837205   END SUBROUTINE trc_dmp 
    838206#endif 
    839  
    840207   !!====================================================================== 
    841208END MODULE trcdmp 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    • Property svn:executable deleted
    r1271 r2528  
    55   !!====================================================================== 
    66   !!====================================================================== 
    7    !! History :  7.0  !  91-11  (G. Madec)  Original code 
    8    !!                 !  93-03  (M. Guyon)  symetrical conditions 
    9    !!                 !  95-02  (M. Levy)   passive tracers 
    10    !!                 !  96-02  (G. Madec & M. Imbard)  opa release 8.0 
    11    !!            8.0  !  96-04  (A. Weaver)  Euler forward step 
    12    !!            8.2  !  99-02  (G. Madec, N. Grima)  semi-implicit pressure grad. 
    13    !!            8.5  !  02-08  (G. Madec)  F90: Free form and module 
    14    !!                 !  02-11  (C. Talandier, A-M Treguier) Open boundaries 
    15    !!            9.0  !  04-03  (C. Ethe) passive tracers 
    16    !!                 !  07-02  (C. Deltel) Diagnose ML trends for passive tracers 
     7   !! History :  7.0  !  1991-11  (G. Madec)  Original code 
     8   !!                 !  1993-03  (M. Guyon)  symetrical conditions 
     9   !!                 !  1995-02  (M. Levy)   passive tracers 
     10   !!                 !  1996-02  (G. Madec & M. Imbard)  opa release 8.0 
     11   !!            8.0  !  1996-04  (A. Weaver)  Euler forward step 
     12   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad. 
     13   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module 
     14   !!                 !  2002-08  (G. Madec)  F90: Free form and module 
     15   !!                 !  2002-11  (C. Talandier, A-M Treguier) Open boundaries 
     16   !!                 !  2004-03  (C. Ethe) passive tracers 
     17   !!                 !  2007-02  (C. Deltel) Diagnose ML trends for passive tracers 
     18   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation 
     19   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf 
     20   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option 
     21   !!            3.3  !  2010-06  (C. Ethe, G. Madec) Merge TRA-TRC 
    1722   !!---------------------------------------------------------------------- 
    1823#if defined key_top 
    … …  
    2429   !! * Modules used 
    2530   USE oce_trc         ! ocean dynamics and tracers variables 
    26    USE trp_trc             ! ocean passive tracers variables 
     31   USE trc             ! ocean passive tracers variables 
    2732   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    28    USE trctrp_lec      ! pasive tracers transport 
    2933   USE prtctl_trc      ! Print control for debbuging 
    30    USE trdmld_trc 
    31    USE trdmld_trc_oce 
     34   USE trdmod_oce 
     35   USE trdtra 
     36   USE tranxt 
     37# if defined key_agrif 
    3238   USE agrif_top_update 
    3339   USE agrif_top_interp 
     40# endif 
    3441 
    3542   IMPLICIT NONE 
    … …  
    3845   !! * Routine accessibility 
    3946   PUBLIC trc_nxt          ! routine called by step.F90 
     47 
     48  REAL(wp), DIMENSION(jpk) ::   r2dt 
    4049   !!---------------------------------------------------------------------- 
    41    !!   TOP 1.0 , LOCEAN-IPSL (2005)  
     50   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4251   !! $Id$  
    43    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     52   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4453   !!---------------------------------------------------------------------- 
    4554 
    … …  
    7079      !! ** Action  : - update trb, trn 
    7180      !!---------------------------------------------------------------------- 
    72       USE oce, ONLY :   ztrtrd => ua    ! use ua as 3D workspace  
    7381      !! * Arguments 
    7482      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    7583      !! * Local declarations 
    76       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     84      INTEGER  ::   jk, jn   ! dummy loop indices 
    7785      REAL(wp) ::   zfact            ! temporary scalar 
    7886      CHARACTER (len=22) :: charout 
     87      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdt  
    7988      !!---------------------------------------------------------------------- 
    8089 
    81       IF( kt == nittrc000 .AND. lwp ) THEN 
     90      IF( kt == nit000 .AND. lwp ) THEN 
    8291         WRITE(numout,*) 
    8392         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 
    8493      ENDIF 
    8594 
     95      ! Update after tracer on domain lateral boundaries 
    8696      DO jn = 1, jptra 
     97         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )    
     98      END DO 
    8799 
    88          ! 0. Lateral boundary conditions on tra (T-point, unchanged sign) 
    89          ! ---------------------------------============ 
    90          CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )    
    91           
    92          !                                                ! =============== 
    93          DO jk = 1, jpk                                   ! Horizontal slab 
    94             !                                             ! =============== 
    95             ! 1. Leap-frog scheme (only in explicit case, otherwise the  
    96             ! -------------------  time stepping is already done in trczdf) 
    97             IF( l_trczdf_exp .AND. ( ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 
    98                zfact = 2. * rdttra(jk) * FLOAT(ndttrc)  
    99                IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(ndttrc)  
    100                tra(:,:,jk,jn) = ( trb(:,:,jk,jn) + zfact * tra(:,:,jk,jn) ) * tmask(:,:,jk) 
    101             ENDIF 
    102  
    103          END DO 
    104100 
    105101#if defined key_obc 
    106         CALL ctl_stop( '          Passive tracers and Open Boundary condition can not be used together ' & 
    107            &           '          Check in trc_nxt routine' ) 
     102!!      CALL obc_trc( kt )               ! OBC open boundaries 
     103#endif 
     104#if defined key_bdy 
     105!!      CALL bdy_trc( kt )               ! BDY open boundaries 
     106#endif 
     107#if defined key_agrif 
     108      CALL Agrif_trc                   ! AGRIF zoom boundaries 
    108109#endif 
    109110 
     111 
     112      ! set time step size (Euler/Leapfrog) 
     113      IF( neuler == 0 .AND. kt ==  nit000) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nit000             (Euler) 
     114      ELSEIF( kt <= nit000 + 1 )           THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
     115      ENDIF 
     116 
     117      ! trends computation initialisation 
     118      IF( l_trdtrc )  THEN 
     119         ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) )  !* store now fields before applying the Asselin filter 
     120         ztrdt(:,:,:,:)  = trn(:,:,:,:) 
     121      ENDIF 
     122      ! Leap-Frog + Asselin filter time stepping 
     123      IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
     124         !                                             ! (only swap) 
     125         DO jn = 1, jptra 
     126            DO jk = 1, jpkm1 
     127               trn(:,:,jk,jn) = tra(:,:,jk,jn) 
     128            END DO 
     129         END DO 
     130         !                                               
     131      ELSE 
     132         ! Leap-Frog + Asselin filter time stepping 
     133         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl)  
     134         ELSE                ;   CALL tra_nxt_fix( kt, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     135         ENDIF 
     136      ENDIF 
     137 
    110138#if defined key_agrif 
    111          !                                             ! =============== 
    112       END DO                                           !   End of slab 
    113       !                                                ! =============== 
    114       ! Interp tracers on boundaries (coarse => fine) 
    115       CALL Agrif_trc 
    116       !                                                ! =============== 
    117       DO jn = 1, jptra                                 ! Horizontal slab 
    118          !                                             ! =============== 
    119 #endif 
     139      ! Update tracer at AGRIF zoom boundaries 
     140      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Trc( kt )      ! children only 
     141#endif       
    120142 
    121          DO jk = 1, jpk   
    122  
    123             ! 2. Time filter and swap of arrays 
    124             ! --------------------------------- 
    125             IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN 
    126  
    127                IF( neuler == 0 .AND. kt == nittrc000 ) THEN 
    128                   DO jj = 1, jpj 
    129                      DO ji = 1, jpi 
    130                         trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    131                         trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 
    132                         tra(ji,jj,jk,jn) = 0. 
    133                      END DO 
    134                   END DO 
    135                   IF( l_trdtrc )   ztrtrd(:,:,:) = 0.e0           !    no trend 
    136                ELSE 
    137                   IF( l_trdtrc ) THEN                             !    Asselin trend 
    138                      DO jj = 1, jpj 
    139                         DO ji = 1, jpi 
    140                            ztrtrd(ji,jj,jk) = atfp * ( trb(ji,jj,jk,jn) - 2*trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) 
    141                         END DO 
    142                      END DO 
    143                   ENDIF 
    144  
    145                   DO jj = 1, jpj 
    146                      DO ji = 1, jpi 
    147                         trb(ji,jj,jk,jn) = atfp  * ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) + atfp1 * trn(ji,jj,jk,jn) 
    148                         trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 
    149                         tra(ji,jj,jk,jn) = 0. 
    150                      END DO 
    151                   END DO 
    152                ENDIF 
    153             ELSE                                                  ! >> EULER-FORWARD schemes (SMOLAR, MUSCL) 
    154                IF( l_trdtrc ) ztrtrd(:,:,:) = 0.e0                !    no trend 
    155  
    156                DO jj = 1, jpj 
    157                   DO ji = 1, jpi 
    158                      trb(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 
    159                      trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn) 
    160                      tra(ji,jj,jk,jn) = 0. 
    161                   END DO 
    162                END DO 
    163  
    164             ENDIF 
    165             !                                             ! =============== 
    166          END DO                                           !   End of slab 
    167          !                                                ! =============== 
    168  
    169          IF( l_trdtrc ) THEN                                      ! trends 
    170             DO jk = 1, jpk 
    171                zfact = 2. * rdttra(jk) * FLOAT(ndttrc) 
    172                ztrtrd(:,:,jk) = ztrtrd(:,:,jk) / zfact            ! n.b. ztrtrd=0 in Euler-forward case 
     143      ! trends computation 
     144      IF( l_trdtrc ) THEN                                      ! trends 
     145         DO jn = 1, jptra 
     146            DO jk = 1, jpkm1 
     147               zfact = 1.e0 / r2dt(jk)   
     148               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact  
     149               CALL trd_tra( kt, 'TRC', jn, jptra_trd_atf, ztrdt ) 
    173150            END DO 
    174             IF (luttrd(jn)) CALL trd_mod_trc( ztrtrd, jn, jptrc_trd_atf, kt ) 
    175          ENDIF 
    176          !                                                        ! =========== 
    177       END DO                                                      ! tracer loop 
    178       !                                                           ! =========== 
    179  
     151         END DO 
     152         DEALLOCATE( ztrdt ) 
     153      END IF 
     154      ! 
    180155      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    181156         WRITE(charout, FMT="('nxt')") 
    … …  
    183158         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 
    184159      ENDIF 
    185  
    186 #if defined key_agrif 
    187       IF (.NOT.Agrif_Root())    CALL Agrif_Update_Trc( kt ) 
    188 #endif       
    189  
    190  
     160      ! 
    191161   END SUBROUTINE trc_nxt 
    192162 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    • Property svn:executable deleted
    r1257 r2528  
    1414   !!---------------------------------------------------------------------- 
    1515   USE oce_trc             ! ocean dynamics and tracers variables 
    16    USE trp_trc             ! ocean passive tracers variables 
    17    USE trdmld_trc 
    18    USE trdmld_trc_oce 
     16   USE trc                 ! ocean passive tracers variables 
     17   USE trdmod_oce 
     18   USE trdtra 
    1919   USE lib_mpp 
    2020   USE prtctl_trc          ! Print control for debbuging 
    … …  
    2828#  include "top_substitute.h90" 
    2929   !!---------------------------------------------------------------------- 
    30    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     30   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3131   !! $Id$  
    32    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     32   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 
    3434    
    … …  
    5454      !!---------------------------------------------------------------------- 
    5555 
    56       IF( kt == nittrc000 ) THEN 
     56      IF( kt == nit000 ) THEN 
    5757         IF(lwp) WRITE(numout,*) 
    5858         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 
    … …  
    139139                  DO ji = 1, jpi 
    140140                     zvolk  = cvol(ji,jj,jk) 
    141 # if defined key_off_degrad 
     141# if defined key_degrad 
    142142                     zvolk  = zvolk * facvol(ji,jj,jk) 
    143143# endif 
    … …  
    180180               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    181181               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
    182                IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdb, jn, jptrc_trd_radb, kt )       ! Asselin-like trend handling 
    183                IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdn, jn, jptrc_trd_radn, kt )       ! standard     trend handling 
     182               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radb, ztrtrdb )       ! Asselin-like trend handling 
     183               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radn, ztrtrdn )       ! standard     trend handling 
    184184              ! 
    185185            ENDIF 
    … …  
    208208            IF( l_trdtrc ) THEN 
    209209               ! 
    210                zs2rdt = 1. / ( 2. * rdt * FLOAT(ndttrc) ) 
     210               zs2rdt = 1. / ( 2. * rdt * FLOAT(nn_dttrc) ) 
    211211               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    212212               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
    213                IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdb, jn, jptrc_trd_radb, kt )       ! Asselin-like trend handling 
    214                IF (luttrd(jn)) CALL trd_mod_trc( ztrtrdn, jn, jptrc_trd_radn, kt )       ! standard     trend handling 
     213               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radb, ztrtrdb )       ! Asselin-like trend handling 
     214               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radn, ztrtrdn )       ! standard     trend handling 
    215215              ! 
    216216            ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    • Property svn:executable deleted
    r1739 r2528  
    44   !! Ocean passive tracers:  surface boundary condition 
    55   !!====================================================================== 
    6    !! History :  8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
    7    !!            8.2  !  01-02  (D. Ludicone)  sea ice and free surface 
    8    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    9    !!            9.0  !  04-03  (C. Ethe)  adapted for passive tracers 
    10    !!                 !  06-08  (C. Deltel) Diagnose ML trends for passive tracers 
     6   !! History :  8.2  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
     7   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface 
     8   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module 
     9   !!            9.0  !  2004-03  (C. Ethe)  adapted for passive tracers 
     10   !!                 !  2006-08  (C. Deltel) Diagnose ML trends for passive tracers 
    1111   !!============================================================================== 
    1212#if defined key_top 
    … …  
    1818   !! * Modules used 
    1919   USE oce_trc             ! ocean dynamics and active tracers variables 
    20    USE trp_trc                 ! ocean  passive tracers variables 
     20   USE trc                 ! ocean  passive tracers variables 
    2121   USE prtctl_trc          ! Print control for debbuging 
    22    USE trdmld_trc 
    23    USE trdmld_trc_oce 
     22   USE trdmod_oce 
     23   USE trdtra 
    2424 
    2525   IMPLICIT NONE 
    … …  
    3232#  include "top_substitute.h90" 
    3333   !!---------------------------------------------------------------------- 
    34    !!   TOP 1.0 , LOCEAN-IPSL (2005)  
     34   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3535   !! $Id$  
    36    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     36   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3737   !!---------------------------------------------------------------------- 
    3838 
    … …  
    6565      !! * Local declarations 
    6666      INTEGER  ::   ji, jj, jn           ! dummy loop indices 
    67       REAL(wp) ::   ztra, zsrau, zse3t   ! temporary scalars 
     67      REAL(wp) ::   zsrau, zse3t   ! temporary scalars 
     68      REAL(wp), DIMENSION(jpi,jpj) ::   zemps  ! surface freshwater flux 
    6869      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    6970      CHARACTER (len=22) :: charout 
    7071      !!---------------------------------------------------------------------- 
    7172 
    72       IF( kt == nittrc000 ) THEN 
     73      IF( kt == nit000 ) THEN 
    7374         IF(lwp) WRITE(numout,*) 
    7475         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 
    … …  
    7677      ENDIF 
    7778 
     79 
    7880      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
     81 
     82      IF( lk_offline ) THEN          ! emps in dynamical files contains emps - rnf 
     83         zemps(:,:) = emps(:,:)   
     84      ELSE                           ! Concentration dilution effect on tracer due to evaporation, precipitation, and river runoff 
     85         IF( lk_vvl ) THEN                      ! volume variable 
     86            zemps(:,:) = emps(:,:) - emp(:,:)    
     87!!ch         zemps(:,:) = 0. 
     88         ELSE                                   ! linear free surface 
     89            IF( ln_rnf ) THEN  ;  zemps(:,:) = emps(:,:) - rnf(:,:)   !  E-P-R 
     90            ELSE               ;  zemps(:,:) = emps(:,:) 
     91            ENDIF  
     92         ENDIF  
     93      ENDIF  
    7994 
    8095      ! 0. initialization 
    8196      zsrau = 1. / rau0 
    82       IF( .NOT. ln_sco )  zse3t = 1. / fse3t(1,1,1) 
    83  
    8497      DO jn = 1, jptra 
    85          ! 1. Concentration dillution effect on tra 
     98         ! 
    8699         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends 
    87  
     100         !                                             ! add the trend to the general tracer trend 
    88101         DO jj = 2, jpj 
    89102            DO ji = fs_2, fs_jpim1   ! vector opt. 
    90                IF( ln_sco ) zse3t = 1. / fse3t(ji,jj,1) 
    91                ! concent./dilut. effect 
    92                ztra = emps(ji,jj) * zsrau * trn(ji,jj,1,jn) * zse3t * tmask(ji,jj,1) 
    93                ! add the trend to the general tracer trend 
    94                tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + ztra 
    95 #if defined key_trc_diatrd 
    96                IF( luttrd(jn) ) & 
    97                &    trtrd(ji,jj,1,ikeep(jn),jpdiatrc) = trtrd(ji,jj,1,ikeep(jn),jpdiatrc) + ztra 
    98 #endif 
    99  
     103               zse3t = 1. / fse3t(ji,jj,1) 
     104               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zemps(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t 
    100105            END DO 
    101106         END DO 
    … …  
    103108         IF( l_trdtrc ) THEN 
    104109            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 
    105             IF (luttrd(jn)) CALL trd_mod_trc(ztrtrd, jn, jptrc_trd_sbc, kt) 
     110            CALL trd_tra( kt, 'TRC', jn, jptra_trd_nsr, ztrtrd ) 
    106111         END IF 
    107  
    108112         !                                                       ! =========== 
    109113      END DO                                                     ! tracer loop 
    110114      !                                                          ! =========== 
    111  
    112115      IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    113116 
    114  
    115       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    116          WRITE(charout, FMT="('sbc')") 
    117          CALL prt_ctl_trc_info(charout) 
    118          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
     117      IF( ln_ctl )   THEN 
     118         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
     119                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    119120      ENDIF 
    120121 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    • Property svn:executable deleted
    r1800 r2528  
    55   !!====================================================================== 
    66   !! History :   1.0  !  2004-03 (C. Ethe) Original code 
     7   !!             3.3  !  2010-07 (C. Ethe) Merge TRA-TRC 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_top 
    … …  
    1314   !!---------------------------------------------------------------------- 
    1415   USE oce_trc         ! ocean dynamics and active tracers variables 
    15    USE trp_trc         ! ocean passive tracers variables  
    16    USE trctrp_lec      ! passive tracers transport parameters 
    17    USE prtctl_trc      ! Print control for debbuging 
    18  
     16   USE trc             ! ocean passive tracers variables  
     17   USE trcnam_trp      ! passive tracers transport namelist variables 
     18   USE trabbl          ! bottom boundary layer               (trc_bbl routine) 
    1919   USE trcbbl          ! bottom boundary layer               (trc_bbl routine) 
     20   USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine) 
    2021   USE trcdmp          ! internal damping                    (trc_dmp routine) 
    21  
    22    USE trcldf_bilapg   ! lateral mixing               (trc_ldf_bilapg routine) 
    23    USE trcldf_bilap    ! lateral mixing                (trc_ldf_bilap routine) 
    24    USE trcldf_iso      ! lateral mixing                  (trc_ldf_iso routine) 
    25    USE trcldf_iso_zps  ! lateral mixing              (trc_ldf_iso_zps routine) 
    26    USE trcldf_lap      ! lateral mixing                  (trc_ldf_lap routine) 
    27   
     22   USE trcldf          ! lateral mixing                      (trc_ldf routine) 
     23   USE trcadv          ! advection                           (trc_adv routine) 
     24   USE trczdf          ! vertical diffusion                  (trc_zdf routine) 
    2825   USE trcnxt          ! time-stepping                       (trc_nxt routine) 
    2926   USE trcrad          ! positivity                          (trc_rad routine) 
    30  
    31    USE trcadv_cen2     ! 2nd order centered advection   (trc_adv_cen2 routine) 
    32    USE trcadv_muscl    ! MUSCL advection               (trc_adv_muscl routine) 
    33    USE trcadv_muscl2   ! MUSCL2 advection             (trc_adv_muscl2 routine) 
    34    USE trcadv_tvd      ! TVD advection                   (trc_adv_tvd routine) 
    35    USE trcadv_smolar   ! SMOLAR advection             (trc_adv_smolar routine) 
    36  
    37    USE trczdf_exp      ! vertical diffusion              (trc_zdf_exp routine) 
    38    USE trczdf_imp      ! vertical diffusion              (trc_zdf_exp routine) 
    39    USE trczdf_iso      ! vertical diffusion              (trc_zdf_exp routine) 
    40    USE trczdf_iso_vopt ! vertical diffusion              (trc_zdf_exp routine) 
    4127   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
    42  
    43    USE zpshde_trc      ! partial step: hor. derivative   (zps_hde_trc routine) 
     28   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
    4429 
    4530#if defined key_agrif 
    … …  
    5540#  include "top_substitute.h90" 
    5641   !!---------------------------------------------------------------------- 
    57    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     42   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5843   !! $Id$  
    59    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     44   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6045   !!---------------------------------------------------------------------- 
    6146 
    6247CONTAINS 
    6348 
    64    SUBROUTINE trc_trp( kt ) 
     49   SUBROUTINE trc_trp( kstp ) 
    6550      !!---------------------------------------------------------------------- 
    6651      !!                     ***  ROUTINE trc_trp  *** 
    … …  
    7156      !!              - Update the passive tracers 
    7257      !!---------------------------------------------------------------------- 
    73       INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
    74       !! 
    75       CHARACTER (len=25) :: charout 
     58      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index 
    7659      !! --------------------------------------------------------------------- 
    77  
    78                                CALL trc_sbc( kt )            ! surface boundary condition 
    79 # if defined key_trcbbc 
    80 !!gm bug : this should be control during the initialisation phase, not here! 
    81        CALL ctl_stop( '  Bottom heat flux not yet implemented with passive tracer         ' & 
    82            &          '  Check in trc_trp routine ' ) 
    83 # endif  
    84       !                                                      ! bottom boundary condition 
    85       IF( lk_trcbbl_dif    )   CALL trc_bbl_dif( kt )            ! diffusive bottom boundary layer scheme 
    86       IF( lk_trcbbl_adv    )   CALL trc_bbl_adv( kt )            ! advective (and/or diffusive) bottom boundary layer scheme 
    87  
    88       IF( lk_trcdmp        )   CALL trc_dmp( kt )            ! internal damping trends 
    89  
    90       !                                                      ! horizontal & vertical advection 
    91       IF( ln_trcadv_cen2   )   CALL trc_adv_cen2  ( kt )         ! 2nd order centered scheme 
    92       IF( ln_trcadv_muscl  )   CALL trc_adv_muscl ( kt )         ! MUSCL scheme 
    93       IF( ln_trcadv_muscl2 )   CALL trc_adv_muscl2( kt )         ! MUSCL2 scheme 
    94       IF( ln_trcadv_tvd    )   CALL trc_adv_tvd   ( kt )         ! TVD scheme 
    95       IF( ln_trcadv_smolar )   CALL trc_adv_smolar( kt )         ! SMOLARKIEWICZ scheme 
    96  
    97   
    98       IF( n_cla == 1   ) THEN 
    99 !!gm bug : this should be control during the initialisation phase, not here! 
    100          WRITE(ctmp1,*) ' Cross Land Advection not yet implemented with passive tracer n_cla = ',n_cla 
    101          CALL ctl_stop( ctmp1 ) 
    102       ENDIF 
    103  
    104       !                                                      ! lateral mixing  
    105       IF( l_trcldf_bilapg  )   CALL trc_ldf_bilapg ( kt )        ! s-coord. horizontal bilaplacian 
    106       IF( l_trcldf_bilap   )   CALL trc_ldf_bilap  ( kt )        ! iso-level bilaplacian  
    107       IF( l_trcldf_iso     )   CALL trc_ldf_iso    ( kt )        ! iso-neutral laplacian  
    108       IF( l_trcldf_iso_zps )   CALL trc_ldf_iso_zps( kt )        ! partial step iso-neutral laplacian 
    109       IF( l_trcldf_lap     )   CALL trc_ldf_lap    ( kt )        ! iso-level laplacian 
    110  
     60      IF( .NOT. lk_c1d ) THEN 
     61         ! 
     62                                CALL trc_sbc( kstp )            ! surface boundary condition 
     63         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme 
     64         IF( lk_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends 
     65                                CALL trc_adv( kstp )            ! horizontal & vertical advection  
     66                                CALL trc_ldf( kstp )            ! lateral mixing 
     67         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
     68            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
    11169#if defined key_agrif 
    112       IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc               ! tracers sponge 
     70         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge 
    11371#endif 
    114   
    115       !                                                      ! vertical diffusion 
    116       IF( l_trczdf_exp     )   CALL trc_zdf_exp     ( kt )       ! explicit time stepping (time splitting scheme) 
    117       IF( l_trczdf_imp     )   CALL trc_zdf_imp     ( kt )       ! implicit time stepping (euler backward) 
    118       IF( l_trczdf_iso     )   CALL trc_zdf_iso     ( kt )       ! isopycnal 
    119       IF( l_trczdf_iso_vo  )   CALL trc_zdf_iso_vopt( kt )       ! vector opt. isopycnal 
    120  
    121                                CALL trc_nxt( kt )            ! tracer fields at next time step 
    122       
    123       IF( ln_trcrad )          CALL trc_rad( kt )            ! Correct artificial negative concentrations 
    124       !                                                      ! especially useful when isopycnal mixing is used 
    125       !                                                       
    126  
    127       IF( ln_zps .AND. .NOT. lk_trc_c1d )   &              ! Partial steps: now horizontal gradient of passive 
    128          &                     CALL zps_hde_trc( kt, trb, gtru, gtrv )       ! tracers at the bottom ocean level 
     72                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
     73                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
     74         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     75         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive 
     76                                                                ! tracers at the bottom ocean level 
     77         ! 
     78      ELSE                                               ! 1D vertical configuration 
     79                                CALL trc_sbc( kstp )            ! surface boundary condition 
     80         IF( .NOT. lk_offline .AND. lk_zdfkpp )    & 
     81            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes 
     82                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields 
     83                                CALL trc_nxt( kstp )            ! tracer fields at next time step      
     84          IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations 
     85         ! 
     86      END IF 
    12987      ! 
    13088   END SUBROUTINE trc_trp 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90

    • Property svn:keywords set to Id
    r1685 r2528  
    1616   !!   trd_mld_trc_init : initialization step 
    1717   !!---------------------------------------------------------------------- 
    18    USE trp_trc           ! tracer definitions (trn, trb, tra, etc.) 
    19    USE oce_trc           ! needed for namelist logicals, and euphotic layer arrays 
    20    USE trctrp_lec 
    21    USE trdmld_trc_oce    ! definition of main arrays used for trends computations 
     18   USE trc               ! tracer definitions (trn, trb, tra, etc.) 
     19   USE dom_oce           ! domain definition 
     20   USE zdfmxl  , ONLY : nmln !: number of level in the mixed layer 
     21   USE zdf_oce , ONLY : avt  !: vert. diffusivity coef. at w-point for temp   
     22# if defined key_zdfddm    
     23   USE zdfddm  , ONLY : avs  !: salinity vertical diffusivity coeff. at w-point 
     24# endif 
     25   USE trcnam_trp      ! passive tracers transport namelist variables 
     26   USE trdmod_trc_oce    ! definition of main arrays used for trends computations 
    2227   USE in_out_manager    ! I/O manager 
    2328   USE dianam            ! build the name of file (routine) 
    … …  
    2934   USE sms_pisces         
    3035   USE sms_lobster 
    31    USE trc 
    3236 
    3337   IMPLICIT NONE 
    3438   PRIVATE 
    3539 
    36    INTERFACE trd_mod_trc 
    37       MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio 
    38    END INTERFACE 
    39  
    40    PUBLIC trd_mod_trc                                             ! routine called by step.F90 
    4140   PUBLIC trd_mld_trc 
    4241   PUBLIC trd_mld_bio 
    4342   PUBLIC trd_mld_trc_init 
     43   PUBLIC trd_mld_trc_zint 
     44   PUBLIC trd_mld_bio_zint 
    4445 
    4546   CHARACTER (LEN=40) ::  clhstnam                                ! name of the trends NetCDF file 
    … …  
    6061#  include "top_substitute.h90" 
    6162   !!---------------------------------------------------------------------- 
    62    !!   TOP 1.0 , LOCEAN-IPSL (2007)  
     63   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    6364   !! $Header:  $  
    64    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     65   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6566   !!---------------------------------------------------------------------- 
    6667 
    6768CONTAINS 
    68  
    69    SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt ) 
    70       !!---------------------------------------------------------------------- 
    71       !!                  ***  ROUTINE trd_mod_trc  *** 
    72       !!---------------------------------------------------------------------- 
    73 #if defined key_trcbbl_adv 
    74       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zun, zvn                   ! temporary arrays 
    75 #else 
    76       USE oce_trc,   zun => un                                            ! When no bbl, zun == un 
    77       USE oce_trc,   zvn => vn                                            ! When no bbl, zvn == vn 
    78 #endif 
    79       INTEGER, INTENT( in )  ::   kt                                  ! time step 
    80       INTEGER, INTENT( in )  ::   kjn                                 ! tracer index 
    81       INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
    83       !!---------------------------------------------------------------------- 
    84  
    85       IF( kt == nittrc000 ) THEN 
    86 !         IF(lwp)WRITE(numout,*) 
    87 !         IF(lwp)WRITE(numout,*) 'trd_mod_trc:' 
    88 !         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~' 
    89       ENDIF 
    90  
    91       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    92       ! Mixed layer trends for passive tracers 
    93       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    94  
    95       SELECT CASE ( ktrd ) 
    96          CASE ( jptrc_trd_xad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_xad    , '3D', kjn ) 
    97          CASE ( jptrc_trd_yad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_yad    , '3D', kjn ) 
    98          CASE ( jptrc_trd_zad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zad    , '3D', kjn ) 
    99          CASE ( jptrc_trd_ldf     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_ldf    , '3D', kjn ) 
    100          CASE ( jptrc_trd_xei     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_xei    , '3D', kjn ) 
    101          CASE ( jptrc_trd_yei     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_yei    , '3D', kjn ) 
    102          CASE ( jptrc_trd_bbl     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_bbl    , '3D', kjn ) 
    103          CASE ( jptrc_trd_zdf     ) 
    104             IF( ln_trcldf_iso ) THEN 
    105                CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_ldf, '3D', kjn ) 
    106             ELSE 
    107                CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zdf, '3D', kjn ) 
    108             ENDIF 
    109          CASE ( jptrc_trd_zei     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zei    , '3D', kjn ) 
    110          CASE ( jptrc_trd_dmp     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_dmp    , '3D', kjn ) 
    111          CASE ( jptrc_trd_sbc     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sbc    , '2D', kjn ) 
    112          CASE ( jptrc_trd_sms     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sms    , '3D', kjn ) 
    113          CASE ( jptrc_trd_bbc     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_bbc    , '3D', kjn ) 
    114          CASE ( jptrc_trd_radb    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radb   , '3D', kjn ) 
    115          CASE ( jptrc_trd_radn    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radn   , '3D', kjn ) 
    116          CASE ( jptrc_trd_atf     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_atf    , '3D', kjn ) 
    117       END SELECT 
    118  
    119  
    120    END SUBROUTINE trd_mod_trc_trp 
    121  
    122    SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt ) 
    123       !!---------------------------------------------------------------------- 
    124       !!                  ***  ROUTINE trd_mod_bio  *** 
    125       !!---------------------------------------------------------------------- 
    126  
    127       INTEGER, INTENT( in )  ::   kt                                  ! time step 
    128       INTEGER, INTENT( in )  ::   ktrd                                ! bio trend index 
    129       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrbio  ! Bio trend 
    130       !!---------------------------------------------------------------------- 
    131  
    132       CALL trd_mld_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends 
    133  
    134    END SUBROUTINE trd_mod_trc_bio 
    135  
    13669 
    13770   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) 
    … …  
    170103           
    171104         ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 
    172          SELECT CASE ( nctls_trc )                                ! choice of the control surface 
     105         SELECT CASE ( nn_ctls_trc )                                ! choice of the control surface 
    173106            CASE ( -2  )   ;   STOP 'trdmld_trc : not ready '     !     -> isopycnal surface (see ???) 
    174107#if defined key_pisces || defined key_lobster 
    … …  
    177110            CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl) 
    178111            CASE (  1  )   ;   nmld_trc(:,:) = nbol_trc(:,:)          !     -> read index from file 
    179             CASE (  2: )   ;   nctls_trc = MIN( nctls_trc, jpktrd_trc - 1 ) 
    180                                nmld_trc(:,:) = nctls_trc + 1      !     -> model level 
     112            CASE (  2: )   ;   nn_ctls_trc = MIN( nn_ctls_trc, jpktrd_trc - 1 ) 
     113                               nmld_trc(:,:) = nn_ctls_trc + 1      !     -> model level 
    181114         END SELECT 
    182115 
    … …  
    281214         tmltrd_bio(:,:,:) = 0.e0    ! <<< reset trend arrays to zero 
    282215         ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 
    283          SELECT CASE ( nctls_trc )                                    ! choice of the control surface 
     216         SELECT CASE ( nn_ctls_trc )                                    ! choice of the control surface 
    284217            CASE ( -2  )   ;   STOP 'trdmld_trc : not ready '     !     -> isopycnal surface (see ???) 
    285218            CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion 
    286219            CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl) 
    287220            CASE (  1  )   ;   nmld_trc(:,:) = nbol_trc(:,:)          !     -> read index from file 
    288             CASE (  2: )   ;   nctls_trc = MIN( nctls_trc, jpktrd_trc - 1 ) 
    289                                nmld_trc(:,:) = nctls_trc + 1          !     -> model level 
     221            CASE (  2: )   ;   nn_ctls_trc = MIN( nn_ctls_trc, jpktrd_trc - 1 ) 
     222                               nmld_trc(:,:) = nn_ctls_trc + 1          !     -> model level 
    290223         END SELECT 
    291224 
    … …  
    380313      !!        of time-averaged mixed-layer fields, this residual WILL NOT BE ZERO 
    381314      !!        over the first two analysis windows (except if restart). 
    382       !!        N.B. For ORCA2_LIM, use e.g. ntrc_trc=5, ucf_trc=1., nctls_trc=8 
     315      !!        N.B. For ORCA2_LIM, use e.g. ntrc_trc=5, rn_ucf_trc=1., nctls_trc=8 
    383316      !!             for checking residuals. 
    384317      !!             On a NEC-SX5 computer, this typically leads to: 
    … …  
    421354      REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  ztmltrd2  ! -+ 
    422355      !! 
    423       REAL(wp), DIMENSION(jpi,jpj) ::   z2d                       ! temporary array, used for eiv arrays 
    424356      CHARACTER (LEN= 5) ::   clvar 
    425357#if defined key_dimgout 
    … …  
    429361      !!---------------------------------------------------------------------- 
    430362 
    431       IF( llwarn ) THEN                                           ! warnings 
    432          IF(      ( nittrc000 /= nit000   ) & 
    433               .OR.( ndttrc    /= 1        )    ) THEN 
    434  
    435             WRITE(numout,*) 'Be careful, trends diags never validated' 
    436             STOP 'Uncomment this line to proceed' 
    437          ENDIF 
    438       ENDIF 
     363      IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " ) 
    439364 
    440365      ! ====================================================================== 
    … …  
    450375            DO ji = 1,jpi 
    451376               ik = nmld_trc(ji,jj) 
    452                zavt = avt(ji,jj,ik) 
     377               zavt = fsavs(ji,jj,ik) 
    453378               DO jn = 1, jptra 
    454                   IF( luttrd(jn) )    & 
     379                  IF( ln_trdtrc(jn) )    & 
    455380                  tmltrd_trc(ji,jj,jpmld_trc_zdf,jn) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
    456381                       &                    * ( trn(ji,jj,ik-1,jn) - trn(ji,jj,ik,jn) )            & 
    … …  
    462387         DO jn = 1, jptra 
    463388         ! ... Remove this K_z trend from the iso-neutral diffusion term (if any) 
    464             IF( luttrd(jn) ) & 
     389            IF( ln_trdtrc(jn) ) & 
    465390                 tmltrd_trc(:,:,jpmld_trc_ldf,jn) = tmltrd_trc(:,:,jpmld_trc_ldf,jn) - tmltrd_trc(:,:,jpmld_trc_zdf,jn) 
    466391    
    … …  
    473398      ! therefore we do not call lbc_lnk in GYRE config. (closed basin, no cyclic B.C.) 
    474399      DO jn = 1, jptra 
    475          IF( luttrd(jn) ) THEN 
     400         IF( ln_trdtrc(jn) ) THEN 
    476401            DO jl = 1, jpltrd_trc 
    477402               CALL lbc_lnk( tmltrd_trc(:,:,jl,jn), 'T', 1. )        ! lateral boundary conditions 
    … …  
    490415      ! II.1 Set before values of vertically averages passive tracers 
    491416      ! ------------------------------------------------------------- 
    492       IF( kt > nittrc000 ) THEN 
     417      IF( kt > nit000 ) THEN 
    493418         DO jn = 1, jptra 
    494             IF( luttrd(jn) ) THEN 
     419            IF( ln_trdtrc(jn) ) THEN 
    495420               tmlb_trc   (:,:,jn) = tml_trc   (:,:,jn) 
    496421               tmlatfn_trc(:,:,jn) = tmltrd_trc(:,:,jpmld_trc_atf,jn) 
    … …  
    505430      DO jk = 1, jpktrd_trc ! - 1 ??? 
    506431         DO jn = 1, jptra 
    507             IF( luttrd(jn) ) & 
     432            IF( ln_trdtrc(jn) ) & 
    508433               tml_trc(:,:,jn) = tml_trc(:,:,jn) + wkx_trc(:,:,jk) * trn(:,:,jk,jn) 
    509434         END DO 
    … …  
    515440         ! 
    516441         DO jn = 1, jptra 
    517             IF( luttrd(jn) ) THEN 
     442            IF( ln_trdtrc(jn) ) THEN 
    518443               tmlbb_trc  (:,:,jn) = tmlb_trc   (:,:,jn)   ;   tmlbn_trc  (:,:,jn) = tml_trc    (:,:,jn) 
    519444               tmlatfb_trc(:,:,jn) = tmlatfn_trc(:,:,jn)   ;   tmlradb_trc(:,:,jn) = tmlradn_trc(:,:,jn) 
    … …  
    544469         ! ... Cumulate over BOTH physical contributions AND over time steps 
    545470         DO jn = 1, jptra 
    546             IF( luttrd(jn) ) THEN 
     471            IF( ln_trdtrc(jn) ) THEN 
    547472               DO jl = 1, jpltrd_trc 
    548473                  tmltrdm_trc(:,:,jn) = tmltrdm_trc(:,:,jn) + tmltrd_trc(:,:,jl,jn) 
    … …  
    552477 
    553478         DO jn = 1, jptra 
    554             IF( luttrd(jn) ) THEN 
     479            IF( ln_trdtrc(jn) ) THEN 
    555480               ! ... Special handling of the Asselin trend  
    556481               tmlatfm_trc(:,:,jn) = tmlatfm_trc(:,:,jn) + tmlatfn_trc(:,:,jn) 
    … …  
    573498 
    574499      ! Convert to appropriate physical units 
    575       tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * ucf_trc 
    576  
    577       itmod = kt - nittrc000 + 1 
     500      tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * rn_ucf_trc 
     501 
     502      itmod = kt - nit000 + 1 
    578503      it    = kt 
    579504 
    580       MODULO_NTRD : IF( MOD( itmod, ntrd_trc ) == 0 ) THEN           ! nitend MUST be multiple of ntrd_trc 
     505      MODULO_NTRD : IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN           ! nitend MUST be multiple of nn_trd_trc 
    581506         ! 
    582507         ztmltot (:,:,:) = 0.e0                                   ! reset arrays to zero 
    … …  
    591516 
    592517         DO jn = 1, jptra 
    593             IF( luttrd(jn) ) THEN 
     518            IF( ln_trdtrc(jn) ) THEN 
    594519               !-- Compute total trends    (use rdttrc instead of rdt ???) 
    595                IF ( ln_trcadv_smolar .OR. ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN  ! EULER-FORWARD schemes 
     520               IF ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) THEN  ! EULER-FORWARD schemes 
    596521                  ztmltot(:,:,jn) =  ( tml_trc(:,:,jn) - tmlbn_trc(:,:,jn) )/rdt 
    597522               ELSE                                                                     ! LEAP-FROG schemes 
    … …  
    629554               !-- Compute passive tracer total trends 
    630555         DO jn = 1, jptra 
    631             IF( luttrd(jn) ) THEN 
     556            IF( ln_trdtrc(jn) ) THEN 
    632557               tml_sum_trc(:,:,jn) = tmlbn_trc(:,:,jn) + 2 * ( tml_sum_trc(:,:,jn) - tml_trc(:,:,jn) ) + tml_trc(:,:,jn) 
    633558               ztmltot2   (:,:,jn) = ( tml_sum_trc(:,:,jn) - tml_sumb_trc(:,:,jn) ) /  ( 2.*rdt )    ! now tracer unit is /sec 
    … …  
    637562         !-- Compute passive tracer residuals 
    638563         DO jn = 1, jptra 
    639             IF( luttrd(jn) ) THEN 
     564            IF( ln_trdtrc(jn) ) THEN 
    640565               ! 
    641566               DO jl = 1, jpltrd_trc 
    … …  
    680605            DO jn = 1, jptra 
    681606 
    682                IF( luttrd(jn) ) THEN 
     607               IF( ln_trdtrc(jn) ) THEN 
    683608                  WRITE(numout, *) 
    684609                  WRITE(numout, *) '>>>>>>>>>>>>>>>>>>  TRC TRACER jn =', jn, ' <<<<<<<<<<<<<<<<<<' 
    … …  
    777702         rmld_sum_trc(:,:)     = rmld_sum_trc(:,:)     /      (2*zfn)  ! similar to tml_sum and sml_sum 
    778703         DO jn = 1, jptra 
    779             IF( luttrd(jn) ) THEN         
     704            IF( ln_trdtrc(jn) ) THEN         
    780705               ! For passive tracer instantaneous diagnostics 
    781706               tmlbb_trc  (:,:,jn) = tmlb_trc   (:,:,jn)   ;   tmlbn_trc  (:,:,jn) = tml_trc    (:,:,jn) 
    … …  
    791716               ! III.4 Convert to appropriate physical units 
    792717               ! ------------------------------------------- 
    793                ztmltot     (:,:,jn)   = ztmltot     (:,:,jn)   * ucf_trc/zfn   ! instant diags 
    794                ztmlres     (:,:,jn)   = ztmlres     (:,:,jn)   * ucf_trc/zfn 
    795                ztmlatf     (:,:,jn)   = ztmlatf     (:,:,jn)   * ucf_trc/zfn 
    796                ztmlrad     (:,:,jn)   = ztmlrad     (:,:,jn)   * ucf_trc/zfn 
     718               ztmltot     (:,:,jn)   = ztmltot     (:,:,jn)   * rn_ucf_trc/zfn   ! instant diags 
     719               ztmlres     (:,:,jn)   = ztmlres     (:,:,jn)   * rn_ucf_trc/zfn 
     720               ztmlatf     (:,:,jn)   = ztmlatf     (:,:,jn)   * rn_ucf_trc/zfn 
     721               ztmlrad     (:,:,jn)   = ztmlrad     (:,:,jn)   * rn_ucf_trc/zfn 
    797722               tml_sum_trc (:,:,jn)   = tml_sum_trc (:,:,jn)   /      (2*zfn)  ! mean diags 
    798                ztmltot2    (:,:,jn)   = ztmltot2    (:,:,jn)   * ucf_trc/zfn2 
    799                ztmltrd2    (:,:,:,jn) = ztmltrd2    (:,:,:,jn) * ucf_trc/zfn2 
    800                ztmlatf2    (:,:,jn)   = ztmlatf2    (:,:,jn)   * ucf_trc/zfn2 
    801                ztmlrad2    (:,:,jn)   = ztmlrad2    (:,:,jn)   * ucf_trc/zfn2 
    802                ztmlres2    (:,:,jn)   = ztmlres2    (:,:,jn)   * ucf_trc/zfn2 
     723               ztmltot2    (:,:,jn)   = ztmltot2    (:,:,jn)   * rn_ucf_trc/zfn2 
     724               ztmltrd2    (:,:,:,jn) = ztmltrd2    (:,:,:,jn) * rn_ucf_trc/zfn2 
     725               ztmlatf2    (:,:,jn)   = ztmlatf2    (:,:,jn)   * rn_ucf_trc/zfn2 
     726               ztmlrad2    (:,:,jn)   = ztmlrad2    (:,:,jn)   * rn_ucf_trc/zfn2 
     727               ztmlres2    (:,:,jn)   = ztmlres2    (:,:,jn)   * rn_ucf_trc/zfn2 
    803728            ENDIF 
    804729         END DO 
    … …  
    820745      ! ---------------------------------- 
    821746 
    822       IF( lwp .AND. MOD( itmod , ntrd_trc ) == 0 ) THEN 
     747      IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN 
    823748         WRITE(numout,*) ' ' 
    824749         WRITE(numout,*) 'trd_mld_trc : write passive tracer trends in the NetCDF file :' 
    … …  
    834759         DO jn = 1, jptra 
    835760            ! 
    836             IF( luttrd(jn) ) THEN 
    837                !-- Specific treatment for EIV trends 
    838                !   WARNING : When eiv is switched on but key_diaeiv is not, we do NOT diagnose 
    839                !   u_eiv, v_eiv, and w_eiv : the exact eiv advective trends thus cannot be computed, 
    840                !   only their sum makes sense => mask directional contrib. to avoid confusion 
    841                z2d(:,:) = tmltrd_trc(:,:,jpmld_trc_xei,jn) + tmltrd_trc(:,:,jpmld_trc_yei,jn) & 
    842                     &   + tmltrd_trc(:,:,jpmld_trc_zei,jn) 
    843 #if ( defined key_trcldf_eiv && defined key_diaeiv ) 
    844                tmltrd_trc(:,:,jpmld_trc_xei,jn) = -999. 
    845                tmltrd_trc(:,:,jpmld_trc_yei,jn) = -999. 
    846                tmltrd_trc(:,:,jpmld_trc_zei,jn) = -999. 
    847 #endif    
     761            IF( ln_trdtrc(jn) ) THEN 
    848762               CALL histwrite( nidtrd(jn), "mxl_depth", it, rmld_trc(:,:), ndimtrd1, ndextrd1 ) 
    849763               !-- Output the fields 
    … …  
    864778                    &          it, ztmlatf(:,:,jn), ndimtrd1, ndextrd1 ) 
    865779                      
    866                CALL histwrite( nidtrd(jn), trim(clvar//ctrd_trc( jpltrd_trc+1,2)),     &  ! now total EIV : jpltrd_trc + 1 
    867                     &          it, z2d(:,:), ndimtrd1, ndextrd1 )                      
    868             ! 
    869780            ENDIF 
    870781         END DO 
    … …  
    872783         IF( kt == nitend ) THEN  
    873784            DO jn = 1, jptra 
    874                IF( luttrd(jn) )  CALL histclo( nidtrd(jn) ) 
     785               IF( ln_trdtrc(jn) )  CALL histclo( nidtrd(jn) ) 
    875786            END DO 
    876787         ENDIF 
    … …  
    881792         DO jn = 1, jptra 
    882793            ! 
    883             IF( luttrd(jn) ) THEN 
    884                !-- Specific treatment for EIV trends 
    885                !   WARNING : see above 
    886                z2d(:,:) = ztmltrd2(:,:,jpmld_trc_xei,jn) + ztmltrd2(:,:,jpmld_trc_yei,jn) & 
    887                    &   + ztmltrd2(:,:,jpmld_trc_zei,jn) 
    888  
    889 #if ( defined key_trcldf_eiv && defined key_diaeiv ) 
    890                ztmltrd2(:,:,jpmld_trc_xei,jn) = -999. 
    891                ztmltrd2(:,:,jpmld_trc_yei,jn) = -999. 
    892                ztmltrd2(:,:,jpmld_trc_zei,jn) = -999. 
    893 #endif 
     794            IF( ln_trdtrc(jn) ) THEN 
    894795               CALL histwrite( nidtrd(jn), "mxl_depth", it, rmld_sum_trc(:,:), ndimtrd1, ndextrd1 )  
    895796               !-- Output the fields 
    … …  
    911812                 &          it, ztmlatf2(:,:,jn), ndimtrd1, ndextrd1 ) 
    912813 
    913                CALL histwrite( nidtrd(jn), trim(clvar//ctrd_trc( jpltrd_trc+1,2)),    &  ! now total EIV : jpltrd_trc + 1 
    914                  &          it, z2d(:,:), ndimtrd1, ndextrd1 ) 
    915  
    916814            ENDIF  
    917815            ! 
    … …  
    919817         IF( kt == nitend ) THEN  
    920818            DO jn = 1, jptra 
    921                IF( luttrd(jn) )  CALL histclo( nidtrd(jn) ) 
     819               IF( ln_trdtrc(jn) )  CALL histclo( nidtrd(jn) ) 
    922820            END DO 
    923821         ENDIF 
    … …  
    931829# endif /* key_dimgout */ 
    932830 
    933       IF( MOD( itmod, ntrd_trc ) == 0 ) THEN 
     831      IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN 
    934832         ! 
    935833         ! Reset cumulative arrays to zero 
    … …  
    1010908      !!---------------------------------------------------------------------- 
    1011909      ! ... Warnings 
    1012       IF( llwarn ) THEN 
    1013          IF(      ( nittrc000 /= nit000   ) & 
    1014               .OR.( ndttrc    /= 1        )    ) THEN 
    1015  
    1016             WRITE(numout,*) 'Be careful, trends diags never validated' 
    1017             STOP 'Uncomment this line to proceed' 
    1018          END IF 
    1019       END IF 
     910      IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " ) 
    1020911 
    1021912      ! ====================================================================== 
    … …  
    1058949 
    1059950      ! Convert to appropriate physical units 
    1060       tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * ucf_trc 
    1061  
    1062       MODULO_NTRD : IF( MOD( kt, ntrd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd 
     951      tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * rn_ucf_trc 
     952 
     953      MODULO_NTRD : IF( MOD( kt, nn_trd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd 
    1063954         ! 
    1064955         zfn  = float(nmoymltrdbio)    ;    zfn2 = zfn * zfn 
    … …  
    11141005         ! III.4 Convert to appropriate physical units 
    11151006         ! ------------------------------------------- 
    1116          ztmltrdbio2    (:,:,:) = ztmltrdbio2    (:,:,:) * ucf_trc/zfn2 
     1007         ztmltrdbio2    (:,:,:) = ztmltrdbio2    (:,:,:) * rn_ucf_trc/zfn2 
    11171008 
    11181009      END IF MODULO_NTRD 
    … …  
    11331024 
    11341025      ! define time axis 
    1135       itmod = kt - nittrc000 + 1 
     1026      itmod = kt - nit000 + 1 
    11361027      it    = kt 
    11371028 
    1138       IF( lwp .AND. MOD( itmod , ntrd_trc ) == 0 ) THEN 
     1029      IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN 
    11391030         WRITE(numout,*) ' ' 
    11401031         WRITE(numout,*) 'trd_mld_bio : write ML bio trends in the NetCDF file :' 
    … …  
    11761067# endif /* key_dimgout */ 
    11771068 
    1178       IF( MOD( itmod, ntrd_trc ) == 0 ) THEN 
     1069      IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN 
    11791070         ! 
    11801071         ! III.5 Reset cumulative arrays to zero 
    … …  
    12161107      INTEGER :: ilseq, jl, jn 
    12171108      REAL(wp) ::   zjulian, zsto, zout 
    1218       CHARACTER (LEN=40) ::   clop, cleiv 
     1109      CHARACTER (LEN=40) ::   clop 
    12191110      CHARACTER (LEN=15) ::   csuff 
    12201111      CHARACTER (LEN=12) ::   clmxl 
    12211112      CHARACTER (LEN=16) ::   cltrcu 
    12221113      CHARACTER (LEN= 5) ::   clvar 
    1223  
    1224       NAMELIST/namtoptrd/ ntrd_trc, nctls_trc, ucf_trc, & 
    1225                           ln_trdmld_trc_restart, ln_trdmld_trc_instant, luttrd 
    12261114 
    12271115      !!---------------------------------------------------------------------- 
    … …  
    12411129      ! I.1 Check consistency of user defined preferences 
    12421130      ! ------------------------------------------------- 
    1243 #if defined key_trcldf_eiv 
    1244       IF( lk_trdmld_trc .AND. ln_trcldf_iso ) THEN 
    1245          WRITE(numout,cform_war) 
    1246          WRITE(numout,*) '                You asked for ML diagnostics with iso-neutral diffusion   ' 
    1247          WRITE(numout,*) '                and eiv physics.                                          ' 
    1248          WRITE(numout,*) '                Yet, key_diaeiv is NOT switched on, so the eddy induced   ' 
    1249          WRITE(numout,*) '                velocity is not diagnosed.                                ' 
    1250          WRITE(numout,*) '                Therefore, we cannot deduce the eiv advective trends.     ' 
    1251          WRITE(numout,*) '                Only THE SUM of the i,j,k directional contributions then  ' 
    1252          WRITE(numout,*) '                makes sense => To avoid any confusion, we choosed to mask ' 
    1253          WRITE(numout,*) '                these i,j,k directional contributions (with -999.)        ' 
    1254          nwarn = nwarn + 1 
    1255       ENDIF 
    1256 #  endif 
    1257  
    1258       IF( ( lk_trdmld_trc ) .AND. ( MOD( nitend, ntrd_trc ) /= 0 ) ) THEN 
     1131 
     1132      IF( ( lk_trdmld_trc ) .AND. ( MOD( nitend, nn_trd_trc ) /= 0 ) ) THEN 
    12591133         WRITE(numout,cform_err) 
    12601134         WRITE(numout,*) '                Your nitend parameter, nitend = ', nitend 
    12611135         WRITE(numout,*) '                is no multiple of the trends diagnostics frequency        ' 
    1262          WRITE(numout,*) '                          you defined, ntrd_trc   = ', ntrd_trc 
     1136         WRITE(numout,*) '                          you defined, nn_trd_trc   = ', nn_trd_trc 
    12631137         WRITE(numout,*) '                This will not allow you to restart from this simulation.  ' 
    12641138         WRITE(numout,*) '                You should reconsider this choice.                        '  
    … …  
    12691143      ENDIF 
    12701144 
    1271       IF( ( lk_trdmld_trc ) .AND. ( n_cla == 1 ) ) THEN 
    1272          WRITE(numout,cform_war) 
    1273          WRITE(numout,*) '                You set n_cla = 1. Note that the Mixed-Layer diagnostics  ' 
    1274          WRITE(numout,*) '                are not exact along the corresponding straits.            ' 
    1275          nwarn = nwarn + 1 
    1276       ENDIF 
    1277  
    1278  
    12791145      ! * Debugging information * 
    12801146      IF( lldebug ) THEN 
    12811147         WRITE(numout,*) '               ln_trcadv_muscl = '      , ln_trcadv_muscl 
    1282          WRITE(numout,*) '               ln_trcadv_smolar = '     , ln_trcadv_smolar 
    12831148         WRITE(numout,*) '               ln_trdmld_trc_instant = ', ln_trdmld_trc_instant 
    1284       ENDIF 
    1285  
    1286       IF( ln_trcadv_smolar .AND. .NOT. ln_trdmld_trc_instant ) THEN 
    1287          WRITE(numout,cform_err) 
    1288          WRITE(numout,*) '                Currently, you can NOT use simultaneously tracer Smolark. ' 
    1289          WRITE(numout,*) '                advection and window averaged diagnostics of ML trends.   ' 
    1290          WRITE(numout,*) '                WHY? Everything in trdmld_trc is coded for leap-frog, and ' 
    1291          WRITE(numout,*) '                Smolarkiewicz scheme is Euler forward.                    ' 
    1292          WRITE(numout,*) '                In particuliar, entrainment trend would be FALSE. However ' 
    1293          WRITE(numout,*) '                this residual is correct for instantaneous ML diagnostics.' 
    1294          WRITE(numout,*)  
    1295          nstop = nstop + 1 
    12961149      ENDIF 
    12971150 
    … …  
    13641217      ! I.3 Read control surface from file ctlsurf_idx 
    13651218      ! ---------------------------------------------- 
    1366       IF( nctls_trc == 1 ) THEN 
     1219      IF( nn_ctls_trc == 1 ) THEN 
    13671220         CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    13681221         READ ( inum ) nbol_trc 
    … …  
    13781231#else 
    13791232      ! clmxl = legend root for netCDF output 
    1380       IF( nctls_trc == 0 ) THEN                                   ! control surface = mixed-layer with density criterion 
     1233      IF( nn_ctls_trc == 0 ) THEN                                   ! control surface = mixed-layer with density criterion 
    13811234         clmxl = 'Mixed Layer ' 
    1382       ELSE IF( nctls_trc == 1 ) THEN                              ! control surface = read index from file  
     1235      ELSE IF( nn_ctls_trc == 1 ) THEN                              ! control surface = read index from file  
    13831236         clmxl = '      Bowl ' 
    1384       ELSE IF( nctls_trc >= 2 ) THEN                              ! control surface = model level 
    1385          WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nctls_trc 
     1237      ELSE IF( nn_ctls_trc >= 2 ) THEN                              ! control surface = model level 
     1238         WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nn_ctls_trc 
    13861239      ENDIF 
    13871240 
    … …  
    13951248         STOP 'trd_mld_trc : this was never checked. Comment this line to proceed...' 
    13961249      ENDIF 
    1397       zsto = ntrd_trc * rdt 
     1250      zsto = nn_trd_trc * rdt 
    13981251      clop = "inst("//TRIM(clop)//")" 
    13991252#  else 
    … …  
    14011254         zsto = rdt                                               ! inst. diags : we use IOIPSL time averaging 
    14021255      ELSE 
    1403          zsto = ntrd_trc * rdt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging 
     1256         zsto = nn_trd_trc * rdt                                    ! mean  diags : we DO NOT use any IOIPSL time averaging 
    14041257      ENDIF 
    14051258      clop = "ave("//TRIM(clop)//")" 
    14061259#  endif 
    1407       zout = ntrd_trc * rdt 
     1260      zout = nn_trd_trc * rdt 
    14081261 
    14091262      IF(lwp) WRITE (numout,*) '                netCDF initialization' 
    … …  
    14241277      !       ==> choose them according to trdmld_trc_oce.F90 <== 
    14251278 
    1426 #if defined key_diaeiv 
    1427       cleiv = " (*** only total EIV is meaningful ***)"           ! eiv advec. trends require u_eiv, v_eiv 
    1428 #else 
    1429       cleiv = " " 
    1430 #endif 
    14311279      ctrd_trc(jpmld_trc_xad    ,1) = " Zonal advection"                 ;   ctrd_trc(jpmld_trc_xad    ,2) = "_xad" 
    14321280      ctrd_trc(jpmld_trc_yad    ,1) = " Meridional advection"            ;   ctrd_trc(jpmld_trc_yad    ,2) = "_yad" 
    … …  
    14341282      ctrd_trc(jpmld_trc_ldf    ,1) = " Lateral diffusion"               ;   ctrd_trc(jpmld_trc_ldf    ,2) = "_ldf" 
    14351283      ctrd_trc(jpmld_trc_zdf    ,1) = " Vertical diff. (Kz)"             ;   ctrd_trc(jpmld_trc_zdf    ,2) = "_zdf" 
    1436       ctrd_trc(jpmld_trc_xei    ,1) = " Zonal EIV advection"//cleiv      ;   ctrd_trc(jpmld_trc_xei    ,2) = "_xei" 
    1437       ctrd_trc(jpmld_trc_yei    ,1) = " Merid. EIV advection"//cleiv     ;   ctrd_trc(jpmld_trc_yei    ,2) = "_yei" 
    1438       ctrd_trc(jpmld_trc_zei    ,1) = " Vertical EIV advection"//cleiv   ;   ctrd_trc(jpmld_trc_zei    ,2) = "_zei" 
    1439       ctrd_trc(jpmld_trc_bbc    ,1) = " Geothermal flux"                 ;   ctrd_trc(jpmld_trc_bbc    ,2) = "_bbc" 
    14401284      ctrd_trc(jpmld_trc_bbl    ,1) = " Adv/diff. Bottom boundary layer" ;   ctrd_trc(jpmld_trc_bbl    ,2) = "_bbl" 
    14411285      ctrd_trc(jpmld_trc_dmp    ,1) = " Tracer damping"                  ;   ctrd_trc(jpmld_trc_dmp    ,2) = "_dmp" 
    … …  
    14451289      ctrd_trc(jpmld_trc_radn   ,1) = " Correct negative concentrations" ;   ctrd_trc(jpmld_trc_radn   ,2) = "_radn" 
    14461290      ctrd_trc(jpmld_trc_atf    ,1) = " Asselin time filter"             ;   ctrd_trc(jpmld_trc_atf    ,2) = "_atf" 
    1447       ctrd_trc(jpltrd_trc+1     ,1) = " Total EIV"//cleiv                ;   ctrd_trc(jpltrd_trc+1     ,2) = "_tei" 
    14481291 
    14491292      DO jn = 1, jptra       
    14501293      !-- Create a NetCDF file and enter the define mode  
    1451          IF( luttrd(jn) ) THEN 
     1294         IF( ln_trdtrc(jn) ) THEN 
    14521295            csuff="ML_"//ctrcnm(jn) 
    1453             CALL dia_nam( clhstnam, ntrd_trc, csuff ) 
     1296            CALL dia_nam( clhstnam, nn_trd_trc, csuff ) 
    14541297            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1455                &        1, jpi, 1, jpj, nittrc000-ndttrc, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom ) 
     1298               &        1, jpi, 1, jpj, nit000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
    14561299       
    14571300            !-- Define the ML depth variable 
    … …  
    14641307#if defined key_lobster 
    14651308          !-- Create a NetCDF file and enter the define mode 
    1466           CALL dia_nam( clhstnam, ntrd_trc, 'trdbio' ) 
     1309          CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' ) 
    14671310          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1468              &             1, jpi, 1, jpj, nittrc000-ndttrc, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom ) 
     1311             &             1, jpi, 1, jpj, nit000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set ) 
    14691312#endif 
    14701313 
    14711314      !-- Define physical units 
    1472       IF( ucf_trc == 1. ) THEN 
     1315      IF( rn_ucf_trc == 1. ) THEN 
    14731316         cltrcu = "(mmole-N/m3)/sec"                              ! all passive tracers have the same unit  
    1474       ELSEIF ( ucf_trc == 3600.*24.) THEN                         ! ??? trop long : seulement (mmole-N/m3) 
     1317      ELSEIF ( rn_ucf_trc == 3600.*24.) THEN                         ! ??? trop long : seulement (mmole-N/m3) 
    14751318         cltrcu = "(mmole-N/m3)/day"                              ! ??? apparait dans les sorties netcdf  
    14761319      ELSE 
    … …  
    14851328      DO jn = 1, jptra 
    14861329         ! 
    1487          IF( luttrd(jn) ) THEN 
     1330         IF( ln_trdtrc(jn) ) THEN 
    14881331            clvar = trim(ctrcnm(jn))//"ml"                           ! e.g. detml, zooml, no3ml, etc. 
    14891332            CALL histdef(nidtrd(jn), clvar,           clmxl//" "//trim(ctrcnm(jn))//" Mixed Layer ",                         & 
    … …  
    15041347            CALL histdef(nidtrd(jn), trim(clvar//ctrd_trc(jpmld_trc_atf,2)), clmxl//" "//clvar//ctrd_trc(jpmld_trc_atf,1),   &  
    15051348              &       cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zout, zout ) ! IOIPSL: NO time mean 
    1506           
    1507             CALL histdef(nidtrd(jn), trim(clvar//ctrd_trc(jpltrd_trc+1,2)),  clmxl//" "//clvar//ctrd_trc(jpltrd_trc+1 ,1),   &  
    1508               &       cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! Total EIV  
    15091349         ! 
    15101350         ENDIF 
    … …  
    15201360      !-- Leave IOIPSL/NetCDF define mode 
    15211361      DO jn = 1, jptra 
    1522          IF( luttrd(jn) )  CALL histend( nidtrd(jn) ) 
     1362         IF( ln_trdtrc(jn) )  CALL histend( nidtrd(jn), snc4set ) 
    15231363      END DO 
    15241364 
    15251365#if defined key_lobster 
    15261366      !-- Leave IOIPSL/NetCDF define mode 
    1527       CALL histend( nidtrdbio ) 
     1367      CALL histend( nidtrdbio, snc4set ) 
    15281368 
    15291369      IF(lwp) WRITE(numout,*) 
    … …  
    15391379   !!---------------------------------------------------------------------- 
    15401380 
    1541    INTERFACE trd_mod_trc 
    1542       MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio 
    1543    END INTERFACE 
    1544  
    15451381CONTAINS 
    15461382 
    … …  
    15541390      WRITE(*,*) 'trd_mld_bio: You should not have seen this print! error?', kt 
    15551391   END SUBROUTINE trd_mld_bio 
    1556  
    1557    SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt ) 
    1558       INTEGER               , INTENT( in )     ::   kt      ! time step 
    1559       INTEGER               , INTENT( in )     ::   ktrd    ! bio trend index 
    1560       REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrbio  ! Bio trend 
    1561       WRITE(*,*) 'trd_mod_trc_bio : You should not have seen this print! error?', ptrbio(1,1,1) 
    1562       WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd 
    1563       WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt 
    1564    END SUBROUTINE trd_mod_trc_bio 
    1565  
    1566    SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt ) 
    1567       INTEGER               , INTENT( in )     ::   kt      ! time step 
    1568       INTEGER               , INTENT( in )     ::   kjn     ! tracer index 
    1569       INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index 
    1570       REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend 
    1571       WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1) 
    1572       WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn 
    1573       WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd 
    1574       WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt 
    1575    END SUBROUTINE trd_mod_trc_trp 
    15761392 
    15771393   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90

    • Property svn:keywords set to Id
    r1473 r2528  
    99#if defined key_top && defined key_trdmld_trc 
    1010   !!---------------------------------------------------------------------- 
    11    USE oce_trc 
    1211   USE in_out_manager  ! I/O manager 
    1312   USE iom             ! I/O module 
    14    USE trc             ! for ndttrc ctrcnm 
    15    USE trdmld_trc_oce  ! for lk_trdmld_trc 
     13   USE trc             ! for nn_dttrc ctrcnm 
     14   USE trdmod_trc_oce  ! for lk_trdmld_trc 
    1615 
    1716   IMPLICIT NONE 
    … …  
    2322   INTEGER ::   nummldw_trc               ! logical unit for mld restart 
    2423   !!--------------------------------------------------------------------------------- 
    25    !! OPA 9.0 , LOCEAN-IPSL (2006)  
     24   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    2625   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp $  
    27    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     26   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2827   !!--------------------------------------------------------------------------------- 
    2928   
    … …  
    4544      !!-------------------------------------------------------------------------------- 
    4645 
    47       IF( kt == nitrst - ndttrc .OR. nitend - nit000 + 1 < 2 * ndttrc ) THEN ! idem trcrst.F90 
     46      IF( kt == nitrst - nn_dttrc .OR. nitend - nit000 + 1 < 2 * nn_dttrc ) THEN ! idem trcrst.F90 
    4847         IF( nitrst > 1.0e9 ) THEN 
    4948            WRITE(clkt,*) nitrst 

  • trunk/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    • Property svn:eol-style deleted
    r1753 r2528  
    66   !! History :   1.0  !  2004-03  (C. Ethe)  original code 
    77   !!             2.0  !  2007-12 (C. Ethe, G. Madec)  rewritting 
    8    !!---------------------------------------------------------------------- 
    9    !! NEMO/TOP 2.0,  LOCEAN-IPSL (2007) 
    10    !! $Id$ 
    11    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    128   !!---------------------------------------------------------------------- 
    139#if defined key_top 
    … …  
    3228   USE par_oce , ONLY :   jpkdta   =>   jpkdta     !: number of levels            > or = jpk 
    3329   USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option 
     30   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature 
     31   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity 
    3432 
    3533   !* IO manager * 
    36    USE in_out_manager      ! use all the variables 
     34   USE in_out_manager     
     35                           
    3736   !* physical constants * 
    38    USE phycst              ! use all the variables 
     37   USE phycst             
     38 
     39   !* 1D configuration 
     40   USE c1d                                          
    3941 
    4042   !* model domain * 
    … …  
    111113   USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag 
    112114   USE dom_oce , ONLY :   ln_zco     =>  ln_zco      !: z-coordinate flag 
    113    USE dom_oce , ONLY :   lk_zco     =>  lk_zco      !: z-coordinate flag (1D or 3D arrays) 
    114    USE dom_oce , ONLY :   hbatt      =>   hbatt      !: ocean depth at the vertical of  t-point (m) 
    115    USE dom_oce , ONLY :   hbatu      =>   hbatu      !: ocean depth at the vertical of  u-point (m) 
    116    USE dom_oce , ONLY :   hbatv      =>   hbatv      !: ocean depth at the vertical of w-point (m) 
    117    USE dom_oce , ONLY :   gsigt      =>   gsigt      !: model level depth coefficient at T-levels 
    118    USE dom_oce , ONLY :   gsigw      =>   gsigw      !: model level depth coefficient at W-levels 
    119    USE dom_oce , ONLY :   gsi3w      =>   gsi3w      !: model level depth coef at w-levels (defined as the sum of e3w) 
    120    USE dom_oce , ONLY :   esigt      =>   esigt      !: vertical scale factor coef. at t-levels 
    121    USE dom_oce , ONLY :   esigw      =>   esigw      !: vertical scale factor coef. at w-levels 
    122    USE dom_oce , ONLY :   lk_vvl     => lk_vvl       !: variable grid flag 
    123  
     115   USE dom_oce , ONLY :   hbatt      =>  hbatt       !: ocean depth at the vertical of  t-point (m) 
     116   USE dom_oce , ONLY :   hbatu      =>  hbatu       !: ocean depth at the vertical of  u-point (m) 
     117   USE dom_oce , ONLY :   hbatv      =>  hbatv       !: ocean depth at the vertical of w-point (m) 
     118   USE dom_oce , ONLY :   gsigt      =>  gsigt       !: model level depth coefficient at T-levels 
     119   USE dom_oce , ONLY :   gsigw      =>  gsigw       !: model level depth coefficient at W-levels 
     120   USE dom_oce , ONLY :   gsi3w      =>  gsi3w       !: model level depth coef at w-levels (defined as the sum of e3w) 
     121   USE dom_oce , ONLY :   esigt      =>  esigt       !: vertical scale factor coef. at t-levels 
     122   USE dom_oce , ONLY :   esigw      =>  esigw       !: vertical scale factor coef. at w-levels 
     123   USE dom_oce , ONLY :   lk_vvl     =>  lk_vvl      !: variable grid flag 
     124# if defined key_vvl 
     125   USE dom_oce , ONLY :   gdep3w_1   =>  gdep3w_1    !: ??? 
     126   USE dom_oce , ONLY :   gdept_1    =>  gdept_1     !: depth of t-points (m) 
     127   USE dom_oce , ONLY :   gdepw_1    =>  gdepw_1     !: depth of t-points (m) 
     128   USE dom_oce , ONLY :   e3t_1      =>  e3t_1       !: vertical scale factors at t- 
     129   USE dom_oce , ONLY :   e3u_1      =>  e3u_1       !: vertical scale factors at u- 
     130   USE dom_oce , ONLY :   e3v_1      =>  e3v_1       !: vertical scale factors v- 
     131   USE dom_oce , ONLY :   e3w_1      =>  e3w_1       !: w-points (m) 
     132   USE dom_oce , ONLY :   e3f_1      =>  e3f_1       !: f-points (m) 
     133   USE dom_oce , ONLY :   e3uw_1     =>  e3uw_1      !: uw-points (m) 
     134   USE dom_oce , ONLY :   e3vw_1     =>  e3vw_1      !: vw-points (m) 
     135# endif 
    124136   !* masks, bathymetry * 
    125    USE dom_oce , ONLY :   mbathy     =>   mbathy     !: number of ocean level (=0,  & 1, ... , jpk-1)  
     137   USE dom_oce , ONLY :   mbkt       =>   mbkt       !: vertical index of the bottom last T- ocean level 
     138   USE dom_oce , ONLY :   mbku       =>   mbku       !: vertical index of the bottom last U- ocean level 
     139   USE dom_oce , ONLY :   mbkv       =>   mbkv       !: vertical index of the bottom last V- ocean level 
    126140   USE dom_oce , ONLY :   tmask_i    =>   tmask_i    !: Interior mask at t-points 
    127141   USE dom_oce , ONLY :   tmask      =>   tmask      !: land/ocean mask at t-points 
    … …  
    129143   USE dom_oce , ONLY :   vmask      =>   vmask      !: land/ocean mask at v-points  
    130144   USE dom_oce , ONLY :   fmask      =>   fmask      !: land/ocean mask at f-points  
    131 # if defined key_off_degrad 
    132    USE dom_oce , ONLY :   facvol     =>   facvol     !: volume factor for degradation 
    133 # endif 
    134145 
    135146   !* time domain * 
    … …  
    166177   USE oce , ONLY :   tn      =>    tn      !: pot. temperature (celsius) 
    167178   USE oce , ONLY :   sn      =>    sn      !: salinity (psu) 
     179   USE oce , ONLY :   tsn     =>    tsn     !: 4D array contaning ( tn, sn ) 
     180   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb ) 
     181   USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa ) 
    168182   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
    169183   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    170184   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
    171 #if defined key_off_tra 
    172    USE oce , ONLY :   gtu     =>    gtu     !: t-, s- and rd horizontal gradient at u- and 
    173    USE oce , ONLY :   gsu     =>    gsu     !: v-points at bottom ocean level 
     185   USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion 
     186#if defined key_offline 
     187   USE oce , ONLY :   gtsu    =>    gtsu    !: t-, s- and rd horizontal gradient at u- and 
     188   USE oce , ONLY :   gtsv    =>    gtsv    !: 
    174189   USE oce , ONLY :   gru     =>    gru     !: 
    175    USE oce , ONLY :   gtv     =>    gtv     !: 
    176    USE oce , ONLY :   gsv     =>    gsv     !: 
    177190   USE oce , ONLY :   grv     =>    grv     !:  
     191# if defined key_degrad 
     192   USE dommsk , ONLY :   facvol     =>   facvol     !: volume factor for degradation 
     193# endif 
     194 
    178195#endif 
    179    USE lib_mpp , ONLY :   lk_mpp    =>  lk_mpp       !: Mpp flag 
    180  
    181    USE dom_oce , ONLY :   n_cla     =>   n_cla         !: flag (0/1) for cross land advection  
     196   USE lib_mpp , ONLY :   lk_mpp    =>  lk_mpp        !: Mpp flag 
     197 
     198   USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection  
    182199 
    183200   !* surface fluxes * 
    … …  
    186203   USE sbc_oce , ONLY :   wndm       =>    wndm       !: 10m wind speed  
    187204   USE sbc_oce , ONLY :   qsr        =>    qsr        !: penetrative solar radiation (w m-2)   
    188    USE sbc_oce , ONLY :   emp        =>    emp        !: evaporation minus precipitation (kg m-2 s-2)  
    189    USE sbc_oce , ONLY :   emps       =>    emps       !: evaporation minus precipitation (kg m-2 s-2) 
     205   USE sbc_oce , ONLY :   emp        =>    emp        !: freshwater budget: volume flux               [Kg/m2/s] 
     206   USE sbc_oce , ONLY :   emps       =>    emps       !: freshwater budget: concentration/dillution   [Kg/m2/s] 
     207   USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s] 
     208   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Daily mean to Diurnal Cycle short wave (qsr)  
     209   USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths 
    190210   USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1) 
    191211   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface 
    192212   USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction 
    193    USE traqsr  , ONLY :   rn_si2     =>    rn_si2     !: deepest depth of extinction (blue &  0.01 mg.m-3)     (RGB) 
    194213   USE traqsr  , ONLY :   ln_qsr_bio =>    ln_qsr_bio !: flag to use or not the biological fluxes for light 
    195214   USE sbcrnf  , ONLY :   rnfmsk     =>    rnfmsk     !: mixed adv scheme in runoffs vicinity (hori.)  
    196215   USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.) 
    197216 
    198    !* bottom boundary layer * 
    199 # if   defined key_trabbl_dif   ||   defined key_trabbl_adv 
    200 # if ! defined key_off_tra  
    201    USE trabbl , ONLY :   atrbbl   =>   rn_ahtbbl     !: lateral coeff. for bottom boundary layer scheme (m2/s) 
    202 # else  
    203    USE trabbl, ONLY :   bblx   => bblx         !: ??? 
    204    USE trabbl, ONLY :   bbly   => bbly         !: ??? 
    205 #  endif 
    206 # endif 
     217   USE trc_oce 
    207218 
    208219   !* lateral diffusivity (tracers) * 
    … …  
    221232   USE zdf_oce , ONLY :   avt        =>   avt         !: vert. diffusivity coef. at w-point for temp   
    222233# if defined key_zdfddm 
    223    USE zdfddm  , ONLY :   avs        =>    avs        !: salinity vertical diffusivity coeff. at w-point 
     234   USE zdfddm  , ONLY :   avs        =>   avs        !: salinity vertical diffusivity coeff. at w-point 
    224235# endif 
    225236 
    … …  
    245256#endif 
    246257 
     258   !!---------------------------------------------------------------------- 
     259   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     260   !! $Id$ 
     261   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    247262   !!====================================================================== 
    248263END MODULE oce_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    • Property svn:eol-style deleted
    r2047 r2528  
    99   !!             1.0  !  2004-03  (C. Ethe) Free form and module 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    11    !!---------------------------------------------------------------------- 
    12    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    13    !! $Id$  
    14    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1511   !!---------------------------------------------------------------------- 
    1612   USE par_kind          ! kind parameters 
    … …  
    3935   LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .FALSE.  !: 1D pass. tracer configuration flag 
    4036# endif 
    41    ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 
    42 # if defined key_trc_diatrd 
    43    ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 
    44    INTEGER, PUBLIC,  PARAMETER ::   jptrc_xad     =  1   !: x- horizontal advection 
    45    INTEGER, PUBLIC,  PARAMETER ::   jptrc_yad     =  2   !: y- horizontal advection 
    46    INTEGER, PUBLIC,  PARAMETER ::   jptrc_zad     =  3   !: z- vertical   advection 
    47    INTEGER, PUBLIC,  PARAMETER ::   jptrc_xdf     =  4   !: lateral       diffusion 
    48    INTEGER, PUBLIC,  PARAMETER ::   jptrc_ydf     =  5   !: lateral       diffusion 
    49    INTEGER, PUBLIC,  PARAMETER ::   jptrc_zdf     =  6   !: vertical diffusion (Kz) 
    50    INTEGER, PUBLIC,  PARAMETER ::   jptrc_sbc     =  7   !: surface boundary condition 
    51 #if ! defined key_trcldf_eiv && ! defined key_trcdmp 
    52    INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      =  7  !: trends: 3*(advection + diffusion       ) + sbc 
    53 #endif 
    54 #if defined key_trcldf_eiv && defined key_trcdmp 
    55    INTEGER, PUBLIC,  PARAMETER ::   jptrc_xei     =  8   !: x- horiz. EIV advection 
    56    INTEGER, PUBLIC,  PARAMETER ::   jptrc_yei     =  9   !: y- horiz. EIV advection 
    57    INTEGER, PUBLIC,  PARAMETER ::   jptrc_zei     = 10   !: z- vert.  EIV advection 
    58    INTEGER, PUBLIC,  PARAMETER ::   jptrc_dmp     = 11   !: damping 
    59    INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      = 11   !: trends: 3*(advection + diffusion + eiv ) + sbc + damping 
    60 #endif 
    61 #if defined key_trcldf_eiv && ! defined key_trcdmp 
    62    INTEGER, PUBLIC,  PARAMETER ::   jptrc_xei     =  8   !: x- horiz. EIV advection 
    63    INTEGER, PUBLIC,  PARAMETER ::   jptrc_yei     =  9   !: y- horiz. EIV advection 
    64    INTEGER, PUBLIC,  PARAMETER ::   jptrc_zei     = 10   !: z- vert.  EIV advection 
    65    INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      = 10   !: trends: 3*(advection + diffusion + eiv ) + sbc  
    66 #endif 
    67 #if ! defined key_trcldf_eiv && defined key_trcdmp 
    68    INTEGER, PUBLIC,  PARAMETER ::   jptrc_dmp     =  8   !: damping 
    69    INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      =  8   !: trends: 3*(advection + diffusion       ) + sbc + damping 
    70 #endif 
    71 #endif 
    7237 
    7338   REAL(wp), PUBLIC  :: rtrn  = 1.e-15      !: truncation value      
     39 
     40   !!---------------------------------------------------------------------- 
     41   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     42   !! $Id$  
     43   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    7444   !!====================================================================== 
    7545END MODULE par_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90

    • Property svn:eol-style deleted
    r1581 r2528  
    3535   PUBLIC prt_ctl_trc_info    ! 
    3636   PUBLIC prt_ctl_trc_init    ! called by opa.F90 
    37  
    38    !!---------------------------------------------------------------------- 
    39    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    40    !! $Id$  
    41    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    42    !!---------------------------------------------------------------------- 
    4337 
    4438CONTAINS 
    … …  
    466460   !!---------------------------------------------------------------------- 
    467461#endif 
    468      
    469    !!====================================================================== 
     462  
     463   !!---------------------------------------------------------------------- 
     464   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     465   !! $Id$  
     466   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     467   !!======================================================================    
    470468END MODULE prtctl_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90

    r1146 r2528  
    22   !!                    ***  top_substitute.h90   *** 
    33   !!---------------------------------------------------------------------- 
    4    !! ** purpose : Statement function file: to be include in all routines 
    5    !!              concerning passive tracer model  
     4   !! ** purpose : Statement function file: to be include in all passive tracer modules 
    65   !!---------------------------------------------------------------------- 
    76   !! History :   1.0  !  2004-03 (C. Ethe) Original code 
    87   !!             2.0  !  2007-12 (C. Ethe, G. Madec) new architecture 
    98   !!---------------------------------------------------------------------- 
    10    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     9#  include "domzgr_substitute.h90" 
     10#  include "ldfeiv_substitute.h90" 
     11#  include "ldftra_substitute.h90" 
     12#  include "vectopt_loop_substitute.h90" 
     13   !!---------------------------------------------------------------------- 
     14   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    1115   !! $Id$  
    12    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     16   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1317   !!---------------------------------------------------------------------- 
    14  
    15     ! Lateral eddy diffusivity coefficient for passive tracer: 
    16     ! ======================================================== 
    17 #if defined key_traldf_c3d || defined key_off_degrad 
    18 !   'key_traldf_c3d' :                 aht: 3D coefficient 
    19 #       define fsahtrt(i,j,k)  trcrat * ahtt(i,j,k) 
    20 #       define fsahtru(i,j,k)  trcrat * ahtu(i,j,k) 
    21 #       define fsahtrv(i,j,k)  trcrat * ahtv(i,j,k) 
    22 #       define fsahtrw(i,j,k)  trcrat * ahtw(i,j,k) 
    23 #elif defined key_traldf_c2d 
    24 !   'key_traldf_c2d' :                 aht: 2D coefficient 
    25 #       define fsahtrt(i,j,k)  trcrat * ahtt(i,j) 
    26 #       define fsahtru(i,j,k)  trcrat * ahtu(i,j) 
    27 #       define fsahtrv(i,j,k)  trcrat * ahtv(i,j) 
    28 #       define fsahtrw(i,j,k)  trcrat * ahtw(i,j) 
    29 #elif defined key_traldf_c1d 
    30 !   'key_traldf_c1d' :                 aht: 1D coefficient 
    31 #       define fsahtrt(i,j,k)  trcrat * ahtt(k) 
    32 #       define fsahtru(i,j,k)  trcrat * ahtu(k) 
    33 #       define fsahtrv(i,j,k)  trcrat * ahtv(k) 
    34 #       define fsahtrw(i,j,k)  trcrat * ahtw(k) 
    35 #else 
    36 !   Default option :             aht: Constant coefficient 
    37 #       define fsahtrt(i,j,k)  ahtrc0 
    38 #       define fsahtru(i,j,k)  ahtrc0 
    39 #       define fsahtrv(i,j,k)  ahtrc0 
    40 #       define fsahtrw(i,j,k)  ahtrc0 
    41 #endif 
    42  
    43     ! Eddy induced velocity  coefficient for passive tracer: 
    44     ! ======================================================== 
    45 #if defined key_traldf_c3d || defined key_off_degrad 
    46 !   'key_traldf_c3d' :                 eiv: 3D coefficient 
    47 #       define fsaeitru(i,j,k)  trcrat * aeiu(i,j,k) 
    48 #       define fsaeitrv(i,j,k)  trcrat * aeiv(i,j,k) 
    49 #       define fsaeitrw(i,j,k)  trcrat * aeiw(i,j,k) 
    50 #elif defined key_traldf_c2d 
    51 !   'key_traldf_c2d' :                 eiv: 2D coefficient 
    52 #       define fsaeitru(i,j,k)  trcrat * aeiu(i,j) 
    53 #       define fsaeitrv(i,j,k)  trcrat * aeiv(i,j) 
    54 #       define fsaeitrw(i,j,k)  trcrat * aeiw(i,j) 
    55 #elif defined key_traldf_c1d 
    56 !   'key_traldf_c1d' :                 eiv: 1D coefficient 
    57 #       define fsaeitru(i,j,k)  trcrat * aeiu(k) 
    58 #       define fsaeitrv(i,j,k)  trcrat * aeiv(k) 
    59 #       define fsaeitrw(i,j,k)  trcrat * aeiw(k) 
    60 #else 
    61 !   Default option :             eiv: Constant coefficient 
    62 #       define fsaeitru(i,j,k)  aeiv0 
    63 #       define fsaeitrv(i,j,k)  aeiv0 
    64 #       define fsaeitrw(i,j,k)  aeiv0 
    65 #endif 
    66     ! mixing for passive tracer: 
    67     ! ======================================================== 
    68 #if defined key_trc_zdfddm 
    69 !   'key_trc_zdfddm' :    avs  
    70 #       define fstravs(i,j,k)   avs(i,j,k) 
    71 #else 
    72 !   Defautl option :   avs = avt 
    73 #       define fstravs(i,j,k)   avt(i,j,k) 
    74 #endif 
    75  
    76 ! ======================================================== 
    77 #include "domzgr_substitute.h90" 
    78 #include "ldfeiv_substitute.h90" 
    79 #include "ldftra_substitute.h90" 
    80 #include "vectopt_loop_substitute.h90" 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90

    • Property svn:eol-style deleted
    r1542 r2528  
    44   !! Passive tracers   :  module for tracers defined 
    55   !!====================================================================== 
    6    !! History :    -   !  1996-01  (M. Levy)  Original code 
     6   !! History :   OPA  !  1996-01  (M. Levy)  Original code 
    77   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model 
    88   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    9    !!             1.0  !  2004-03  (C. Ethe)  Free form and module 
    10    !!---------------------------------------------------------------------- 
    11    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    12    !! $Id$  
    13    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     9   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module 
    1410   !!---------------------------------------------------------------------- 
    1511#if defined key_top 
    … …  
    3430   INTEGER, PUBLIC                   ::   numnat   !: the number of the passive tracer NAMELIST 
    3531   LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutini   !:  initialisation from FILE or not (NAMELIST) 
    36    LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutsav   !:  logical for saving tracer or not 
    37    INTEGER, PUBLIC, DIMENSION(jptra) ::   nutini   !: FORTRAN LOGICAL UNIT for initialisation file 
     32   LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutsav   !:  save the tracer or not 
    3833 
    3934   !! passive tracers fields (before,now,after) 
    4035   !! -------------------------------------------------- 
    41    REAL(wp), PUBLIC ::   trai                         !: initial total tracer 
    42    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol  !: masked grid volume  
    43    REAL(wp), PUBLIC ::   areatot                      !: total volume  
     36   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol   !: volume correction -degrad option-  
     37   REAL(wp), PUBLIC ::   trai                          !: initial total tracer 
     38   REAL(wp), PUBLIC ::   areatot                       !: total volume  
    4439 
    4540   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trn   !: traceur concentration for actual time step 
    … …  
    4742   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trb   !: traceur concentration for before time step 
    4843 
     44   !! interpolated gradient 
     45   !!--------------------------------------------------   
     46   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtru   !: horizontal gradient at u-points at bottom ocean level 
     47   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtrv   !: horizontal gradient at v-points at bottom ocean level 
    4948    
    5049   !! passive tracers restart (input and output) 
    5150   !! ------------------------------------------   
    52    INTEGER , PUBLIC  ::  ndttrc     !: frequency of step on passive tracers 
    53    INTEGER , PUBLIC  ::  nittrc000  !: first time step of passive tracers model 
    54    LOGICAL , PUBLIC  ::  ln_rsttr     !: boolean term for restart i/o for passive tracers (namelist) 
    55    LOGICAL , PUBLIC  ::  lrst_trc   !: logical to control the trc restart write 
    56    INTEGER , PUBLIC  ::  nutwrs     !: output FILE for passive tracers restart 
    57    INTEGER , PUBLIC  ::  nutrst     !: logical unit for restart FILE for passive tracers 
    58    INTEGER , PUBLIC  ::  nrsttr     !: control of the time step ( 0 or 1 ) for pass. tr. 
    59    CHARACTER(len=50) ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
    60    CHARACTER(len=50) ::  cn_trcrst_out !: suffix of pass. tracer restart name (output) 
     51   LOGICAL , PUBLIC          ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist) 
     52   LOGICAL , PUBLIC          ::  lrst_trc      !: logical to control the trc restart write 
     53   INTEGER , PUBLIC          ::  nn_dttrc      !: frequency of step on passive tracers 
     54   INTEGER , PUBLIC          ::  nutwrs        !: output FILE for passive tracers restart 
     55   INTEGER , PUBLIC          ::  nutrst        !: logical unit for restart FILE for passive tracers 
     56   INTEGER , PUBLIC          ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr. 
     57   CHARACTER(len=50), PUBLIC ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
     58   CHARACTER(len=50), PUBLIC ::  cn_trcrst_out !: suffix of pass. tracer restart name (output) 
    6159    
    6260   !! information for outputs 
    6361   !! -------------------------------------------------- 
    64    INTEGER , PUBLIC ::   nwritetrc   !: time step frequency for concentration outputs (namelist) 
     62   INTEGER , PUBLIC ::   nn_writetrc   !: time step frequency for concentration outputs (namelist) 
     63   REAL(wp), PUBLIC, DIMENSION(jpk) ::   rdttrc        !: vertical profile of passive tracer time step 
    6564    
    66 # if defined key_trc_diaadd && ! defined key_iomput 
     65# if defined key_diatrc && ! defined key_iomput 
    6766   !! additional 2D/3D outputs namelist 
    6867   !! -------------------------------------------------- 
    69    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d   !: 2d output field name 
    70    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u   !: 2d output field unit    
    71    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d   !: 3d output field name 
    72    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u   !: 3d output field unit 
    73    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l   !: 2d output field long name 
    74    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l   !: 3d output field long name 
     68   INTEGER , PUBLIC                               ::   nwritedia   !: frequency of additional arrays outputs(namelist) 
     69   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d      !: 2d output field name 
     70   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u      !: 2d output field unit    
     71   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d      !: 3d output field name 
     72   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u      !: 3d output field unit 
     73   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l      !: 2d output field long name 
     74   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l      !: 3d output field long name 
    7575 
    76    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d   !:  additional 2d outputs   
    77    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d   !:  additional 3d outputs   
     76   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d    !:  additional 2d outputs   
     77   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d    !:  additional 3d outputs   
    7878    
    79    INTEGER , PUBLIC ::   nwritedia     !: frequency of additional arrays outputs(namelist) 
    8079# endif 
    8180 
    82 #if defined key_trc_diabio || defined key_trdmld_trc 
    83    CHARACTER(len=8),  DIMENSION(jpdiabio) ::   ctrbio   !: biological trends name      (NAMELIST) 
    84    CHARACTER(len=20), DIMENSION(jpdiabio) ::   ctrbiu   !: biological trends unit      (NAMELIST) 
    85    CHARACTER(len=80), DIMENSION(jpdiabio) ::   ctrbil   !: biological trends long name (NAMELIST) 
    86    INTEGER ::   nwritebio   !: time step frequency for biological outputs (NAMELIST) 
     81#if defined key_diabio || defined key_trdmld_trc 
     82   !                                                              !!*  namtop_XXX namelist * 
     83   INTEGER , PUBLIC                               ::   nwritebio   !: time step frequency for biological outputs  
     84   CHARACTER(len=8 ), PUBLIC, DIMENSION(jpdiabio) ::   ctrbio      !: biological trends name       
     85   CHARACTER(len=20), PUBLIC, DIMENSION(jpdiabio) ::   ctrbiu      !: biological trends unit    
     86   CHARACTER(len=80), PUBLIC, DIMENSION(jpdiabio) ::   ctrbil      !: biological trends long name 
    8787#endif 
    88 # if defined key_trc_diabio 
     88# if defined key_diabio 
    8989   !! Biological trends 
    9090   !! ----------------- 
    91    REAL(wp), DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends 
     91   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends 
    9292# endif 
    9393 
    … …  
    105105#endif 
    106106 
     107   !!---------------------------------------------------------------------- 
     108   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     109   !! $Id$  
     110   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    107111   !!====================================================================== 
    108112END MODULE trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    • Property svn:eol-style deleted
    r2421 r2528  
    44   !! TOP :   Output of passive tracers 
    55   !!====================================================================== 
    6    !! History :    -   !  1995-01 (M. Levy)  Original code 
     6   !! History :   OPA  !  1995-01 (M. Levy)  Original code 
    77   !!              -   !  1998-01 (C. Levy) NETCDF format using ioipsl interface 
    88   !!              -   !  1999-01 (M.A. Foujols) adapted for passive tracer 
    99   !!              -   !  1999-09 (M.A. Foujols) split into three parts 
    10    !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     10   !!   NEMO      1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
    1111   !!                  !  2008-05 (C. Ethe re-organization) 
    1212   !!---------------------------------------------------------------------- 
    … …  
    1717   !! trc_dia     : main routine of output passive tracer 
    1818   !! trcdit_wr   : outputs of concentration fields 
    19    !! trcdid_wr   : outputs of dvection-diffusion trends 
    2019   !! trcdii_wr   : outputs of additional 2D/3D diagnostics 
    2120   !! trcdib_wr   : outputs of biological fields 
    … …  
    2423   USE oce_trc 
    2524   USE trc 
    26    USE trp_trc 
    2725   USE par_trc 
    28    USE trdmld_trc_oce, ONLY : luttrd 
    2926   USE dianam    ! build name of file (routine) 
    3027   USE in_out_manager  ! I/O manager 
    … …  
    3532   PRIVATE 
    3633 
    37    PUBLIC trc_dia       
     34   PUBLIC   trc_dia   ! called by XXX module  
    3835 
    3936   INTEGER  ::   nit5      !: id for tracer output file 
    … …  
    4542   INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index 
    4643   INTEGER , DIMENSION (jpij)     ::   ndext51   !: integer arrays for ocean surface index 
    47 # if defined key_trc_diaadd 
     44# if defined key_diatrc 
    4845   INTEGER  ::   nitd      !: id for additional array output file 
    4946   INTEGER  ::   ndepitd   !: id for depth mesh 
    5047   INTEGER  ::   nhoritd   !: id for horizontal mesh 
    5148# endif 
    52 # if defined key_trc_diatrd 
    53    INTEGER , DIMENSION (jptra) ::   nit6      !: id for additional array output file 
    54    INTEGER , DIMENSION (jptra) ::   ndepit6   !: id for depth mesh 
    55    INTEGER , DIMENSION (jptra) ::   nhorit6   !: id for horizontal mesh 
    56 # endif 
    57 # if defined key_trc_diabio 
     49# if defined key_diabio 
    5850   INTEGER  ::   nitb        !:         id.         for additional array output file 
    5951   INTEGER  ::   ndepitb   !:  id for depth mesh 
    … …  
    6456#  include "top_substitute.h90" 
    6557   !!---------------------------------------------------------------------- 
    66    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     58   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    6759   !! $Id$  
    68    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    69    !!---------------------------------------------------------------------- 
    70  
     60   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     61   !!---------------------------------------------------------------------- 
    7162CONTAINS 
    7263 
    … …  
    8071      INTEGER               :: kindic 
    8172      !!--------------------------------------------------------------------- 
    82        
     73      ! 
    8374      CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration 
    84       CALL trcdid_wr( kt, kindic )      ! outputs for dynamical trends 
    8575      CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays 
    8676      CALL trcdib_wr( kt, kindic )      ! outputs for biological trends 
    87  
    8877      ! 
    8978   END SUBROUTINE trc_dia 
     79 
    9080 
    9181   SUBROUTINE trcdit_wr( kt, kindic ) 
    … …  
    111101      LOGICAL ::   ll_print = .FALSE. 
    112102      CHARACTER (len=40) :: clhstnam, clop 
    113 #if defined key_off_tra 
    114103      INTEGER ::   inum = 11             ! temporary logical unit 
    115 #endif 
    116104      CHARACTER (len=20) :: cltra, cltrau 
    117105      CHARACTER (len=80) :: cltral 
    118106      REAL(wp) :: zsto, zout, zdt 
    119       INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod 
     107      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    120108      !!---------------------------------------------------------------------- 
    121109 
    … …  
    133121      ENDIF 
    134122# if defined key_diainstant 
    135       zsto = nwritetrc * rdt 
     123      zsto = nn_writetrc * rdt 
    136124      clop = "inst("//TRIM(clop)//")" 
    137125# else 
    … …  
    139127      clop = "ave("//TRIM(clop)//")" 
    140128# endif 
    141       zout = nwritetrc * zdt 
     129      zout = nn_writetrc * zdt 
    142130 
    143131      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    147135 
    148136      ! define time axis 
    149       itmod = kt - nittrc000 + 1 
     137      itmod = kt - nit000 + 1 
    150138      it    = kt 
     139      iiter = ( nit000 - 1 ) / nn_dttrc 
    151140 
    152141      ! Define NETCDF files and fields at beginning of first time step 
    … …  
    155144      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 
    156145       
    157       IF( kt == nittrc000 ) THEN 
     146      IF( kt == nit000 ) THEN 
    158147 
    159148         ! Compute julian date from starting date of the run 
    … …  
    161150         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    162151         IF(lwp)WRITE(numout,*)' '   
    163          IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         & 
     152         IF(lwp)WRITE(numout,*)' Date 0 used :', nit000                         & 
    164153            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   & 
    165154            &                 ,'Julian day : ', zjulian   
    … …  
    168157            &                    ' limit storage in depth = ', ipk 
    169158 
    170 #if defined key_off_tra 
    171         ! WRITE root name in date.file for use by postpro 
    172          IF(lwp) THEN 
    173             CALL dia_nam( clhstnam, nwritetrc,' ' ) 
     159         IF( lk_offline .AND. lwp ) THEN 
     160            CALL dia_nam( clhstnam, nn_writetrc,' ' ) 
    174161            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea ) 
    175162            WRITE(inum,*) clhstnam 
    176163            CLOSE(inum) 
    177164         ENDIF 
    178 #endif 
    179165 
    180166         ! Define the NETCDF files for passive tracer concentration 
    181          CALL dia_nam( clhstnam, nwritetrc, 'ptrc_T' ) 
     167         CALL dia_nam( clhstnam, nn_writetrc, 'ptrc_T' ) 
    182168         IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam 
    183169 
    … …  
    185171         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     & 
    186172            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
    187             &          nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
     173            &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set) 
    188174 
    189175         ! Vertical grid for tracer : gdept 
    … …  
    206192 
    207193         ! end netcdf files header 
    208          CALL histend( nit5 ) 
     194         CALL histend( nit5, snc4set ) 
    209195         IF(lwp) WRITE(numout,*) 
    210196         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr' 
    … …  
    216202      ! --------------------------------------- 
    217203 
    218       IF( lwp .AND. MOD( itmod, nwritetrc ) == 0 ) THEN 
     204      IF( lwp .AND. MOD( itmod, nn_writetrc ) == 0 ) THEN 
    219205         WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step' 
    220206         WRITE(numout,*) '~~~~~~~~~ ' 
    … …  
    233219   END SUBROUTINE trcdit_wr 
    234220 
    235 # if defined key_trc_diatrd 
    236  
    237    SUBROUTINE trcdid_wr( kt, kindic ) 
    238       !!---------------------------------------------------------------------- 
    239       !!                     ***  ROUTINE trcdid_wr  *** 
    240       !! 
    241       !! ** Purpose :   output of passive tracer : advection-diffusion trends 
    242       !! 
    243       !! ** Method  :   At the beginning of the first time step (nit000), define all 
    244       !!             the NETCDF files and fields for concentration of passive tracer 
    245       !! 
    246       !!        At each time step call histdef to compute the mean if necessary 
    247       !!        Each nwritetrd time step, output the instantaneous or mean fields 
    248       !! 
    249       !!        IF kindic <0, output of fields before the model interruption. 
    250       !!        IF kindic =0, time step loop 
    251       !!        IF kindic >0, output of fields before the time step loop 
    252       !!---------------------------------------------------------------------- 
    253       INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    254       INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
    255       !! 
    256       LOGICAL ::   ll_print = .FALSE. 
    257       CHARACTER (len=40) ::   clhstnam, clop 
    258       CHARACTER (len=20) ::   cltra, cltrau 
    259       CHARACTER (len=80) ::   cltral 
    260       CHARACTER (len=10) ::   csuff 
    261       INTEGER  ::   jn, jl, ikn 
    262       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
    263       REAL(wp) ::   zsto, zout, zdt 
    264       !!---------------------------------------------------------------------- 
    265  
    266       ! 0. Initialisation 
    267       ! ----------------- 
    268        
    269  
    270       ! local variable for debugging 
    271       ll_print = .FALSE. 
    272       ll_print = ll_print .AND. lwp 
    273       ! 
    274       ! Define frequency of output and means 
    275       zdt = rdt 
    276       IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!) 
    277       ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time) 
    278       ENDIF 
    279 #  if defined key_diainstant 
    280       zsto = nwritetrd * rdt 
    281       clop = "inst("//TRIM(clop)//")" 
    282 #  else 
    283       zsto = zdt 
    284       clop = "ave("//TRIM(clop)//")" 
    285 #  endif 
    286       zout = nwritetrd * zdt 
    287  
    288       ! Define indices of the horizontal output zoom and vertical limit storage 
    289       iimi = 1      ;      iima = jpi 
    290       ijmi = 1      ;      ijma = jpj 
    291       ipk = jpk 
    292  
    293       ! define time axis 
    294       itmod = kt - nittrc000 + 1 
    295       it    = kt 
    296  
    297       ! Define the NETCDF files (one per tracer) 
    298       IF( ll_print ) WRITE(numout,*) 'trcdid kt=', kt, ' kindic ', kindic 
    299        
    300        
    301       IF( kt == nittrc000 ) THEN 
    302  
    303          DO jn = 1, jptra 
    304             ! 
    305             IF( luttrd(jn) ) THEN      ! Define the file for dynamical trends - one per each tracer IF required 
    306  
    307                IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  & 
    308                    &                   ' limit storage in depth = ', ipk 
    309                csuff='DY_'//ctrcnm(jn) 
    310                CALL dia_nam( clhstnam, nwritetrd, csuff ) 
    311                IF(lwp)WRITE(numout,*)   " Name of NETCDF file for dynamical trends",   & 
    312                   &                     " of tracer number : ",clhstnam 
    313  
    314                CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,       & 
    315                   &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,   & 
    316                   &          nittrc000-ndttrc, zjulian, zdt, nhorit6(jn),  & 
    317                   &          nit6(jn) , domain_id=nidom ) 
    318  
    319                ! Vertical grid for tracer trend - one per each tracer IF needed 
    320                CALL histvert( nit6(jn), 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit6(jn) )  
    321              END IF 
    322           END DO 
    323  
    324           ! Declare all the output fields as NETCDF variables 
    325           DO jn = 1, jptra 
    326             IF( luttrd(jn) ) THEN 
    327                 DO jl = 1, jpdiatrc 
    328                   IF( jl == jptrc_xad ) THEN 
    329                       ! short and long title for x advection for tracer 
    330                       WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 
    331                       WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58) 
    332                   END IF 
    333                   IF( jl == jptrc_yad ) THEN 
    334                       ! short and long title for y advection for tracer 
    335                       WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 
    336                       WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58) 
    337                   END IF 
    338                   IF( jl == jptrc_zad ) THEN 
    339                       ! short and long title for Z advection for tracer 
    340                       WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 
    341                       WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58) 
    342                   END IF 
    343                   IF( jl == jptrc_xdf ) THEN 
    344                       ! short and long title for X diffusion for tracer 
    345                       WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 
    346                       WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
    347                   END IF 
    348                   IF( jl == jptrc_ydf ) THEN 
    349                       ! short and long title for Y diffusion for tracer 
    350                       WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 
    351                       WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
    352                   END IF 
    353                   IF( jl == jptrc_zdf ) THEN 
    354                       ! short and long title for Z diffusion for tracer 
    355                       WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 
    356                       WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
    357                   END IF 
    358 # if defined key_trcldf_eiv 
    359                   IF( jl == jptrc_xei ) THEN 
    360                       ! short and long title for x gent velocity for tracer 
    361                       WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 
    362                       WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
    363                   END IF 
    364                   IF( jl == jptrc_yei ) THEN 
    365                       ! short and long title for y gent velocity for tracer 
    366                       WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 
    367                       WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
    368                   END IF 
    369                   IF( jl == jptrc_zei ) THEN 
    370                       ! short and long title for Z gent velocity for tracer 
    371                       WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 
    372                       WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
    373                   END IF 
    374 # endif 
    375 # if defined key_trcdmp 
    376                   IF( jl == jptrc_dmp ) THEN 
    377                       ! last trends for tracer damping : short and long title 
    378                       WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 
    379                       WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55) 
    380                   END IF 
    381 # endif 
    382                   IF( jl == jptrc_sbc ) THEN 
    383                       ! last trends for tracer damping : short and long title 
    384                       WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 
    385                       WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 
    386                   END IF 
    387                       WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 
    388                   END IF 
    389                   CALL FLUSH( numout ) 
    390                   cltrau = ctrcun(jn)      ! UNIT for tracer /trends 
    391                   CALL histdef( nit6(jn), cltra, cltral, cltrau, jpi,jpj,  & 
    392                      &          nhorit6(jn), ipk, 1, ipk,  ndepit6(jn), 32, clop ,  & 
    393                      &          zsto,zout ) 
    394                END DO 
    395             END IF 
    396          END DO 
    397          ! CLOSE netcdf Files 
    398           DO jn = 1, jptra 
    399              IF( luttrd(jn) )   CALL histend( nit6(jn) ) 
    400           END DO 
    401  
    402          IF(lwp) WRITE(numout,*) 
    403          IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdid' 
    404          IF(ll_print) CALL FLUSH(numout ) 
    405          ! 
    406       ENDIF 
    407  
    408       ! SOME diagnostics to DO first time 
    409  
    410       ! Start writing data 
    411       ! --------------------- 
    412  
    413       ! trends for tracer concentrations 
    414  
    415       IF( lwp .AND. MOD( itmod, nwritetrd ) == 0 ) THEN 
    416          WRITE(numout,*) 'trcdid_wr : write NetCDF dynamical trends at ', kt, 'time-step' 
    417          WRITE(numout,*) '~~~~~~ ' 
    418       ENDIF 
    419  
    420       DO jn = 1, jptra 
    421          IF( luttrd(jn) ) THEN 
    422             ikn = ikeep(jn)  
    423             DO jl = 1, jpdiatrc 
    424                ! short titles 
    425                IF( jl == jptrc_xad)   WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 
    426                IF( jl == jptrc_yad)   WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 
    427                IF( jl == jptrc_zad)   WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 
    428                IF( jl == jptrc_xdf)   WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 
    429                IF( jl == jptrc_ydf)   WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 
    430                IF( jl == jptrc_zdf)   WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 
    431 # if defined key_trcldf_eiv 
    432                IF( jl == jptrc_xei)   WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 
    433                IF( jl == jptrc_yei)   WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 
    434                IF( jl == jptrc_zei)   WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 
    435 # endif 
    436 # if defined key_trcdmp 
    437                IF( jl == jptrc_dmp )  WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 
    438 # endif 
    439                IF( jl == jptrc_sbc )  WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 
    440                ! 
    441                CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50) 
    442             END DO 
    443          END IF 
    444       END DO 
    445  
    446       ! Closing all files 
    447       ! ----------------- 
    448       IF( kt == nitend .OR. kindic < 0 ) THEN 
    449          DO jn = 1, jptra 
    450             IF( luttrd(jn) )   CALL histclo( nit6(jn) ) 
    451          END DO 
    452       ENDIF 
    453       ! 
    454  
    455    END SUBROUTINE trcdid_wr 
    456  
    457 # else 
    458  
    459    SUBROUTINE trcdid_wr( kt, kindic )                      ! Dummy routine 
    460       INTEGER, INTENT ( in ) ::   kt, kindic 
    461    END SUBROUTINE trcdid_wr 
    462  
    463 # endif 
    464  
    465 #if defined key_trc_diaadd 
     221#if defined key_diatrc 
    466222 
    467223   SUBROUTINE trcdii_wr( kt, kindic ) 
    … …  
    489245      CHARACTER (len=80) ::   cltral 
    490246      INTEGER  ::   jl 
    491       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
     247      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    492248      REAL(wp) ::   zsto, zout, zdt 
    493249      !!---------------------------------------------------------------------- 
    … …  
    506262      ENDIF 
    507263#  if defined key_diainstant 
    508       zsto = nwritedia * zdt 
     264      zsto = nn_writedia * zdt 
    509265      clop = "inst("//TRIM(clop)//")" 
    510266#  else 
    … …  
    512268      clop = "ave("//TRIM(clop)//")" 
    513269#  endif 
    514       zout = nwritedia * zdt 
     270      zout = nn_writedia * zdt 
    515271 
    516272      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    520276 
    521277      ! define time axis 
    522       itmod = kt - nittrc000 + 1 
     278      itmod = kt - nit000 + 1 
    523279      it    = kt 
     280      iiter = ( nit000 - 1 ) / nn_dttrc 
    524281 
    525282      ! 1. Define NETCDF files and fields at beginning of first time step 
    … …  
    528285      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 
    529286 
    530       IF( kt == nittrc000 ) THEN 
     287      IF( kt == nit000 ) THEN 
    531288 
    532289         ! Define the NETCDF files for additional arrays : 2D or 3D 
    … …  
    534291         ! Define the T grid file for tracer auxiliary files 
    535292 
    536          CALL dia_nam( clhstnam, nwritedia, 'diad_T' ) 
     293         CALL dia_nam( clhstnam, nn_writedia, 'diad_T' ) 
    537294         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 
    538295 
    … …  
    541298         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             & 
    542299            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    543             &          nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
     300            &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set ) 
    544301 
    545302         ! Vertical grid for 2d and 3d arrays 
    … …  
    570327 
    571328         ! CLOSE netcdf Files 
    572          CALL histend( nitd ) 
     329         CALL histend( nitd, snc4set ) 
    573330 
    574331         IF(lwp) WRITE(numout,*) 
    … …  
    581338      ! --------------------- 
    582339 
    583       IF( lwp .AND. MOD( itmod, nwritedia ) == 0 ) THEN 
     340      IF( lwp .AND. MOD( itmod, nn_writedia ) == 0 ) THEN 
    584341         WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step' 
    585342         WRITE(numout,*) '~~~~~~ ' 
    … …  
    606363 
    607364# else 
    608  
    609365   SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine 
    610366      INTEGER, INTENT ( in ) :: kt, kindic 
    611367   END SUBROUTINE trcdii_wr 
    612  
    613368# endif 
    614369 
    615 # if defined key_trc_diabio 
     370# if defined key_diabio 
    616371 
    617372   SUBROUTINE trcdib_wr( kt, kindic ) 
    … …  
    631386      !!        IF kindic >0, output of fields before the time step loop 
    632387      !!---------------------------------------------------------------------- 
    633       !! 
    634388      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    635389      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
    … …  
    640394      CHARACTER (len=80) ::   cltral 
    641395      INTEGER  ::   ji, jj, jk, jl 
    642       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
     396      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    643397      REAL(wp) ::   zsto, zout, zdt 
    644398      !!---------------------------------------------------------------------- 
    … …  
    658412      ENDIF 
    659413#        if defined key_diainstant 
    660       zsto = nwritebio * zdt 
     414      zsto = nn_writebio * zdt 
    661415      clop = "inst("//TRIM(clop)//")" 
    662416#        else 
    … …  
    664418      clop = "ave("//TRIM(clop)//")" 
    665419#        endif 
    666       zout = nwritebio * zdt 
     420      zout = nn_writebio * zdt 
    667421 
    668422      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    672426 
    673427      ! define time axis 
    674       itmod = kt - nittrc000 + 1 
     428      itmod = kt - nit000 + 1 
    675429      it    = kt 
     430      iiter = ( nit000 - 1 ) / nn_dttrc 
    676431 
    677432      ! Define NETCDF files and fields at beginning of first time step 
    … …  
    680435      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 
    681436 
    682       IF( kt == nittrc000 ) THEN 
     437      IF( kt == nit000 ) THEN 
    683438 
    684439         ! Define the NETCDF files for biological trends 
    685440 
    686          CALL dia_nam(clhstnam,nwritebio,'biolog') 
     441         CALL dia_nam(clhstnam,nn_writebio,'biolog') 
    687442         IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam 
    688443         ! Horizontal grid : glamt and gphit 
    689444         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      & 
    690445            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
    691             &    nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
     446            &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set ) 
    692447         ! Vertical grid for biological trends 
    693448         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb) 
    … …  
    704459 
    705460         ! CLOSE netcdf Files 
    706           CALL histend( nitb ) 
     461          CALL histend( nitb, snc4set ) 
    707462 
    708463         IF(lwp) WRITE(numout,*) 
    … …  
    716471 
    717472      ! biological trends 
    718       IF( lwp .AND. MOD( itmod, nwritebio ) == 0 ) THEN 
     473      IF( lwp .AND. MOD( itmod, nn_writebio ) == 0 ) THEN 
    719474         WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step' 
    720475         WRITE(numout,*) '~~~~~~ ' 
    … …  
    749504      INTEGER, INTENT(in) :: kt 
    750505   END SUBROUTINE trc_dia    
    751  
    752506#endif 
    753507 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    • Property svn:eol-style deleted
    r1801 r2528  
    3636#  include "top_substitute.h90" 
    3737   !!---------------------------------------------------------------------- 
    38    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     38   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3939   !! $Id$  
    40    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
     40   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4342CONTAINS 
    4443 
    45    !!---------------------------------------------------------------------- 
    46    !!   Default case                                            NetCDF file 
    47    !!---------------------------------------------------------------------- 
    48     
    4944   SUBROUTINE trc_dta( kt ) 
    5045      !!---------------------------------------------------------------------- 
    … …  
    6358      !! 
    6459      CHARACTER (len=39) ::   clname(jptra) 
    65       INTEGER, PARAMETER ::   & 
    66          jpmonth = 12    ! number of months 
     60      INTEGER, PARAMETER ::   jpmonth = 12    ! number of months 
    6761      INTEGER ::   ji, jj, jn, jl  
    6862      INTEGER ::   imois, iman, i15, ik  ! temporary integers  
    6963      REAL(wp) ::   zxy, zl 
     64!!gm HERE the daymod should be used instead of computation of month and co !! 
     65!!gm      better in case of real calandar and leap-years ! 
    7066      !!---------------------------------------------------------------------- 
    7167 
    … …  
    7470         IF( lutini(jn) ) THEN  
    7571 
    76             IF ( kt == nittrc000 ) THEN 
     72            IF ( kt == nit000 ) THEN 
    7773               !! 3D tracer data 
    7874               IF(lwp)WRITE(numout,*) 
    … …  
    9288            ! -------------------- 
    9389 
    94             IF ( kt == nittrc000 .AND. nlectr(jn) == 0 ) THEN 
     90            IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN 
    9591               ntrc1(jn) = 0 
    9692               IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields' 
    … …  
    107103# if defined key_pisces 
    108104            ! Read montly file 
    109             IF( ( kt == nittrc000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN 
     105            IF( ( kt == nit000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN 
    110106               nlectr(jn) = 1 
    111107 
    … …  
    142138                     DO jj = 1, jpj                ! interpolation of temperature at the last level 
    143139                        DO ji = 1, jpi 
    144                            ik = mbathy(ji,jj) - 1 
     140                           ik = mbkt(ji,jj) 
    145141                           IF( ik > 2 ) THEN 
    146142                              zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
    … …  
    189185# else 
    190186            ! Read init file only 
    191             IF( kt == nittrc000  ) THEN 
     187            IF( kt == nit000  ) THEN 
    192188               ntrc1(jn) = 1 
    193189               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 
    … …  
    196192            ENDIF  
    197193# endif 
    198  
    199194         ENDIF 
    200195 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    • Property svn:eol-style deleted
    r1836 r2528  
    1414   !!---------------------------------------------------------------------- 
    1515   !!---------------------------------------------------------------------- 
    16    !!   trc_ini :   Initialization for passive tracer 
     16   !!   trc_init :   Initialization for passive tracer 
    1717   !!---------------------------------------------------------------------- 
    1818   USE oce_trc 
    1919   USE trc 
    20    USE trp_trc 
    2120   USE trcrst 
    22    USE trcctl 
    23    USE trclec 
     21   USE trcnam          ! Namelist read 
    2422   USE trcini_cfc      ! CFC      initialisation 
    2523   USE trcini_lobster  ! LOBSTER  initialisation 
    … …  
    2826   USE trcini_my_trc   ! MY_TRC   initialisation 
    2927   USE trcdta    
    30 #if defined key_off_tra  
     28#if defined key_offline 
    3129   USE daymod 
    3230#endif 
    33    USE zpshde_trc      ! partial step: hor. derivative  
     31   USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    3432   USE in_out_manager  ! I/O manager 
    3533   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    3634   USE lib_mpp         ! distributed memory computing library 
     35   USE lib_fortran     !  
    3736    
    3837   IMPLICIT NONE 
    3938   PRIVATE 
    4039    
    41    PUBLIC   trc_ini   ! called by opa 
     40   PUBLIC   trc_init   ! called by opa 
    4241 
    4342    !! * Substitutions 
    4443#  include "domzgr_substitute.h90" 
    45    !!---------------------------------------------------------------------- 
    46    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    47    !! $Id$  
    48    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    49    !!---------------------------------------------------------------------- 
    5044   
    5145CONTAINS 
    5246    
    53    SUBROUTINE trc_ini 
     47   SUBROUTINE trc_init 
    5448      !!--------------------------------------------------------------------- 
    55       !!                     ***  ROUTINE trc_ini  *** 
     49      !!                     ***  ROUTINE trc_init  *** 
    5650      !! 
    5751      !! ** Purpose :   Initialization of the passive tracer fields  
    … …  
    6963 
    7064      IF(lwp) WRITE(numout,*) 
    71       IF(lwp) WRITE(numout,*) 'trc_ini : initial set up of the passive tracers' 
     65      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 
    7266      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    7367 
    7468      !                 ! masked grid volume 
    7569      DO jk = 1, jpk 
    76          cvol(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
     70         cvol(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)  
    7771      END DO 
    7872 
    7973      ! total volume of the ocean 
    80 #if ! defined key_off_degrad 
    81       areatot = SUM( cvol(:,:,:) ) 
     74#if ! defined key_degrad 
     75      areatot = glob_sum( cvol(:,:,:) ) 
    8276#else 
    83       areatot = SUM( cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol 
     77      areatot = glob_sum( cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol 
    8478#endif 
    85       IF( lk_mpp )   CALL mpp_sum( areatot )     ! sum over the global domain   
    8679 
    87                                   CALL trc_lec      ! READ passive tracers namelists 
     80                                  CALL trc_nam      ! read passive tracers namelists 
    8881 
    89                                   CALL trc_ctl      ! control consistency between parameters, cpp key 
     82      ! restart for passive tracer (input) 
     83      IF( ln_rsttr ) THEN 
     84         IF(lwp) WRITE(numout,*) '       read a restart file for passive tracer : ', cn_trcrst_in 
     85         IF(lwp) WRITE(numout,*) ' ' 
     86      ELSE 
     87         IF(lwp) WRITE(numout,*) 
     88         DO jn = 1, jptra 
     89            IF( lwp .AND. lutini(jn) )  &                  ! open input FILE only IF lutini(jn) is true 
     90            &  WRITE(numout,*) '        read an initial file  for passive tracer number :', jn, ' traceur : ', ctrcnm(jn)  
     91         END DO 
     92      ENDIF 
     93 
     94      IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    & 
     95         &       CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' ) 
     96 
     97      IF( nn_cla == 1 )   & 
     98         &       CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    9099 
    91100      IF( lk_lobster ) THEN   ;   CALL trc_ini_lobster      ! LOBSTER bio-model 
    … …  
    109118      ENDIF 
    110119 
    111       IF( .NOT. ln_rsttr ) THEN  
    112 #if defined key_off_tra 
    113          CALL day_init      ! calendar 
    114 #endif 
    115 # if defined key_dtatrc 
    116          ! Initialization of tracer from a file that may also be used for damping 
    117          CALL trc_dta( nittrc000 ) 
    118          DO jn = 1, jptra 
    119             IF( lutini(jn) )   trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required 
    120          END DO 
    121 # endif 
    122          trb(:,:,:,:) = trn(:,:,:,:) 
     120      IF( ln_rsttr ) THEN 
     121        ! 
     122        IF( lk_offline )  neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
     123        CALL trc_rst_read              ! restart from a file 
     124        ! 
    123125      ELSE 
    124          ! 
    125          CALL trc_rst_read      ! restart from a file 
    126          ! 
     126        IF( lk_offline )  THEN 
     127           neuler = 0                  ! Set time-step indicator at nit000 (euler) 
     128           CALL day_init               ! set calendar 
     129        ENDIF 
     130        IF( lk_dtatrc )  THEN 
     131           CALL trc_dta( nit000 )      ! Initialization of tracer from a file that may also be used for damping 
     132           DO jn = 1, jptra 
     133              IF( lutini(jn) )   trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required 
     134           END DO 
     135        ENDIF  
     136        trb(:,:,:,:) = trn(:,:,:,:) 
     137        !  
    127138      ENDIF 
    128  
     139  
    129140      tra(:,:,:,:) = 0. 
    130141       
    131       IF( ln_zps .AND. .NOT. lk_trc_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    132       &                     CALL zps_hde_trc( nittrc000, trb, gtru, gtrv )       ! tracers at the bottom ocean level 
     142      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive 
     143      &                     CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
    133144 
    134145 
    … …  
    136147      trai = 0.e0 
    137148      DO jn = 1, jptra 
    138 #if ! defined key_off_degrad 
    139          trai = trai + SUM( trn(:,:,:,jn) * cvol(:,:,:) ) 
     149#if ! defined key_degrad 
     150         trai = trai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 
    140151#else 
    141          trai = trai + SUM( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol 
     152         trai = trai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol 
    142153#endif 
    143154      END DO       
    144       IF( lk_mpp )   CALL mpp_sum( trai )     ! sum over the global domain   
    145  
    146155 
    147156      !                 ! control print 
    … …  
    162171      ENDIF 
    163172 
    164    END SUBROUTINE trc_ini 
     173   END SUBROUTINE trc_init 
    165174 
    166175#else 
    … …  
    169178   !!---------------------------------------------------------------------- 
    170179CONTAINS 
    171    SUBROUTINE trc_ini                      ! Dummy routine    
    172    END SUBROUTINE trc_ini 
     180   SUBROUTINE trc_init                      ! Dummy routine    
     181   END SUBROUTINE trc_init 
    173182#endif 
    174183 
     184   !!---------------------------------------------------------------------- 
     185   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     186   !! $Id$  
     187   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    175188   !!====================================================================== 
    176189END MODULE trcini 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    • Property svn:eol-style deleted
    r1836 r2528  
    2525   USE oce_trc 
    2626   USE trc 
    27    USE trctrp_lec 
     27   USE trcnam_trp 
    2828   USE lib_mpp 
     29   USE lib_fortran 
    2930   USE iom 
    3031   USE trcrst_cfc      ! CFC       
    … …  
    3334   USE trcrst_c14b     ! C14 bomb restart 
    3435   USE trcrst_my_trc   ! MY_TRC   restart 
    35 #if defined key_off_tra 
    36     USE daymod 
    37 #endif 
     36   USE daymod 
    3837   IMPLICIT NONE 
    3938   PRIVATE 
    … …  
    4746   !! * Substitutions 
    4847#  include "top_substitute.h90" 
    49    !!---------------------------------------------------------------------- 
    50    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    51    !! $Id$  
    52    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    53    !!---------------------------------------------------------------------- 
    5448    
    5549CONTAINS 
    … …  
    6761      !!---------------------------------------------------------------------- 
    6862      ! 
    69 # if ! defined key_off_tra 
    70       IF( kt == nit000 ) lrst_trc = .FALSE.  
    71 # else 
    72       IF( kt == nit000 ) THEN 
    73         lrst_trc = .FALSE.  
    74         nitrst = nitend   
    75       ENDIF 
    76  
    77       IF( MOD( kt - 1, nstock ) == 0 ) THEN 
    78          ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    79          nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    80          IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    81       ENDIF 
    82 # endif 
    83      ! to get better performances with NetCDF format: 
    84      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*ndttrc + 1) 
    85      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*ndttrc + 1 
    86      IF( kt == nitrst - 2*ndttrc + 1 .OR. nstock == ndttrc .OR. ( kt == nitend - ndttrc + 1 .AND. .NOT. lrst_trc ) ) THEN 
     63      IF( lk_offline ) THEN 
     64         IF( kt == nit000 ) THEN 
     65            lrst_trc = .FALSE. 
     66            nitrst = nitend 
     67         ENDIF 
     68 
     69         IF( MOD( kt - 1, nstock ) == 0 ) THEN 
     70            ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
     71            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     72            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
     73         ENDIF 
     74      ELSE 
     75         IF( kt == nit000 ) lrst_trc = .FALSE. 
     76      ENDIF 
     77 
     78      ! to get better performances with NetCDF format: 
     79      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
     80      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
     81      IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1 .AND. .NOT. lrst_trc ) ) THEN 
    8782         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    8883         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    … …  
    106101      !!---------------------------------------------------------------------- 
    107102      INTEGER  ::  jn      
    108       INTEGER  ::  iarak0  
    109       REAL(wp) ::  zarak0 
    110103      INTEGER  ::  jlibalt = jprstlib 
    111104      LOGICAL  ::  llok 
    … …  
    128121      ! Time domain : restart 
    129122      ! --------------------- 
    130       CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar 
    131  
    132       IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   iarak0 = 1 
    133       ELSE                                           ;   iarak0 = 0 
    134       ENDIF 
    135       CALL iom_get( numrtr, 'arak0', zarak0 ) 
    136  
    137       IF( iarak0 /= NINT( zarak0 ) )   &                           ! Control of the scheme 
    138          & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 
    139          & ' it must be the same type for both restart and previous run', & 
    140          & ' centered or euler '  ) 
    141       IF(lwp) WRITE(numout,*) 
    142       IF(lwp) WRITE(numout,*) '    arakawa option      : ', NINT( zarak0 ) 
     123      CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    143124 
    144125      ! READ prognostic variables and computes diagnostic variable 
    … …  
    175156 
    176157      CALL trc_rst_cal( kt, 'WRITE' )   ! calendar 
    177  
    178       IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   zarak0 = 1. 
    179       ELSE                                           ;   zarak0 = 0. 
    180       ENDIF 
    181       CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 
    182  
     158      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step 
    183159      ! prognostic variables  
    184160      ! --------------------  
    … …  
    222198      !! 
    223199      !!   According to namelist parameter nrstdt, 
    224       !!       nrsttr = 0  no control on the date (nittrc000 is  arbitrary). 
    225       !!       nrsttr = 1  we verify that nit000 is equal to the last 
     200      !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary). 
     201      !!       nn_rsttr = 1  we verify that nit000 is equal to the last 
    226202      !!                   time step of previous run + 1. 
    227203      !!       In both those options, the  exact duration of the experiment 
    … …  
    230206      !!       This is valid is the time step has remained constant. 
    231207      !! 
    232       !!       nrsttr = 2  the duration of the experiment in days (adatrj) 
     208      !!       nn_rsttr = 2  the duration of the experiment in days (adatrj) 
    233209      !!                    has been stored in the restart file. 
    234210      !!---------------------------------------------------------------------- 
    … …  
    236212      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    237213      ! 
    238       REAL(wp) ::  zkt 
    239 #if defined key_off_tra 
     214      REAL(wp) ::  zkt, zrdttrc1 
    240215      REAL(wp) ::  zndastp 
    241 #endif 
    242216 
    243217      ! Time domain : restart 
    … …  
    250224            WRITE(numout,*) '   previous time-step                               : ', NINT( zkt ) 
    251225            WRITE(numout,*) ' *** restart option' 
    252             SELECT CASE ( nrsttr ) 
    253             CASE ( 0 )   ;   WRITE(numout,*) ' nrsttr = 0 : no control of nittrc000' 
    254             CASE ( 1 )   ;   WRITE(numout,*) ' nrsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
    255             CASE ( 2 )   ;   WRITE(numout,*) ' nrsttr = 2 : calendar parameters read in restart' 
     226            SELECT CASE ( nn_rsttr ) 
     227            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000' 
     228            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
     229            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
    256230            END SELECT 
    257231            WRITE(numout,*) 
    258232         ENDIF 
    259233         ! Control of date  
    260          IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nrsttr /= 0 )                                  & 
     234         IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
    261235            &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
    262             &                  ' verify the restart file or rerun with nrsttr = 0 (namelist)' ) 
    263 #if defined key_off_tra 
    264          ! define ndastp and adatrj 
    265          IF ( nrsttr == 2 ) THEN 
    266             CALL iom_get( numrtr, 'ndastp', zndastp )  
    267             ndastp = NINT( zndastp ) 
    268             CALL iom_get( numrtr, 'adatrj', adatrj  ) 
    269          ELSE 
    270             ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    271             adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
    272             ! note this is wrong if time step has changed during run 
     236            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
     237         IF( lk_offline ) THEN      ! set the date in offline mode 
     238            ! Check dynamics and tracer time-step consistency and force Euler restart if changed 
     239            IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN 
     240               CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 ) 
     241               IF( zrdttrc1 /= rdttrc(1) )   neuler = 0 
     242            ENDIF 
     243            !                          ! define ndastp and adatrj 
     244            IF ( nn_rsttr == 2 ) THEN 
     245               CALL iom_get( numrtr, 'ndastp', zndastp )  
     246               ndastp = NINT( zndastp ) 
     247               CALL iom_get( numrtr, 'adatrj', adatrj  ) 
     248            ELSE 
     249               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
     250               adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     251               ! note this is wrong if time step has changed during run 
     252            ENDIF 
     253            ! 
     254            IF(lwp) THEN 
     255              WRITE(numout,*) ' *** Info used values : ' 
     256              WRITE(numout,*) '   date ndastp                                      : ', ndastp 
     257              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
     258              WRITE(numout,*) 
     259            ENDIF 
     260            ! 
     261            CALL day_init          ! compute calendar 
     262            ! 
    273263         ENDIF 
    274264         ! 
    275          IF(lwp) THEN 
    276            WRITE(numout,*) ' *** Info used values : ' 
    277            WRITE(numout,*) '   date ndastp                                      : ', ndastp 
    278            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj 
    279            WRITE(numout,*) 
    280          ENDIF 
    281          ! 
    282          CALL day_init          ! compute calendar 
    283          ! 
    284 #endif 
    285  
    286265      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
    287266         ! 
    … …  
    291270            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    292271         ENDIF 
    293          ! calendar control 
    294272         CALL iom_rstput( kt, nitrst, numrtw, 'kt'     , REAL( kt    , wp) )   ! time-step 
    295273         CALL iom_rstput( kt, nitrst, numrtw, 'ndastp' , REAL( ndastp, wp) )   ! date 
    … …  
    308286      !!---------------------------------------------------------------------- 
    309287 
    310       INTEGER  :: ji, jj, jk, jn 
     288      INTEGER  :: jn 
    311289      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 
    312       REAL(wp) :: zder, zvol 
     290      REAL(wp) :: zder 
    313291      !!---------------------------------------------------------------------- 
    314292 
    … …  
    322300      zdiag_tot = 0.e0 
    323301      DO jn = 1, jptra 
    324          zdiag_var    = 0.e0 
    325          zdiag_varmin = 0.e0 
    326          zdiag_varmax = 0.e0 
    327          DO jk = 1, jpk 
    328             DO jj = 1, jpj 
    329                DO ji = 1, jpi 
    330                   zvol = cvol(ji,jj,jk) 
    331 #  if defined key_off_degrad 
    332                   zvol = zvol * facvol(ji,jj,jk) 
     302#  if defined key_degrad 
     303         zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) 
     304#  else 
     305         zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:)  ) 
    333306#  endif 
    334                   zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * zvol 
    335                END DO 
    336             END DO 
    337          END DO 
    338           
    339307         zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    340308         zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    … …  
    342310            CALL mpp_min( zdiag_varmin )      ! min over the global domain 
    343311            CALL mpp_max( zdiag_varmax )      ! max over the global domain 
    344             CALL mpp_sum( zdiag_var    )      ! sum over the global domain 
    345312         END IF 
    346313         zdiag_tot = zdiag_tot + zdiag_var 
    … …  
    369336#endif 
    370337 
     338   !!---------------------------------------------------------------------- 
     339   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     340   !! $Id$  
     341   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    371342   !!====================================================================== 
    372343END MODULE trcrst 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    • Property svn:eol-style deleted
    r1254 r2528  
    2828 
    2929   !!---------------------------------------------------------------------- 
    30    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     30   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3131   !! $Id$  
    32    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     32   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 
    3434 
    … …  
    4848      !!--------------------------------------------------------------------- 
    4949 
    50       IF ( MOD(kt,ndttrc) /= 0) RETURN      ! this ROUTINE is called only every ndttrc time step 
     50      IF ( MOD( kt, nn_dttrc) /= 0 ) RETURN      ! this ROUTINE is called only every ndttrc time step 
    5151 
    5252      IF( lk_lobster )   CALL trc_sms_lobster( kt )    ! main program of LOBSTER 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    • Property svn:keywords set to Id
    r1457 r2528  
    44   !! Time-stepping    : time loop of opa for passive tracer 
    55   !!====================================================================== 
     6   !! History :  1.0  !  2004-03  (C. Ethe)  Original 
     7   !!---------------------------------------------------------------------- 
    68#if defined key_top 
    79   !!---------------------------------------------------------------------- 
    810   !!   trc_stp      : passive tracer system time-stepping 
    911   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1112   USE oce_trc          ! ocean dynamics and active tracers variables 
    12    USE trp_trc 
     13   USE trc 
    1314   USE trctrp           ! passive tracers transport 
    1415   USE trcsms           ! passive tracers sources and sinks 
    … …  
    1718   USE trcwri 
    1819   USE trcrst 
    19    USE trdmld_trc_oce 
     20   USE trdmod_trc_oce 
    2021   USE trdmld_trc 
    2122   USE iom 
    … …  
    2526   PRIVATE 
    2627 
    27    !! * Routine accessibility 
    28    PUBLIC trc_stp           ! called by step 
     28   PUBLIC   trc_stp    ! called by step 
     29    
    2930   !!---------------------------------------------------------------------- 
    30    !!   TOP 1.0 , LOCEAN-IPSL (2005)  
    31    !! $Id: trcstp.F90 1285 2009-02-03 13:38:51Z cetlod $  
    32    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     31   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     32   !! $Id$  
     33   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3334   !!---------------------------------------------------------------------- 
    34  
    3535CONTAINS 
    3636 
    … …  
    4444      !!              Compute the passive tracers trends  
    4545      !!              Update the passive tracers 
    46       !! 
    47       !! History : 
    48       !!   9.0  !  04-03  (C. Ethe)  Original 
    4946      !!------------------------------------------------------------------- 
    50       !! * Arguments 
    5147      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
    5248      CHARACTER (len=25)    ::  charout 
     49      !!------------------------------------------------------------------- 
    5350 
    54       ! this ROUTINE is called only every ndttrc time step 
    55       IF( MOD( kt , ndttrc ) /= 0 ) RETURN 
    56  
    57       IF(ln_ctl) THEN 
    58          WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    59          CALL prt_ctl_trc_info(charout) 
     51      IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
     52         ! 
     53         IF(ln_ctl) THEN 
     54            WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
     55            CALL prt_ctl_trc_info(charout) 
     56         ENDIF 
     57         ! 
     58         tra(:,:,:,:) = 0.e0 
     59         ! 
     60         IF( kt == nit000 .AND. lk_trdmld_trc  )  & 
     61            &                      CALL trd_mld_trc_init        ! trends: Mixed-layer 
     62                                   CALL trc_rst_opn( kt )       ! Open tracer restart file  
     63         IF( lk_iomput ) THEN  ;   CALL trc_wri( kt )           ! output of passive tracers 
     64         ELSE                  ;   CALL trc_dia( kt ) 
     65         ENDIF 
     66                                   CALL trc_sms( kt )           ! tracers: sink and source 
     67                                   CALL trc_trp( kt )           ! transport of passive tracers 
     68         IF( kt == nit000 )     CALL iom_close( numrtr )     ! close input  passive tracers restart file 
     69         IF( lrst_trc )            CALL trc_rst_wri( kt )       ! write tracer restart file 
     70         IF( lk_trdmld_trc  )      CALL trd_mld_trc( kt )       ! trends: Mixed-layer 
     71         ! 
    6072      ENDIF 
    61  
    62       IF( kt == nittrc000 .AND. lk_trdmld_trc  )  & 
    63          &                   CALL trd_mld_trc_init        ! trends: Mixed-layer 
    64                              CALL trc_rst_opn( kt )       ! Open tracer restart file  
    65                              CALL trc_sms( kt )           ! tracers: sink and source 
    66                              CALL trc_trp( kt )           ! transport of passive tracers 
    67       IF( kt == nittrc000 )  CALL iom_close( numrtr )     ! close input  passive tracers restart file 
    68       IF( lrst_trc )         CALL trc_rst_wri( kt )       ! write tracer restart file 
    69       IF( lk_iomput ) THEN 
    70                              CALL trc_wri( kt )           ! output of passive tracers 
    71       ELSE 
    72                              CALL trc_dia( kt )   ! diagnostics 
    73       ENDIF 
    74       IF( lk_trdmld_trc  )   CALL trd_mld_trc( kt )     ! trends: Mixed-layer 
    7573 
    7674   END SUBROUTINE trc_stp 
    … …  
    8280CONTAINS 
    8381   SUBROUTINE trc_stp( kt )        ! Empty routine 
    84       INTEGER, INTENT(in) :: kt 
    8582      WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt 
    8683   END SUBROUTINE trc_stp 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    • Property svn:keywords set to Id
    r1836 r2528  
    55   !!==================================================================================== 
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    7    !!                  !  2010-03 (C. Ethe, R. Seferian ) Add the tracer transport trends 
    87   !!---------------------------------------------------------------------- 
    98#if defined key_top &&  defined key_iomput 
    … …  
    1211   !!---------------------------------------------------------------------- 
    1312   !! trc_wri_trc   :  outputs of concentration fields 
    14    !! trc_wri_trd   :  outputs of transport trends 
    1513   !!---------------------------------------------------------------------- 
    1614   USE dom_oce         ! ocean space and time domain variables 
    1715   USE oce_trc 
    18    USE trp_trc 
    1916   USE trc 
    20    USE trdmld_trc_oce, ONLY : luttrd 
    2117   USE iom 
    22 #if defined key_off_tra 
    23    USE oce_trc 
    2418   USE dianam 
    25 #endif 
    2619 
    2720   IMPLICIT NONE 
    … …  
    3225   !! * Substitutions 
    3326#  include "top_substitute.h90" 
    34    !!---------------------------------------------------------------------- 
    35    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    36    !! $Id: trcdia.F90 1450 2009-05-15 14:12:12Z cetlod $  
    37    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    38    !!---------------------------------------------------------------------- 
    3927 
    4028CONTAINS 
    … …  
    5038 
    5139      ! 
    52       CALL iom_setkt  ( kt + ndttrc - 1 )       ! set the passive tracer time step 
     40      CALL iom_setkt  ( kt + nn_dttrc - 1 )       ! set the passive tracer time step 
    5341      CALL trc_wri_trc( kt              )       ! outputs for tracer concentration 
    54       CALL trc_wri_trd( kt              )       ! outputs for dynamical trends 
    5542      CALL iom_setkt  ( kt              )       ! set the model time step 
    5643      ! 
    … …  
    6552      INTEGER, INTENT( in ) :: kt       ! ocean time-step 
    6653      INTEGER               :: jn 
    67       CHARACTER (len=20)    :: cltra, cltras 
    68 #if defined key_off_tra 
     54      CHARACTER (len=20)    :: cltra 
    6955      CHARACTER (len=40) :: clhstnam 
    7056      INTEGER ::   inum = 11            ! temporary logical unit 
    71 #endif 
    7257      !!--------------------------------------------------------------------- 
    7358  
    74 #if defined key_off_tra 
    75       IF( kt == nittrc000 ) THEN 
    76         ! WRITE root name in date.file for use by postpro 
    77          IF(lwp) THEN 
    78             CALL dia_nam( clhstnam, nwritetrc,' ' ) 
    79             CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    80             WRITE(inum,*) clhstnam 
    81             CLOSE(inum) 
    82          ENDIF 
     59      IF( lk_offline .AND. kt == nit000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
     60         CALL dia_nam( clhstnam, nn_writetrc,' ' ) 
     61         CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     62         WRITE(inum,*) clhstnam 
     63         CLOSE(inum) 
    8364      ENDIF 
    84 #endif 
    8565      ! write the tracer concentrations in the file 
    8666      ! --------------------------------------- 
    … …  
    9272   END SUBROUTINE trc_wri_trc 
    9373 
    94 # if defined key_trc_diatrd 
    95  
    96    SUBROUTINE trc_wri_trd( kt ) 
    97       !!---------------------------------------------------------------------- 
    98       !!                     ***  ROUTINE trc_wri_trd  *** 
    99       !! 
    100       !! ** Purpose :   output of passive tracer : advection-diffusion trends 
    101       !! 
    102       !!---------------------------------------------------------------------- 
    103       INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    104       !! 
    105       CHARACTER (len=3) ::   cltra 
    106       INTEGER  ::   jn, jl, ikn 
    107       !!---------------------------------------------------------------------- 
    108  
    109       DO jn = 1, jptra 
    110          IF( luttrd(jn) ) THEN 
    111             ikn = ikeep(jn) 
    112             DO jl = 1, jpdiatrc 
    113                IF( jl == jptrc_xad ) WRITE (cltra,"(3a)") 'XAD' ! x advection for tracer 
    114                IF( jl == jptrc_yad ) WRITE (cltra,"(3a)") 'YAD'  ! y advection for tracer 
    115                IF( jl == jptrc_zad ) WRITE (cltra,"(3a)") 'ZAD'  ! z advection for tracer 
    116                IF( jl == jptrc_xdf ) WRITE (cltra,"(3a)") 'XDF'  ! x diffusion for tracer 
    117                IF( jl == jptrc_ydf ) WRITE (cltra,"(3a)") 'YDF'  ! y diffusion for tracer 
    118                IF( jl == jptrc_zdf ) WRITE (cltra,"(3a)") 'ZDF'  ! z diffusion for tracer 
    119 # if defined key_trcldf_eiv 
    120                IF( jl == jptrc_xei ) WRITE (cltra,"(3a)") 'XGV'  ! x gent velocity for tracer 
    121                IF( jl == jptrc_yei ) WRITE (cltra,"(3a)") 'YGV'  ! y gent velocity for tracer 
    122                IF( jl == jptrc_zei ) WRITE (cltra,"(3a)") 'ZGV'  ! z gent velocity for tracer 
    123 # endif 
    124 # if defined key_trcdmp 
    125                IF( jl == jptrc_dmp ) WRITE (cltra,"(3a)") 'DMP'  ! damping 
    126 # endif 
    127                IF( jl == jptrc_sbc ) WRITE (cltra,"(3a)") 'SBC'  ! surface boundary conditions 
    128                ! write the trends 
    129                CALL iom_put( cltra, trtrd(:,:,:,ikn,jl) ) 
    130             END DO 
    131          END IF 
    132       END DO 
    133       ! 
    134    END SUBROUTINE trc_wri_trd 
    135  
    136 # else 
    137    SUBROUTINE trc_wri_trd( kt )                      ! Dummy routine 
    138       INTEGER, INTENT ( in ) ::   kt 
    139    END SUBROUTINE trc_wri_trd 
    140 #endif 
    14174#else 
    14275   !!---------------------------------------------------------------------- 
    … …  
    15083#endif 
    15184 
     85   !!---------------------------------------------------------------------- 
     86   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     87   !! $Id$  
     88   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    15289   !!====================================================================== 
    15390END MODULE trcwri 
Note: See TracChangeset for help on using the changeset viewer.