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 763 – NEMO

Changeset 763


Ignore:
Timestamp:
2007-12-13T14:52:50+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - Style only addition in TOP F90 h90 routines

Location:
branches/dev_001_GM/NEMO/TOP_SRC
Files:
38 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/par_sms.F90

    r719 r763  
    11MODULE par_sms 
    2    !!--------------------------------------------------------------------- 
    3    !! 
    4    !!                         PARAMETER SMS 
    5    !!                       ******************************* 
    6    !! 
    7    !!  purpose : 
    8    !!  --------- 
    9    !!     INCLUDE PARAMETER FILE for SMS  models 
    10    !! 
    11    !! 
     2   !!====================================================================== 
     3   !!                         ***  MODULE par_sms  *** 
     4   !! TOP :   parameters of passive tracers 
     5   !!====================================================================== 
     6   !! History :   1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
    127   !!---------------------------------------------------------------------- 
    13    !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    14    !! $Header$  
    15    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     8   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     9   !! $Id:$  
     10   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     11   !!---------------------------------------------------------------------- 
     12#if defined key_passivetrc 
     13   !!---------------------------------------------------------------------- 
     14   !!   'key_passivetrc'                                    Passive tracers 
    1615   !!---------------------------------------------------------------------- 
    1716   USE par_trc_trp 
     17 
    1818   IMPLICIT NONE 
    1919 
    … …  
    3232#elif defined key_cfc 
    3333   !!---------------------------------------------------------------------- 
    34    !!   'key_cfc  '                                          CFC model                   
     34   !!   'key_cfc  '                                      CFC chemical model                   
    3535   !!---------------------------------------------------------------------- 
    3636#  include "par_sms_cfc.h90" 
    3737 
    3838#else 
    39    !!  purpose : 
    40    !!  --------- 
    41    !!     No SMS  models 
     39   !!---------------------------------------------------------------------- 
     40   !!  Empty module :                                     No passive tracer 
     41   !!---------------------------------------------------------------------- 
    4242#endif 
    4343 
     44   !!====================================================================== 
    4445END MODULE par_sms 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/par_sms_cfc.h90

    r719 r763  
    55 
    66   !!---------------------------------------------------------------------- 
    7    !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    8    !! $Header$  
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     7   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     8   !! $Id:$  
     9   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1010   !!---------------------------------------------------------------------- 
    1111 
    12    INTEGER , PARAMETER :: & 
    13       jpyear = 100,       & ! temporal parameter  
    14       jphem  = 2            ! hemispheric parameter 
     12   INTEGER, PARAMETER ::   jpyear = 100   ! temporal parameter  
     13   INTEGER, PARAMETER ::   jphem  = 2     ! hemispheric parameter 
    1514 
    16    INTEGER, PARAMETER ::  &  
    17       jp11 = 1,           & ! CFC-11 
    18       jp12 = 2              ! CFC-12 
     15   INTEGER, PARAMETER ::   jp11   = 1     ! CFC-11 
     16   INTEGER, PARAMETER ::   jp12   = 2     ! CFC-12 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/par_sms_lobster1.h90

    r719 r763  
    1 !!--------------------------------------------------------------------- 
    2 !! 
    3 !!                         PARAMETER passivetrc.lobster1 
    4 !!                       ******************************** 
    5 !! 
    6 !!  purpose : 
    7 !!  --------- 
    8 !!     INCLUDE PARAMETER FILE for passive tracer LOBSTER1 model 
    9 !! 
    10 !!  modifications:   
    11 !!  -------------- 
    12 !!     00-12 (E. Kestenare):  
    13 !!            assign a parameter to name individual tracers 
    14 !! 
    15 !! productive layer depth 
    16 !! ---------------------- 
    17 !!       jpkb   : first vertical layers where biology is active 
    18 !!       jpkbm1 : jpkb - 1 
    19 !! 
    20 !!---------------------------------------------------------------------- 
    21 !!  TOP 1.0,  LOCEAN-IPSL (2005) 
    22 !! $Header$ 
    23 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    24 !!---------------------------------------------------------------------- 
     1   !!--------------------------------------------------------------------- 
     2   !!                     ***  par_sms_lobster1.h90  ***   
     3   !! TOP :   CFC Source Minus Sink parameter for LOBSTER 
     4   !!--------------------------------------------------------------------- 
     5   !! History :    -   !  1999-06  (M. Levy)  original code 
     6   !!              -   !  2000-12  (E. Kestenare) assign a parameter to name individual tracers 
     7   !!             1.0  !  2005-03  (C. Ethe) F90 
     8   !!---------------------------------------------------------------------- 
    259 
    26       INTEGER jpkb,jpkbm1 
    27       PARAMETER (jpkb = 12,jpkbm1 = 11) 
    28 !! 
    29 !! number of biological trends 
    30 !! --------------------------- 
    31 !! 
    32       INTEGER jpdiabio 
    33       PARAMETER (jpdiabio = 15) 
    34 !! 
    35 !!    NOW ASSIGN A PARAMETER TO NAME INDIVIDUAL TRACERS 
    36 !! 
    37 !!    JPDET : detritus (mmoleN/m3) 
    38 !!    JPZOO : zooplancton concentration (mmoleN/m3) 
    39 !!    JPPHY : phytoplancton concentration (mmoleN/m3) 
    40 !!    JPNO3 : nitrate concentration (mmoleN/m3) 
    41 !!    JPNH4 : ammonium concentration (mmoleN/m3) 
    42 !!    JPDOM : dissolved organic matter (mmoleN/m3) 
    43 !! 
    44       INTEGER jpdet,jpzoo,jpphy,jpno3,jpnh4,jpdom 
    45       PARAMETER (jpdet=1,jpzoo=2,jpphy=3,jpno3=4,jpnh4=5,jpdom=6) 
     10   !!---------------------------------------------------------------------- 
     11   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     12   !! $Id:$  
     13   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     14   !!---------------------------------------------------------------------- 
    4615 
     16   INTEGER, PARAMETER ::   jpkb     = 12        !: top jk layers where biology is active 
     17   INTEGER, PARAMETER ::   jpkbm1   = jpkb - 1  !: 
     18 
     19   INTEGER, PARAMETER ::   jpdiabio = 15        !: number of biological trends 
     20       
     21   INTEGER, PARAMETER ::   jpdet    = 1         !: detritus                    [mmoleN/m3] 
     22   INTEGER, PARAMETER ::   jpzoo    = 2         !: zooplancton concentration   [mmoleN/m3] 
     23   INTEGER, PARAMETER ::   jpphy    = 3         !: phytoplancton concentration [mmoleN/m3] 
     24   INTEGER, PARAMETER ::   jpno3    = 4         !: nitrate concentration       [mmoleN/m3] 
     25   INTEGER, PARAMETER ::   jpnh4    = 5         !: ammonium concentration      [mmoleN/m3] 
     26   INTEGER, PARAMETER ::   jpdom    = 6         !: dissolved organic matter    [mmoleN/m3] 
     27 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/par_sms_pisces.h90

    r719 r763  
    44   !!====================================================================== 
    55 
    6    INTEGER, PARAMETER ::  jpdiabio = 1 
     6   !!---------------------------------------------------------------------- 
     7   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     8   !! $Id:$  
     9   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     10   !!---------------------------------------------------------------------- 
    711 
    8    !! WARNING: BE CAREFUL ABOUT THE ORDER WHEN READING THE RESTART FILE 
    9    !! 
    10    INTEGER, PARAMETER :: & 
    11       jpdic = 1  ,  &  ! dissolved inoganic carbon concentration  
    12       jptal = 2  ,  &  ! total alkalinity  
    13       jpoxy = 3  ,  &  ! oxygen carbon concentration  
    14       jpcal = 4  ,  &  ! calcite  concentration  
    15       jppo4 = 5  ,  &  ! phosphate concentration  
    16       jppoc = 6  ,  &  ! small particulate organic phosphate concentration 
    17       jpsil = 7  ,  &  ! silicate concentration 
    18       jpphy = 8  ,  &  ! phytoplancton concentration  
    19       jpzoo = 9  ,  &  ! zooplancton concentration 
    20       jpdoc = 10 ,  &  ! dissolved organic carbon concentration  
    21       jpdia = 11 ,  &  ! Diatoms Concentration 
    22       jpmes = 12 ,  &  ! Mesozooplankton Concentration 
    23       jpbsi = 13 ,  &  ! (big) Silicate Concentration 
    24       jpfer = 14 ,  &  ! Iron Concentration 
     12   INTEGER, PARAMETER ::   jpdiabio = 1   !: number of biological trends 
     13 
     14   ! WARNING: BE CAREFUL ABOUT THE ORDER WHEN READING THE RESTART FILE 
     15 
     16   INTEGER, PARAMETER ::   jpdic =  1     !: dissolved inoganic carbon concentration  
     17   INTEGER, PARAMETER ::   jptal =  2     !: total alkalinity  
     18   INTEGER, PARAMETER ::   jpoxy =  3     !: oxygen carbon concentration  
     19   INTEGER, PARAMETER ::   jpcal =  4     !: calcite  concentration  
     20   INTEGER, PARAMETER ::   jppo4 =  5     !: phosphate concentration  
     21   INTEGER, PARAMETER ::   jppoc =  6     !: small particulate organic phosphate concentration 
     22   INTEGER, PARAMETER ::   jpsil =  7     !: silicate concentration 
     23   INTEGER, PARAMETER ::   jpphy =  8     !: phytoplancton concentration  
     24   INTEGER, PARAMETER ::   jpzoo =  9     !: zooplancton concentration 
     25   INTEGER, PARAMETER ::   jpdoc = 10     !: dissolved organic carbon concentration  
     26   INTEGER, PARAMETER ::   jpdia = 11     !: Diatoms Concentration 
     27   INTEGER, PARAMETER ::   jpmes = 12     !: Mesozooplankton Concentration 
     28   INTEGER, PARAMETER ::   jpbsi = 13     !: (big) Silicate Concentration 
     29   INTEGER, PARAMETER ::   jpfer = 14     !: Iron Concentration 
    2530#if ! defined key_trc_kriest 
    26       jpbfe = 15 ,  &  ! Big iron particles Concentration 
    27       jpgoc = 16 ,  &  ! big particulate organic phosphate concentration 
    28       jpsfe = 17 ,  &  ! Small iron particles Concentration 
    29       jpdfe = 18 ,  &  ! Diatoms iron Concentration 
    30       jpdsi = 19 ,  &  ! Diatoms Silicate Concentration 
    31       jpnfe = 20 ,  &  ! Nano iron Concentration 
    32       jpnch = 21 ,  &  ! Nano Chlorophyll Concentration 
    33       jpdch = 22 ,  &  ! Diatoms Chlorophyll Concentration 
    34       jpno3 = 23 ,  &  ! Nitrates Concentration 
    35       jpnh4 = 24       ! Ammonium Concentration 
     31   !!---------------------------------------------------------------------- 
     32   !!   Default                                             Standard PISCES 
     33   !!---------------------------------------------------------------------- 
     34   INTEGER, PARAMETER ::   jpbfe = 15     !: Big iron particles Concentration 
     35   INTEGER, PARAMETER ::   jpgoc = 16     !: big particulate organic phosphate concentration 
     36   INTEGER, PARAMETER ::   jpsfe = 17     !: Small iron particles Concentration 
     37   INTEGER, PARAMETER ::   jpdfe = 18     !: Diatoms iron Concentration 
     38   INTEGER, PARAMETER ::   jpdsi = 19     !: Diatoms Silicate Concentration 
     39   INTEGER, PARAMETER ::   jpnfe = 20     !: Nano iron Concentration 
     40   INTEGER, PARAMETER ::   jpnch = 21     !: Nano Chlorophyll Concentration 
     41   INTEGER, PARAMETER ::   jpdch = 22     !: Diatoms Chlorophyll Concentration 
     42   INTEGER, PARAMETER ::   jpno3 = 23     !: Nitrates Concentration 
     43   INTEGER, PARAMETER ::   jpnh4 = 24     !: Ammonium Concentration 
    3644#else 
    37       jpnum = 15 ,  &  ! Big iron particles Concentration 
    38       jpsfe = 16 ,  &  ! number of particulate organic phosphate concentration 
    39       jpdfe = 17 ,  &  ! Diatoms iron Concentration 
    40       jpdsi = 18 ,  &  ! Diatoms Silicate Concentration 
    41       jpnfe = 19 ,  &  ! Nano iron Concentration 
    42       jpnch = 20 ,  &  ! Nano Chlorophyll Concentration 
    43       jpdch = 21 ,  &  ! Diatoms Chlorophyll Concentration 
    44       jpno3 = 22 ,  &  ! Nitrates Concentration 
    45       jpnh4 = 23       ! Ammonium Concentration 
     45   !!---------------------------------------------------------------------- 
     46   !!   'key_trc_kriest'                                    PISCES + kriest 
     47   !!---------------------------------------------------------------------- 
     48   INTEGER, PARAMETER ::   jpnum = 15     !: Big iron particles Concentration 
     49   INTEGER, PARAMETER ::   jpsfe = 16     !: number of particulate organic phosphate concentration 
     50   INTEGER, PARAMETER ::   jpdfe = 17     !: Diatoms iron Concentration 
     51   INTEGER, PARAMETER ::   jpdsi = 18     !: Diatoms Silicate Concentration 
     52   INTEGER, PARAMETER ::   jpnfe = 19     !: Nano iron Concentration 
     53   INTEGER, PARAMETER ::   jpnch = 20     !: Nano Chlorophyll Concentration 
     54   INTEGER, PARAMETER ::   jpdch = 21     !: Diatoms Chlorophyll Concentration 
     55   INTEGER, PARAMETER ::   jpno3 = 22     !: Nitrates Concentration 
     56   INTEGER, PARAMETER ::   jpnh4 = 23     !: Ammonium Concentration 
    4657#endif 
    4758 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/sms.F90

    r719 r763  
    44   !! passive tracers :   set the passive tracers variables 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   9.0  !  04-03  (C. Ethe)  Free form and module 
     6   !! History :    -   !  2004-03  (C. Ethe)  Free form and module 
    87   !!---------------------------------------------------------------------- 
    9    !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    10    !! $Header$  
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    128   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
     9   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     10   !! $Header:$  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     12   !!---------------------------------------------------------------------- 
    1413#if defined key_passivetrc 
    15  
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_passivetrc'                                    Passive tracers 
     16   !!---------------------------------------------------------------------- 
    1617   USE par_oce 
    1718   USE par_trc 
    … …  
    1920 
    2021   IMPLICIT NONE 
    21  
    2222   PUBLIC 
    2323 
    24 #if defined key_trc_lobster1 
     24# if defined key_trc_lobster1 
    2525   !!---------------------------------------------------------------------- 
    2626   !!   'key_trc_lobster1'                        LOBSTER1 biological model   
    … …  
    2828#  include "sms_lobster1.h90" 
    2929 
    30 #elif defined key_trc_pisces 
     30# elif defined key_trc_pisces 
    3131   !!---------------------------------------------------------------------- 
    3232   !!   'key_trc_pisces'                            PISCES biological model                   
    … …  
    3434#  include "sms_pisces.h90" 
    3535 
    36 #elif defined key_cfc 
     36# elif defined key_cfc 
    3737   !!---------------------------------------------------------------------- 
    38    !!   'key_cfc  '                                          CFC model                   
     38   !!   'key_cfc  '                                      CFC chemical model                   
    3939   !!---------------------------------------------------------------------- 
    4040#  include "sms_cfc.h90" 
    4141 
     42# endif 
     43 
     44#else 
     45   !!---------------------------------------------------------------------- 
     46   !!  Empty module :                                     No passive tracer 
     47   !!---------------------------------------------------------------------- 
    4248#endif 
    4349 
    44 #else 
    4550   !!====================================================================== 
    46    !!  Empty module : No passive tracer  
    47    !!====================================================================== 
    48 #endif 
    49  
    5051END MODULE sms 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/sms_cfc.h90

    r719 r763  
    1    !!--------------------------------------------------------------------- 
     1   !!---------------------------------------------------------------------- 
    22   !!                     ***  sms_cfc.h90  ***   
    3    !!                    CFC Source Minus Sink model 
    4    !!--------------------------------------------------------------------- 
     3   !! TOP :   CFC Source Minus Sink valiables 
     4   !!---------------------------------------------------------------------- 
    55 
    66   !!---------------------------------------------------------------------- 
    7    !!  TOP 1.0 , LOCEAN-IPSL (2005)  
     7   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    88   !! $Header$  
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     9   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1010   !!---------------------------------------------------------------------- 
    1111 
    12     INTEGER, PUBLIC :: & 
    13        ndate_beg,     & ! initial calendar date (aammjj) for CFC 
    14        nyear_res,     & ! restoring time constant (year) 
    15        nyear_beg        ! initial year (aa)  
     12   INTEGER , PUBLIC ::   ndate_beg    ! initial calendar date (aammjj) for CFC 
     13   INTEGER , PUBLIC ::   nyear_res    ! restoring time constant (year) 
     14   INTEGER , PUBLIC ::   nyear_beg    ! initial year (aa)  
    1615    
    17     REAL(wp), PUBLIC, DIMENSION(jpi,jpj)  ::  & 
    18        xphem            ! spatial interpolation factor for patm 
     16   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)             ::   xphem    ! spatial interpolation factor for patm 
     17   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jptra) ::   p_cfc    ! partial hemispheric pressure for CFC           
     18   REAL(wp), PUBLIC, DIMENSION(jpi,jpj      ,jptra) ::   pp_cfc   ! temporal interpolation of atmospheric concentrations  
     19   REAL(wp), PUBLIC, DIMENSION(jpi,jpj      ,jptra) ::   qtr      ! input function 
     20   REAL(wp), PUBLIC, DIMENSION(jpi,jpj      ,jptra) ::   qint     ! flux function 
    1921 
    20  
    21     REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jptra)  ::  &    
    22        p_cfc            ! partial hemispheric pressure for CFC           
    23  
    24   
    25     REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jptra) ::  &   
    26        pp_cfc           ! temporal interpolation of atmospheric concentrations  
    27  
    28  
    29     REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jptra) ::  &   
    30        qtr,          & ! input function 
    31        qint            ! flux function 
    32  

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/sms_lobster1.h90

    r719 r763  
    1 !!-------------------------------------------------------------------- 
    2 !! 
    3 !!                         COMMON passivetrc.lobster1.h 
    4 !!                      ******************************* 
    5 !! 
    6 !!  purpose : 
    7 !!  --------- 
    8 !!     INCLUDE COMMON FILE for LOBSTER1 biological model (IF key_trc_lobster1) 
    9 !! 
    10 !!  modifications : 
    11 !!   ------------- 
    12 !!      original    : 99-09 (M. Levy)  
    13 !!      additions   : 00-12 (O. Aumont, E. Kestenare):  
    14 !!                           add sediment parameters 
    15 !! 
    16 !!--------------------------------------------------------------------- 
    17 !!  TOP 1.0 , LOCEAN-IPSL (2005)  
     1   !!---------------------------------------------------------------------- 
     2   !!                     ***  sms_lobster1.h90  ***   
     3   !! TOP :   LOBSTER 1 Source Minus Sink valiables 
     4   !!---------------------------------------------------------------------- 
     5   !! History :    -   !  1999-09 (M. Levy)  original code 
     6   !!              -   !  2000-12 (O. Aumont, E. Kestenare) add sediment  
     7   !!             1.0  !  2005-10 (C. Ethe) F90 
     8   !!             1.0  !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod 
     9   !!              -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca 
     10   !!             2.0  !  2007-04  (C. Deltel, G. Madec) Free form and modules 
     11   !!---------------------------------------------------------------------- 
     12 
     13   !!---------------------------------------------------------------------- 
     14   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    1815   !! $Header$  
    19    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    20 !!--------------------------------------------------------------------- 
    21 !! 
    22 !! 
    23 !!---------------------------------------------------------------------- 
    24 !! 
    25 !!  biological parameters 
    26 !! -------------------------------------------- 
    27 !! 
    28 !!      apmin     : minimum phytoplancton concentration (NAMELIST) 
    29 !!      azmin     : minimum zooplancton concentration (NAMELIST) 
    30 !!      anmin     : minimum nutrients concentration (NAMELIST) 
    31 !!      admin     : minimum detritus concentration (NAMELIST) 
    32 !!      redf      : redfield ratio c:n (NAMELIST) 
    33 !!      reddom    : redfield ratio c:n for DOM 
    34 !!      slopet    : van t hoff coefficient (NAMELIST) 
    35 !!      toptp     : optimal photosynthesis temperature (NAMELIST) 
    36 !!      aknut     : half-saturation nutrient (NAMELIST) 
    37 !!      akno3     : half-saturation for nitrate (NAMELIST) 
    38 !!      aknh4     : half-saturation for ammonium (NAMELIST) 
    39 !!      psinut    : inhibition of nitrate uptake by ammonium (NAMELIST) 
    40 !!      rgamma    : phytoplankton exudation fraction (NAMELIST) 
    41 !!      toptgz    : optimal temperature for zooplankton growth (NAMELIST) 
    42 !!      tmaxgz    : maximal temperature for zooplankton growth (NAMELIST)  
    43 !!      rgz       : widtht of zooplankton temperature FUNCTION (NAMELIST) 
    44 !!      rppz      : zooplankton nominal preference for phytoplancton 
    45 !!                  food, (NAMELIST) 
    46 !!      taus      : maximum specific zooplankton grazing rate (NAMELIST) 
    47 !!      aks       : half saturation constant for total zooplankton 
    48 !! grazing (NAMELIST) 
    49 !!      filmax    : maximum mass clearance rate for zooplankton (NAMELIST) 
    50 !!      rpnaz     : non-assimilated phytoplankton by zooplancton (NAMELIST)  
    51 !!      rdnaz     : non-assimilated detritus by zooplankton (NAMELIST)  
    52 !!      eggzoo    : minimum for zooplankton concentration (NAMELIST) 
    53 !!      tauzn     : zooplancton specific excretion rate (NAMELIST) 
    54 !!      tmmaxp    : maximal phytoplancton mortality rate (NAMELIST) 
    55 !!      tmminp    : minimal phytoplancton mortality rate (NAMELIST) 
    56 !!      tmmaxz    : maximal zooplankton mortality rate (NAMELIST) 
    57 !!      tmminz    : minimal zooplankton mortality rate (NAMELIST) 
    58 !!      anumin    : nutrient threshold for phytoplankton mortality (NAMELIST) 
    59 !!      afdmin    : food threshold for zooplankton mortality (NAMELIST) 
    60 !!      taudn     : detrital breakdown rate (NAMELIST) 
    61 !!      vsed      : sedimentation speed (NAMELIST) 
    62 !!      tmumax    : maximal phytoplankton growth rate (NAMELIST) 
    63 !!      aki       : light photosynthesis half saturation constant (NAMELIST) 
    64 !! 
    65 !!      tmaxr     : maximum coefficient for passive tracer damping (NAMELIST) 
    66 !!      tminr     : minimum coefficient for passive tracer damping (NAMELIST) 
    67 !!      remdmp()  : damping coefficient of passive tracers (depth dependant) 
    68 !!      fdoml     : fraction of exsudation that goes to nh4 (should be labile dom) 
    69 !!      taunn     : nitrification rate 
    70 !!      taudomn   : slow remineralization rate of semi-labile dom to nh4 
    71 !!      xhr       : coeff for Martin's remineralistion profile 
    72 !! 
    73 !!      added by asklod AS Kremeur 2005-03: 
    74 !!      fphylab   : NH4 fraction of phytoplankton excretion 
    75 !!      fzoolab   : NH4 fraction of zooplankton excretion 
    76 !!      fdetlab   : NH4 fraction of detritus dissolution 
    77 !!      fdbod     : zooplankton mortality fraction that goes to detritus 
     16   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     17   !!---------------------------------------------------------------------- 
    7818 
    79       REAL apmin,azmin,anmin,admin,  & 
    80                     redf,reddom,slopet,toptp,aknut,psinut,akno3,aknh4,rcchl,  & 
    81                      rgamma,toptgz,tmaxgz,rgz,  & 
    82                      rppz,taus,aks,filmax,rpnaz,rdnaz,eggzoo,tauzn,  & 
    83                      tmmaxp,tmminp,tmmaxz,tmminz,anumin,afdmin,taudn,  & 
    84                      vsed,tmumax,aki,  & 
    85                      tmaxr,tminr,fdoml,taunn,taudomn,xhr,  & 
    86                      fphylab,fzoolab,fdetlab,fdbod 
    87       REAL remdmp(jpk,jptra) 
     19   !!  biological parameters 
     20   !! ---------------------- 
     21   REAL(wp) ::   apmin    !: minimum phytoplancton concentration              (NAMELIST) 
     22   REAL(wp) ::   azmin    !: minimum zooplancton concentration                (NAMELIST) 
     23   REAL(wp) ::   anmin    !: minimum nutrients concentration                  (NAMELIST) 
     24   REAL(wp) ::   admin    !: minimum detritus concentration                   (NAMELIST) 
     25   REAL(wp) ::   redf     !: redfield ratio c:n                               (NAMELIST) 
     26   REAL(wp) ::   reddom   !: redfield ratio c:n for DOM                        
     27   REAL(wp) ::   slopet   !: van t hoff coefficient                           (NAMELIST) 
     28   REAL(wp) ::   toptp    !: optimal photosynthesis temperature               (NAMELIST)  
     29   REAL(wp) ::   aknut    !: half-saturation nutrient                         (NAMELIST) 
     30   REAL(wp) ::   psinut   !: inhibition of nitrate uptake by ammonium         (NAMELIST) 
     31   REAL(wp) ::   akno3    !: half-saturation for nitrate                      (NAMELIST) 
     32   REAL(wp) ::   aknh4    !: half-saturation for ammonium                     (NAMELIST) 
     33   REAL(wp) ::   rcchl    !: ???                                               
     34   REAL(wp) ::   rgamma   !: phytoplankton exudation fraction                 (NAMELIST) 
     35   REAL(wp) ::   toptgz   !: optimal temperature for zooplankton growth       (NAMELIST) 
     36   REAL(wp) ::   tmaxgz   !: maximal temperature for zooplankton growth       (NAMELIST)  
     37   REAL(wp) ::   rgz      !: widtht of zooplankton temperature FUNCTION       (NAMELIST) 
     38   REAL(wp) ::   rppz     !: zooplankton nominal preference for phytoplancton food (NAMELIST) 
     39   REAL(wp) ::   taus     !: maximum specific zooplankton grazing rate        (NAMELIST) 
     40   REAL(wp) ::   aks      !: half saturation constant for total zooplankton grazing (NAMELIST) 
     41   REAL(wp) ::   filmax   !: maximum mass clearance rate for zooplankton      (NAMELIST) 
     42   REAL(wp) ::   rpnaz    !: non-assimilated phytoplankton by zooplancton     (NAMELIST) 
     43   REAL(wp) ::   rdnaz    !: non-assimilated detritus by zooplankton          (NAMELIST)  
     44   REAL(wp) ::   eggzoo   !: minimum for zooplankton concentration            (NAMELIST) 
     45   REAL(wp) ::   tauzn    !: zooplancton specific excretion rate              (NAMELIST) 
     46   REAL(wp) ::   tmmaxp   !: maximal phytoplancton mortality rate             (NAMELIST) 
     47   REAL(wp) ::   tmminp   !: minimal phytoplancton mortality rate             (NAMELIST) 
     48   REAL(wp) ::   tmmaxz   !: maximal zooplankton mortality rate               (NAMELIST) 
     49   REAL(wp) ::   tmminz   !: minimal zooplankton mortality rate               (NAMELIST) 
     50   REAL(wp) ::   anumin   !: nutrient threshold for phytoplankton mortality   (NAMELIST) 
     51   REAL(wp) ::   afdmin   !: food threshold for zooplankton mortality         (NAMELIST) 
     52   REAL(wp) ::   taudn    !: detrital breakdown rate                          (NAMELIST) 
     53   REAL(wp) ::   vsed     !: sedimentation speed                              (NAMELIST) 
     54   REAL(wp) ::   tmumax   !: maximal phytoplankton growth rate                (NAMELIST) 
     55   REAL(wp) ::   aki      !: light photosynthesis half saturation constant    (NAMELIST) 
     56   REAL(wp) ::   tmaxr    !: maximum coefficient for passive tracer damping   (NAMELIST) 
     57   REAL(wp) ::   tminr    !: minimum coefficient for passive tracer damping   (NAMELIST) 
     58   REAL(wp) ::   fdoml    !: fraction of exsudation that goes to nh4 (should be labile dom) 
     59   REAL(wp) ::   taunn    !: nitrification rate 
     60   REAL(wp) ::   taudomn  !: slow remineralization rate of semi-labile dom to nh4 
     61   REAL(wp) ::   xhr      !: coeff for Martin's remineralistion profile 
     62   REAL(wp) ::   fphylab  !: NH4 fraction of phytoplankton excretion 
     63   REAL(wp) ::   fzoolab  !: NH4 fraction of zooplankton excretion 
     64   REAL(wp) ::   fdetlab  !: NH4 fraction of detritus dissolution 
     65   REAL(wp) ::   fdbod    !: zooplankton mortality fraction that goes to detritus 
    8866 
    89 !! 
    90 !! 
    91 #    if defined key_trc_diabio 
    92 !! 
    93 !!---------------------------------------------------------------------- 
    94 !! 
    95 !!  biological trends  
    96 !! ------------------------------------------------------------------ 
    97 !! 
    98 !!      ctrbio    : biological trends name (NAMELIST) 
    99 !!      ctrbil    : biological trends long name (NAMELIST) 
    100 !!      ctrbiu    : biological trends unit (NAMELIST) 
    101 !!      trbio()   : biological trends 
    102 !! 
    103       CHARACTER*8 ctrbio(jpdiabio) 
    104       CHARACTER*20 ctrbiu(jpdiabio) 
    105       CHARACTER*80 ctrbil(jpdiabio) 
    106       REAL trbio(jpi,jpj,jpk,jpdiabio) 
     67   REAL(wp), DIMENSION(jpk,jptra) ::   remdmp   !: depth dependant damping coefficient of passive tracers  
     68    
    10769 
    108 !! 
    109 !!    netcdf files and index COMMON biological trends files 
    110 !! 
    111 !!      nwritebio: time step frequency for biological outputs (NAMELIST) 
    112 ! asklod 10-2005: oubli de cette partie dans l update: 
    113 !!      nitb     : id for additional array output FILE 
    114 !!      ndepitb  : id for depth mesh 
    115 !!      nhoritb  : id for horizontal mesh 
    116 !! 
    117       INTEGER nwritebio,nitb,ndepitb,nhoritb 
     70# if defined key_trc_diabio 
    11871 
    119 #    endif  
     72   !! Biological trends  
     73   !! ----------------- 
     74   CHARACTER(len=8),  DIMENSION(jpdiabio) ::   ctrbio   !: biological trends name      (NAMELIST) 
     75   CHARACTER(len=20), DIMENSION(jpdiabio) ::   ctrbiu   !: biological trends unit      (NAMELIST) 
     76   CHARACTER(len=80), DIMENSION(jpdiabio) ::   ctrbil   !: biological trends long name (NAMELIST) 
     77   REAL(wp), DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends 
    12078 
    121 !!---------------------------------------------------------------------- 
    122 !! 
    123 !!  optical parameters 
    124 !! ----------------------------------- 
    125 !! 
    126 !!      xze       : euphotic layer depth 
    127 !!      xpar      : par (photosynthetic available radiation) 
    128 !!      xkr0      : water coefficient absorption in red (NAMELIST) 
    129 !!      xkg0      : water coefficient absorption in green (NAMELIST) 
    130 !!      xkrp      : pigment coefficient absorption in red (NAMELIST) 
    131 !!      xkgp      : pigment coefficient absorption in green (NAMELIST) 
    132 !!      xlr       : exposant for pigment absorption in red (NAMELIST) 
    133 !!      xlg       : exposant for pigment absorption in green (NAMELIST) 
    134 !!      rpig      : chla/chla+phea ratio (NAMELIST) 
    135 !! 
    136       REAL xkr0,xkg0,xkrp,xkgp,xlr,xlg,rpig 
     79   !! Netcdf output parameters 
     80   !! ------------------------ 
     81   INTEGER ::   nwritebio   !: time step frequency for biological outputs (NAMELIST) 
     82   INTEGER ::   nitb        !:         id.         for additional array output file 
     83   INTEGER ::   ndepitb     !:         id.         for depth mesh 
     84   INTEGER ::   nhoritb     !:         id.         for horizontal mesh 
    13785 
    138       REAL xze(jpi,jpj) 
    139       REAL xpar(jpi,jpj,jpk) 
     86# endif  
    14087 
    141 !!---------------------------------------------------------------------- 
    142 !! 
    143 !!  sediment parameters 
    144 !! -------------------------------------- 
    145 !! 
    146 !!      sedlam : time coefficient of POC remineralization in sediments 
    147 !!      dmin3  : fraction of sinking POC released at each level 
    148 !!      dminl  : fraction of sinking POC released in sediments 
    149 !! asklod add sedpocb, sedpocn, sedpoca 17 06 2005 
    150 !!      sedpocb : mass of POC in sediments 
    151 !!      sedpocn : mass of POC in sediments 
    152 !!      sedpoca : mass of POC in sediments 
    153 !!      fbod   : rapid sinking particles 
    154 !! 
    155 !! 
    156       REAL sedlam,sedlostpoc 
    157       REAL dmin3(jpi,jpj,jpk), dminl(jpi,jpj) 
    158       REAL sedpoca(jpi,jpj),sedpocb(jpi,jpj),sedpocn(jpi,jpj) 
    159       REAL fbod(jpi,jpj),cmask(jpi,jpj),areacot 
     88   !! Optical parameters                                 
     89   !! ------------------                                 
     90   REAL(wp) ::   xkr0       !: water coefficient absorption in red      (NAMELIST) 
     91   REAL(wp) ::   xkg0       !: water coefficient absorption in green    (NAMELIST) 
     92   REAL(wp) ::   xkrp       !: pigment coefficient absorption in red    (NAMELIST) 
     93   REAL(wp) ::   xkgp       !: pigment coefficient absorption in green  (NAMELIST) 
     94   REAL(wp) ::   xlr        !: exposant for pigment absorption in red   (NAMELIST) 
     95   REAL(wp) ::   xlg        !: exposant for pigment absorption in green (NAMELIST) 
     96   REAL(wp) ::   rpig       !: chla/chla+phea ratio                     (NAMELIST) 
     97                                                         
     98   INTEGER , DIMENSION(jpi,jpj)     ::   neln    !: number of levels in the euphotic layer 
     99   REAL(wp), DIMENSION(jpi,jpj)     ::   xze     !: euphotic layer depth 
     100   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xpar    !: par (photosynthetic available radiation) 
    160101 
     102   !! Sediment parameters                                
     103   !! -------------------                                
     104   REAL(wp) ::   sedlam       !: time coefficient of POC remineralization in sediments 
     105   REAL(wp) ::   sedlostpoc   !: ??? 
     106   REAL(wp) ::   areacot      !: ??? 
     107                                                         
     108   REAL(wp), DIMENSION(jpi,jpj)     ::   dminl   !: fraction of sinking POC released in sediments 
     109   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dmin3   !: fraction of sinking POC released at each level 
     110                                                         
     111   REAL(wp), DIMENSION(jpi,jpj) ::   sedpocb     !: mass of POC in sediments 
     112   REAL(wp), DIMENSION(jpi,jpj) ::   sedpocn     !: mass of POC in sediments 
     113   REAL(wp), DIMENSION(jpi,jpj) ::   sedpoca     !: mass of POC in sediments 
     114                                                         
     115   REAL(wp), DIMENSION(jpi,jpj) ::   fbod        !: rapid sinking particles 
     116   REAL(wp), DIMENSION(jpi,jpj) ::   cmask       !: ??? 
     117 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/sms_pisces.h90

    r730 r763  
    1 !!--------------------------------------------------------------------- 
    2 !! 
    3 !!                         COMMON passivetrc.pisces.h 
    4 !!                       ****************************** 
    5 !! 
    6 !!  purpose : 
    7 !!  --------- 
    8 !!     INCLUDE COMMON FILE for PISCES biological model 
    9 !! 
    10 !!  modifications : 
    11 !!   ------------- 
    12 !!      original    : 00-02 (O. Aumont) 
    13 !! 
    14 !! 
    15 #if defined key_trc_pisces 
    16 !! 
    17 !!---------------------------------------------------------------------- 
    18 !! 
    19 !! Variable for chemistry of the CO2 cycle 
    20 !! 
    21 !! --------------------------------------------------------------------- 
    22 !! 
    23       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    24          akb3, ak13, ak23, aksp, akw3, & 
    25          akp13, akp23, akp33, aksi3, aks3, akf3, & 
    26          hi, borat 
     1   !!---------------------------------------------------------------------- 
     2   !!                     ***  sms_pisces.h90  ***   
     3   !! TOP :   PISCES Source Minus Sink valiables 
     4   !!---------------------------------------------------------------------- 
     5   !! History :   1.0  !  2000-02 (O. Aumont) original code 
     6   !!---------------------------------------------------------------------- 
    277 
    28       REAL :: & 
    29          atcco2, atcox 
     8   !!---------------------------------------------------------------------- 
     9   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     10   !! $Header$  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     12   !!---------------------------------------------------------------------- 
    3013 
    31 !! 
    32 !!---------------------------------------------------------------------- 
    33 !! 
    34 !!  Variable for chemistry of the CO2 cycle 
    35 !! 
    36 !! --------------------------------------------------------------------- 
    37 !! 
    38       REAL(wp), DIMENSION(10)  :: & 
    39          devk1, devk2, devk3, devk4, devk5      
    40     
    41       REAL(wp) :: &  
    42          akcc1, akcc2, akcc3, akcc4,akcc5, akcc6, akcc7, akcc8, akcc9 , & 
    43          bor1, bor2, c00, c01, c02, c03, c04, c05, c10, c11, & 
    44          c12, c13, c20, c21, c22, c23, cb0, cb1, cb2, cb3, & 
    45          cb4, cb5, cb6, cb7, cb8, cb9, cb10, cb11, c14, & 
    46          cw3, cw4, cw5, cw6, cw0, cw1, cw2, ox0, ox1, ox2, ox3, ox4,ox5, & 
    47          salchl, rgas, oxyco, ca0, ca1, ca2, ca3, ca4, ca5, ca6, & 
    48          cp10, cp11, cp12, cp13, cp14, cp15, cp16, cp20, cp21, & 
    49          cp22, cp23, cp24, cp25, cp26, cp30, cp31, cp32, cp33, & 
    50          cp34, cp35, cs10, cs11, cs12, cs13, cs14, cs15, cs16, & 
    51          cs17, cs18, cs19, cs20, cs21, & 
    52          st1, st2, ft1, ft2, ks0, ks1, ks2, ks3, ks4, ks5, & 
    53          ks6, ks7, ks8, ks9, ks10, ks11, ks12, kf0, kf1, & 
    54          kf2, kf3, kf4 
     14   !!---------------------------------------------------------------------- 
     15   !! Variable for chemistry of the CO2 cycle 
     16   !! --------------------------------------------------------------------- 
     17   REAL(wp) ::   atcco2, atcox 
     18   ! 
     19   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akb3, ak13, ak23, aksp, akw3             !: ??? 
     20   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akp13, akp23, akp33, aksi3, aks3, akf3   !: ??? 
     21   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hi, borat                                !: ??? 
    5522 
    56       REAL(wp), DIMENSION(jpi,jpj,3) :: & 
    57          chemc 
     23   !!---------------------------------------------------------------------- 
     24   !!  Variable for chemistry of the CO2 cycle 
     25   !! --------------------------------------------------------------------- 
     26   REAL(wp), DIMENSION(10) ::   devk1, devk2, devk3, devk4, devk5      
     27   ! 
     28   REAL(wp) ::   akcc1, akcc2, akcc3, akcc4,akcc5, akcc6, akcc7, akcc8, akcc9     !: ??? 
     29   REAL(wp) ::   bor1, bor2, c00, c01, c02, c03, c04, c05, c10, c11               !: ??? 
     30   REAL(wp) ::   c12, c13, c20, c21, c22, c23, cb0, cb1, cb2, cb3                 !: ??? 
     31   REAL(wp) ::   cb4, cb5, cb6, cb7, cb8, cb9, cb10, cb11, c14                    !: ??? 
     32   REAL(wp) ::   cw3, cw4, cw5, cw6, cw0, cw1, cw2, ox0, ox1, ox2, ox3, ox4,ox5   !: ??? 
     33   REAL(wp) ::   salchl, rgas, oxyco, ca0, ca1, ca2, ca3, ca4, ca5, ca6           !: ??? 
     34   REAL(wp) ::   cp10, cp11, cp12, cp13, cp14, cp15, cp16, cp20, cp21             !: ??? 
     35   REAL(wp) ::   cp22, cp23, cp24, cp25, cp26, cp30, cp31, cp32, cp33             !: ??? 
     36   REAL(wp) ::   cp34, cp35, cs10, cs11, cs12, cs13, cs14, cs15, cs16             !: ??? 
     37   REAL(wp) ::   cs17, cs18, cs19, cs20, cs21                                     !: ??? 
     38   REAL(wp) ::   st1, st2, ft1, ft2, ks0, ks1, ks2, ks3, ks4, ks5                 !: ??? 
     39   REAL(wp) ::   ks6, ks7, ks8, ks9, ks10, ks11, ks12, kf0, kf1                   !: ??? 
     40   REAL(wp) ::   kf2, kf3, kf4 
     41   ! 
     42   REAL(wp), DIMENSION(jpi,jpj,3) ::   chemc   !: ??? 
    5843 
    59 !! 
    60 !!---------------------------------------------------------------------- 
    61 !! 
    62 !!  Variable for chemistry of Fe and SIO3 
    63 !! 
    64 !! --------------------------------------------------------------------- 
    65 !! 
    66       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    67          sio3eq, fekeq 
     44   !!---------------------------------------------------------------------- 
     45   !!  Variable for chemistry of Fe and SIO3 
     46   !! --------------------------------------------------------------------- 
     47   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   sio3eq   !: ??? 
     48   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   fekeq    !: ??? 
    6849 
    69 !! 
    70 !!---------------------------------------------------------------------- 
    71 !! 
    72 !!  Time variables 
    73 !! 
    74 !! --------------------------------------------------------------------- 
    75 !! 
    76  
    77       INTEGER :: & 
    78          iabsyr, nrdttrc, ndayflxtr 
    79  
    80       REAL(wp) :: & 
    81          tspyr, absyr, xtvit , & 
    82          rfact, rfactr, rfact2, rfact2r 
     50   !!---------------------------------------------------------------------- 
     51   !!  Time variables 
     52   !! --------------------------------------------------------------------- 
     53   INTEGER  ::   iabsyr, nrdttrc, ndayflxtr       !: ??? 
     54   REAL(wp) ::   tspyr, absyr, xtvit              !: ??? 
     55   REAL(wp) ::   rfact, rfactr, rfact2, rfact2r   !: ??? 
    8356 
    8457 
    85 !! 
    86 !!---------------------------------------------------------------------- 
    87 !! 
    88 !!  Gas exchange 
    89 !! 
    90 !! --------------------------------------------------------------------- 
    91 !! 
    92       REAL(wp), DIMENSION(jpi,jpj) :: &  
    93          strn 
    94 !!--------------------------------------- 
    95 !! 
    96 !!  Biological parameters  
    97 !! 
    98 !! -------------------------------------- 
    99 !!  
    100       INTEGER :: & 
    101          jkopt 
     58   !!---------------------------------------------------------------------- 
     59   !!  Gas exchange 
     60   !! --------------------------------------------------------------------- 
     61   REAL(wp), DIMENSION(jpi,jpj) ::   strn         !: ??? 
     62    
     63   !!--------------------------------------- 
     64   !!  Biological parameters  
     65   !! -------------------------------------- 
     66   INTEGER ::   jkopt    !: ??? 
     67   ! 
     68   REAL(wp) ::   caco3r, kdca, nca, part, rno3, o2ut, po4r               !: ??? 
     69   REAL(wp) ::   sco2, dispo0, conc0,sumdepsi,rivalkinput,sedfeinput     !: ??? 
     70   REAL(wp) ::   calcon, rivpo4input,nitdepinput,oxymin,spocri           !: ??? 
     71   REAL(wp) ::   nitrif,rdenit,o2nit,concnnh4,concdnh4                   !: ??? 
     72   REAL(wp) ::   pislope,excret,wsbio,resrat,mprat,wchl,wchld            !: ??? 
     73   REAL(wp) ::   mzrat,grazrat,xprefc,xprefp,unass,xkgraz,xkmort         !: ??? 
     74   REAL(wp) ::   xksi1,xksi2,sicmax,xremik,xremip,xkdoc1                 !: ??? 
     75   REAL(wp) ::   xkdoc2,grosip,resrat2,excret2,mprat2,mzrat2,xprefz      !: ??? 
     76   REAL(wp) ::   xkgraz2,grazrat2,xlam1,conc1,conc2,conc3                !: ??? 
     77   REAL(wp) ::   unass2,xprefpoc,epsher,epsher2,pislope2,mpratm          !: ??? 
     78   REAL(wp) ::   sigma1, sigma2, zprefc, zprefp, zprefd, wchl2, ferat3   !: ??? 
     79   REAL(wp) ::   xsirem, fecnm, fecdm, chlcnm, chlcdm                    !: ??? 
    10280 
    103       REAL(wp) :: & 
    104          caco3r, kdca, nca, part, rno3, o2ut, po4r,  & 
    105          sco2, dispo0, conc0,sumdepsi,rivalkinput,sedfeinput, & 
    106          calcon, rivpo4input,nitdepinput,oxymin,spocri, & 
    107          nitrif,rdenit,o2nit,concnnh4,concdnh4, & 
    108          pislope,excret,wsbio,resrat,mprat,wchl,wchld, & 
    109          mzrat,grazrat,xprefc,xprefp,unass,xkgraz,xkmort, & 
    110          xksi1,xksi2,sicmax,xremik,xremip,xkdoc1, & 
    111          xkdoc2,grosip,resrat2,excret2,mprat2,mzrat2,xprefz, & 
    112          xkgraz2,grazrat2,xlam1,conc1,conc2,conc3, & 
    113          unass2,xprefpoc,epsher,epsher2,pislope2,mpratm, & 
    114          sigma1, sigma2, zprefc, zprefp, zprefd, wchl2, ferat3, & 
    115          xsirem, fecnm, fecdm, chlcnm, chlcdm 
     81   !!--------------------------------------------- 
     82   !!  Biological fluxes for light 
     83   !!--------------------------------------------- 
     84   REAL(wp), DIMENSION(3,61)        ::   xkrgb                 !: ??? 
     85   REAL(wp), DIMENSION(jpi,jpj)     ::   zmeu                  !: ??? 
     86   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   etot, etot3, emoy     !: ??? 
    11687 
     88!!---------------------------------------------------------- 
     89!!  Biological fluxes for primary production 
     90!!---------------------------------------------------------- 
     91   REAL(wp), DIMENSION(jpi,jpj) ::   xksimax, xksi 
     92   ! 
     93   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prmax, tgfunc, tgfunc2                       !: ??? 
     94   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prcaca, prorca, prorca2, prorca3             !: ??? 
     95   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prorca4, prorca5, prorca6, prorca7           !: ??? 
     96   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   pronew, pronew2, proreg, proreg2             !: ??? 
     97   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xnanono3, xdiatno3, xnanonh4, xdiatnh4       !: ??? 
     98   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimphy, xlimdia, concdfe, concnfe, znegtr   !: ??? 
    11799 
     100   !!------------------------------------------ 
     101   !! Sinks for phytoplankton 
     102   !!------------------------------------------ 
     103   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   tortp, tortnf, tortnch            !: ??? 
     104   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   respp, respp2, respnch, respdch   !: ??? 
     105   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   tortp2, tortdf, tortdch, tortds   !: ??? 
     106   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   respds, respdf, respnf            !: ??? 
    118107 
    119 !! 
    120 !!--------------------------------------------- 
    121 !! 
    122 !!  Biological fluxes for light 
    123 !! 
    124 !!--------------------------------------------- 
    125 !! 
    126       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    127          etot, etot3, emoy 
     108   !!------------------------------------ 
     109   !!  SMS for zooplankton 
     110   !!------------------------------------- 
     111   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   respz, tortz, grazp, grazpf                   !: ??? 
     112   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazpch, grazm, grazmf, grazsd                !: ??? 
     113   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazsf, grazss, grazsch, grarem               !: ??? 
     114   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grafer,respz2,tortz2,grazd, grazz,grazn       !: ??? 
     115   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazpoc,graznf, graznch, grazs, grazf         !: ??? 
     116   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazdch, grazpof, grarem2, grafer2, grapoc2   !: ??? 
     117   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grapoc, grazffe, grazfff                      !: ??? 
    128118 
    129       REAL(wp), DIMENSION(jpi,jpj) :: & 
    130          zmeu 
     119   !!--------------------------------------------- 
     120   !!  SMS for the organic matter 
     121   !!--------------------------------------------- 
     122   REAL(wp) ::   wsbio2 
     123   ! 
     124   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xagg, xaggfe, zdiss, xaggdoc, xaggdfe, xbactfer   !: ??? 
     125   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xscave, olimi, orem, orem2, ofer, ofer2           !: ??? 
     126   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   osil, xaggdoc2, nitrfac, xlimbac                  !: ??? 
     127   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   wsbio4, wsbio3, wscal                             !: ??? 
    131128 
    132       REAL(wp), DIMENSION(3,61) :: &  
    133          xkrgb 
    134  
    135  
    136 !! 
    137 !!---------------------------------------------------------- 
    138 !! 
    139 !!  Biological fluxes for primary production 
    140 !! 
    141 !!---------------------------------------------------------- 
    142 !! 
    143       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    144          prmax, tgfunc, tgfunc2, & 
    145          prcaca, prorca, prorca2, prorca3, & 
    146          prorca4, prorca5, prorca6, prorca7, & 
    147          pronew, pronew2, proreg, proreg2, & 
    148          xnanono3, xdiatno3, xnanonh4, xdiatnh4, & 
    149          xlimphy, xlimdia, concdfe, concnfe, znegtr 
    150  
    151       REAL(wp), DIMENSION(jpi,jpj) :: &       
    152          xksimax, xksi 
    153  
    154  
    155  
    156 !! 
    157 !!------------------------------------------ 
    158 !! 
    159 !! Sinks for phytoplankton 
    160 !! 
    161 !!------------------------------------------ 
    162 !! 
    163       REAL(wp), DIMENSION(jpi,jpj,jpk) :: &       
    164          tortp, tortnf, tortnch, & 
    165          respp, respp2, respnch, respdch, & 
    166          tortp2, tortdf, tortdch, tortds, & 
    167          respds, respdf, respnf 
    168  
    169  
    170 !! 
    171 !!------------------------------------ 
    172 !! 
    173 !!  SMS for zooplankton 
    174 !! 
    175 !!------------------------------------- 
    176 !! 
    177       REAL(wp), DIMENSION(jpi,jpj,jpk) :: &    
    178          respz, tortz, grazp, grazpf, & 
    179          grazpch, grazm, grazmf, grazsd, & 
    180          grazsf, grazss, grazsch, grarem, & 
    181          grafer,respz2,tortz2,grazd, grazz,grazn, & 
    182          grazpoc,graznf, graznch, grazs, grazf, & 
    183          grazdch, grazpof, grarem2, grafer2, grapoc2, & 
    184          grapoc, grazffe, grazfff 
    185  
    186  
    187 !! 
    188 !!--------------------------------------------- 
    189 !! 
    190 !!  SMS for the organic matter 
    191 !! 
    192 !!--------------------------------------------- 
    193 !! 
    194       REAL(wp), DIMENSION(jpi,jpj,jpk) :: &    
    195          xagg, xaggfe, zdiss, xaggdoc, xaggdfe, xbactfer, & 
    196          xscave, olimi, orem, orem2, ofer, ofer2, & 
    197          osil, xaggdoc2, nitrfac, xlimbac, &  
    198          wsbio4, wsbio3, wscal 
    199  
    200       REAL(wp) :: & 
    201          wsbio2 
    202  
    203  
    204   
    205 !! 
    206 !!--------------------------------------------------------- 
    207 !! 
    208 !! External sources of nutrients in ocean 
    209 !! 
    210 !!--------------------------------------------------------- 
    211 !! 
    212       REAL(wp), DIMENSION(jpi,jpj,jpk) :: &          
    213          onitr, denitr, ironsed 
    214  
    215       REAL(wp), DIMENSION(jpi,jpj) :: &  
    216          dust, cotdep, nitdep, rivinp 
    217  
    218       REAL(wp), DIMENSION(jpi,jpj,12) ::  &   
    219          dustmo 
    220  
    221       REAL(wp) :: & 
    222          areacot 
    223  
    224       LOGICAL :: & 
    225          bdustfer, briver, bndepo, bsedinput 
    226  
    227  
     129   !!--------------------------------------------------------- 
     130   !! External sources of nutrients in ocean 
     131   !!--------------------------------------------------------- 
     132   LOGICAL ::   bdustfer, briver, bndepo, bsedinput   !: ??? 
     133   ! 
     134   REAL(wp) ::   areacot                              !: ??? 
     135   ! 
     136   REAL(wp), DIMENSION(jpi,jpj)     ::   dust, cotdep, nitdep, rivinp   !: ??? 
     137   REAL(wp), DIMENSION(jpi,jpj,12)  ::   dustmo                         !: ??? 
     138   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   onitr, denitr, ironsed         !: ??? 
    228139 
    229140#if defined key_trc_kriest 
    230 !! 
    231 !!--------------------------------------------------------- 
    232 !! 
    233 !!  Kriest parameter for aggregation 
    234 !! 
    235 !!--------------------------------------------------------- 
    236 !! 
    237       REAL(wp) :: & 
    238          xkr_eta, xkr_zeta, xkr_sfact, xkr_stick,  & 
    239          xkr_mass_min, xkr_mass_max, xkr_massp, xkr_frac, & 
    240          xkr_dnano, xkr_ddiat, xkr_dmeso, xkr_daggr, & 
    241          xkr_nnano, xkr_ndiat, xkr_nmeso, xkr_naggr, & 
    242          xkr_wsbio_min, xkr_wsbio_max 
    243        
    244       REAL(wp), DIMENSION(jpk) :: & 
    245          xnumm 
     141   !!--------------------------------------------------------- 
     142   !!  Kriest parameter for aggregation 
     143   !!--------------------------------------------------------- 
     144   REAL(wp) ::   xkr_eta, xkr_zeta, xkr_sfact, xkr_stick            !: ??? 
     145   REAL(wp) ::   xkr_mass_min, xkr_mass_max, xkr_massp, xkr_frac    !: ??? 
     146   REAL(wp) ::   xkr_dnano, xkr_ddiat, xkr_dmeso, xkr_daggr         !: ??? 
     147   REAL(wp) ::   xkr_nnano, xkr_ndiat, xkr_nmeso, xkr_naggr         !: ??? 
     148   REAL(wp) ::   xkr_wsbio_min, xkr_wsbio_max 
     149   !   
     150   REAL(wp), DIMENSION(jpk) ::   xnumm      !: ??? 
    246151#endif 
    247152 
    248 #endif 
    249  

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcctl.cfc.h90

    r719 r763  
    1 ! $Id$ 
    2 !!! 
    3 !!! Modifications: 
    4 !!! -------------- 
    5 !!!    05-10 (C. Ethe):  
    6 !!!           assign a parameter to name individual tracers 
    7 !!! 
     1   !!====================================================================== 
     2   !!                         ***  trcctl.cfc.h90  *** 
     3   !! TOP :   Control of CFC chemical model 
     4   !!====================================================================== 
     5   !!---------------------------------------------------------------------- 
     6   !! History :   1.0  !  2005-10 (C. Ethe) assign a parameter to name individual tracers 
     7   !!---------------------------------------------------------------------- 
     8   !!---------------------------------------------------------------------- 
     9   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     10   !! $Id:$  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     12   !!---------------------------------------------------------------------- 
     13 
    814 
    915      IF(lwp) THEN 
    … …  
    1218      ENDIF 
    1319 
    14 ! Check number of tracers 
    15 ! ----------------------- 
    16       
    17       IF (jptra .GT. 2) THEN  
    18           IF (lwp) THEN  
     20      ! Check number of tracers 
     21      ! -----------------------    
     22      IF( jptra > 2) THEN  
     23          IF(lwp) THEN  
    1924              WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    2025              WRITE (numout,*) ' =======   ============= ' 
    … …  
    2530      END IF  
    2631 
    27 ! Check tracer names 
    28 ! ------------------ 
    29       IF ( jptra == 1 ) THEN 
     32      ! Check tracer names 
     33      ! ------------------ 
     34      IF( jptra == 1 ) THEN 
    3035         IF ( jp11 == 1 ) THEN 
    3136            IF ( ctrcnm(jp11) /= 'CFC11') THEN 
    32                ctrcnm(jp11)='CFC11' 
    33                ctrcnl(jp11)='Chlorofuorocarbone 11 concentration' 
     37               ctrcnm(jp11) = 'CFC11' 
     38               ctrcnl(jp11) = 'Chlorofuorocarbone 11 concentration' 
    3439            ENDIF 
    3540         ENDIF 
    36          IF ( jp12 == 1 ) THEN 
     41         IF( jp12 == 1 ) THEN 
    3742            IF ( ctrcnm(jp12) /= 'CFC12') THEN 
    38                ctrcnm(jp12)='CFC12' 
    39                ctrcnl(jp12)='Chlorofuorocarbone 12 concentration' 
     43               ctrcnm(jp12) = 'CFC12' 
     44               ctrcnl(jp12) = 'Chlorofuorocarbone 12 concentration' 
    4045            ENDIF 
    4146         ENDIF 
    4247      ENDIF 
    4348 
    44       IF ( jptra == 2 ) THEN 
     49      IF( jptra == 2 ) THEN 
    4550         IF ( ctrcnm(jp11) /= 'CFC11' .OR. ctrcnm(jp12) /= 'CFC12' ) THEN  
    46             ctrcnm(jp11)='CFC11' 
    47             ctrcnl(jp11)='Chlorofuorocarbone 11 concentration' 
    48             ctrcnm(jp12)='CFC12' 
    49             ctrcnl(jp12)='Chlorofuorocarbone 12 concentration'  
     51            ctrcnm(jp11) = 'CFC11' 
     52            ctrcnl(jp11) = 'Chlorofuorocarbone 11 concentration' 
     53            ctrcnm(jp12) = 'CFC12' 
     54            ctrcnl(jp12) = 'Chlorofuorocarbone 12 concentration'  
    5055         ENDIF 
    5156      ENDIF 
    5257 
    53       IF (lwp) THEN 
     58      IF(lwp) THEN 
    5459         WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    5560         WRITE (numout,*) ' =======   ============= ' 
    5661         WRITE (numout,*) ' we force tracer names' 
    57          DO jn=1,jptra 
     62         DO jn = 1, jptra 
    5863            WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 
    5964         END DO 
    … …  
    6267 
    6368 
    64 ! Check tracer units 
    65  
    66       DO jn=1,jptra 
    67         IF (ctrcun(jn) /= 'mole/m3') THEN 
    68             ctrcun(jn)='mole/m3' 
    69             IF (lwp) THEN 
    70                 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    71                 WRITE (numout,*) ' =======   ============= ' 
    72                 WRITE (numout,*) ' we force tracer unit' 
    73                 WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
    74                 WRITE(numout,*) ' ' 
     69      ! Check tracer units 
     70      ! ------------------ 
     71      DO jn = 1, jptra 
     72        IF( ctrcun(jn) /= 'mole/m3' ) THEN 
     73            ctrcun(jn) = 'mole/m3' 
     74            IF(lwp) THEN 
     75               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
     76               WRITE (numout,*) ' =======   ============= ' 
     77               WRITE (numout,*) ' we force tracer unit' 
     78               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
     79               WRITE(numout,*) ' ' 
    7580            ENDIF  
    76         ENDIF  
     81         ENDIF  
    7782      END DO               

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcctl.lobster1.h90

    r719 r763  
    1 !!---------------------------------------------------------------------- 
    2 !!  TOP 1.0,  LOCEAN-IPSL (2005) 
    3 !! $Header$ 
    4 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    5 !!---------------------------------------------------------------------- 
    6 !!! 
    7 !!! Modifications: 
    8 !!! -------------- 
    9 !!!    00-12 (E. Kestenare):  
    10 !!!           assign a parameter to name individual tracers 
    11 !!! 
     1   !!====================================================================== 
     2   !!                         ***  trcctl.lobster1.h90  *** 
     3   !! TOP :   Control of LOBSTER 1 biological model 
     4   !!====================================================================== 
     5   !!---------------------------------------------------------------------- 
     6   !! History :   1.0  !  2000-12 (E. Kestenare) assign a parameter to name individual tracers 
     7   !!---------------------------------------------------------------------- 
     8   !!---------------------------------------------------------------------- 
     9   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     10   !! $Id:$  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     12   !!---------------------------------------------------------------------- 
    1213 
    13 #if defined key_trc_lobster1 
    14       IF(lwp) THEN 
    15           WRITE(numout,*) ' use LOBSTER1 biological model ' 
    16           WRITE(numout,*) ' ' 
    17       ENDIF 
     14      IF(lwp) WRITE(numout,*) 
     15      IF(lwp) WRITE(numout,*) ' use LOBSTER1 biological model ' 
    1816 
    19 ! Check number of tracers 
    20 ! ----------------------- 
     17      ! Check number of tracers 
     18      ! ----------------------- 
    2119      IF (jptra /= 6) THEN  
    2220          IF (lwp) THEN  
    … …  
    3028      END IF  
    3129 
    32 ! Check tracer names 
    33 ! ------------------ 
    34       IF (    ctrcnm(jpdet) /= 'DET' .OR. ctrcnm(jpzoo) /= 'ZOO'     & 
    35          & .OR. ctrcnm(jpphy) /= 'PHY' .OR. ctrcnm(jpno3) /= 'NO3'   & 
    36          & .OR. ctrcnm(jpnh4) /= 'NH4' .OR. ctrcnm(jpdom) /= 'DOM'   &  
    37          & .OR. ctrcnl(jpdet) /= 'Detritus'                          & 
    38          & .OR. ctrcnl(jpzoo) /= 'Zooplankton concentration'         & 
    39          & .OR. ctrcnl(jpphy) /= 'Phytoplankton concentration'       & 
    40          & .OR. ctrcnl(jpno3) /= 'Nitrate concentration'             & 
    41          & .OR. ctrcnl(jpnh4) /= 'Ammonium concentration'            & 
    42          & .OR. ctrcnl(jpdom) /= 'Dissolved organic matter' ) THEN  
    43           ctrcnm(jpdet)='DET' 
    44           ctrcnl(jpdet)='Detritus' 
    45           ctrcnm(jpzoo)='ZOO' 
    46           ctrcnl(jpzoo)='Zooplankton concentration' 
    47           ctrcnm(jpphy)='PHY' 
    48           ctrcnl(jpphy)='Phytoplankton concentration' 
    49           ctrcnm(jpno3)='NO3' 
    50           ctrcnl(jpno3)='Nitrate concentration' 
    51           ctrcnm(jpnh4)='NH4' 
    52           ctrcnl(jpnh4)='Ammonium concentration' 
    53           ctrcnm(jpdom)='DOM' 
    54           ctrcnl(jpdom)='Dissolved organic matter'           
    55           IF (lwp) THEN 
    56               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    57               WRITE (numout,*) ' =======   ============= ' 
    58               WRITE (numout,*) ' we force tracer names' 
    59               DO jn=1,jptra 
    60                 WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 
    61               END DO 
    62               WRITE(numout,*) ' ' 
    63           ENDIF  
     30      ! Check tracer names 
     31      ! ------------------ 
     32      IF(   ctrcnm(jpdet) /= 'DET' .OR. ctrcnm(jpzoo) /= 'ZOO' .OR.   & 
     33         &  ctrcnm(jpphy) /= 'PHY' .OR. ctrcnm(jpno3) /= 'NO3' .OR.   & 
     34         &  ctrcnm(jpnh4) /= 'NH4' .OR. ctrcnm(jpdom) /= 'DOM' .OR.   &  
     35         &  ctrcnl(jpdet) /= 'Detritus'                        .OR.   & 
     36         &  ctrcnl(jpzoo) /= 'Zooplankton concentration'       .OR.   & 
     37         &  ctrcnl(jpphy) /= 'Phytoplankton concentration'     .OR.   & 
     38         &  ctrcnl(jpno3) /= 'Nitrate concentration'           .OR.   & 
     39         &  ctrcnl(jpnh4) /= 'Ammonium concentration'          .OR.   & 
     40         & ctrcnl(jpdom) /= 'Dissolved organic matter' ) THEN  
     41         ctrcnm(jpdet)='DET' 
     42         ctrcnl(jpdet)='Detritus' 
     43         ctrcnm(jpzoo)='ZOO' 
     44         ctrcnl(jpzoo)='Zooplankton concentration' 
     45         ctrcnm(jpphy)='PHY' 
     46         ctrcnl(jpphy)='Phytoplankton concentration' 
     47         ctrcnm(jpno3)='NO3' 
     48         ctrcnl(jpno3)='Nitrate concentration' 
     49         ctrcnm(jpnh4)='NH4' 
     50         ctrcnl(jpnh4)='Ammonium concentration' 
     51         ctrcnm(jpdom)='DOM' 
     52         ctrcnl(jpdom)='Dissolved organic matter'           
     53         IF(lwp) THEN 
     54            WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
     55            WRITE (numout,*) ' =======   ============= ' 
     56            WRITE (numout,*) ' we force tracer names' 
     57            DO jn = 1, jptra 
     58               WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 
     59            END DO 
     60            WRITE(numout,*) ' ' 
     61         ENDIF  
    6462      ENDIF  
    6563 
    66 ! Check tracer units 
    67  
    68       DO jn=1,jptra 
    69         IF (ctrcun(jn) /= 'mmole-N/m3') THEN 
     64      ! Check tracer units 
     65      DO jn = 1, jptra 
     66         IF( ctrcun(jn) /= 'mmole-N/m3') THEN 
    7067            ctrcun(jn)='mmole-N/m3' 
    71             IF (lwp) THEN 
    72                 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    73                 WRITE (numout,*) ' =======   ============= ' 
    74                 WRITE (numout,*) ' we force tracer unit' 
    75                 WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
    76                 WRITE(numout,*) ' ' 
     68            IF(lwp) THEN 
     69               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
     70               WRITE (numout,*) ' =======   ============= ' 
     71               WRITE (numout,*) ' we force tracer unit' 
     72               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
    7773            ENDIF  
    78         ENDIF  
     74         ENDIF  
    7975      END DO               
    80 #endif 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcctl.pisces.h90

    r719 r763  
     1   !!====================================================================== 
     2   !!                         ***  trcctl.cfc.h90  *** 
     3   !! TOP :   Control of CFC chemical model 
     4   !!====================================================================== 
     5   !!---------------------------------------------------------------------- 
     6   !! History :   1.0  !  2005-10 (C. Ethe) assign a parameter to name individual tracers 
     7   !!---------------------------------------------------------------------- 
     8   !!---------------------------------------------------------------------- 
     9   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     10   !! $Id:$  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     12   !!---------------------------------------------------------------------- 
    113 
    2    !!---------------------------------------------------------------------- 
    3    !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    4    !! $Header$  
    5    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    6    !!---------------------------------------------------------------------- 
    7 #if defined key_trc_pisces 
     14      IF(lwp) WRITE(numout,*) 
    815      IF(lwp) WRITE(numout,*) ' use PISCES biological model ' 
    9       IF(lwp) WRITE(numout,*) ' ' 
    1016 
    1117   ! Check number of tracers 
    1218   ! ----------------------- 
    13  
    1419#if  defined key_trc_kriest 
    15       IF (jptra /= 23) THEN  
     20      IF( jptra /= 23) THEN  
    1621#else 
    17       IF (jptra /= 24) THEN 
     22      IF( jptra /= 24) THEN 
    1823#endif 
    1924          IF (lwp) THEN  
    … …  
    2631          STOP 'TRC_CTL' 
    2732      END IF  
    28 #endif 
     33       

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcfreons.F90

    r719 r763  
    11MODULE trcfreons 
    2    !!============================================================== 
    3    !!                  ***  MODULE trcfreons  *** 
    4    !!  Passive tracer : CFC main model 
    5    !!============================================================== 
     2   !!====================================================================== 
     3   !!                      ***  MODULE trcfreons  *** 
     4   !! TOP : CFC main model 
     5   !!====================================================================== 
     6   !! History :    -   !  1999-10  (JC. Dutay)  original code 
     7   !!             1.0  !  2004-03 (C. Ethe) free form + modularity 
     8   !!---------------------------------------------------------------------- 
    69#if defined key_cfc 
    7    !!-------------------------------------------------------------- 
    8    !!   'key_cfc'                                         CFC model 
    9    !!-------------------------------------------------------------- 
    10    !! * Modules used    
     10   !!---------------------------------------------------------------------- 
     11   !!   'key_cfc'                                        CFC chemical model 
     12   !!---------------------------------------------------------------------- 
     13   !!   trc_freons     :  compute and add CFC suface forcing to CFC trends 
     14   !!   trc_freons_cst :  sets constants for CFC surface forcing computation 
     15   !!---------------------------------------------------------------------- 
    1116   USE daymod 
    1217   USE sms 
    … …  
    1419   USE trc 
    1520 
    16  
    1721   IMPLICIT NONE 
    1822   PRIVATE 
    1923 
    20    !! * Routine accessibility 
    21    PUBLIC trc_freons         
    22  
    23    !! * Module variables 
    24    REAL(wp), DIMENSION(jptra) :: & ! coefficient for solubility of CFC11 in  mol/l/atm 
    25       soa1, soa2, soa3, soa4, & 
    26       sob1, sob2, sob3 
    27  
    28    REAL(wp), DIMENSION(jptra) :: & ! coefficients for schmidt number in degre Celcius 
    29       sca1, sca2, sca3, sca4 
    30  
    31    REAL(wp) ::              & ! coefficients for conversion 
    32       xconv1 = 1.0       ,  & ! conversion from to  
    33       xconv2 = 0.01/3600.,  & ! conversion from cm/h to m/s:  
    34       xconv3 = 1.0e+3    ,  & ! conversion from mol/l/atm to mol/m3/atm 
    35       xconv4 = 1.0e-12        ! conversion from mol/m3/atm to mol/m3/pptv  
     24   PUBLIC   trc_freons       ! called in ???     
     25 
     26   REAL(wp), DIMENSION(jptra) ::   soa1, soa2, soa3, soa4   ! coefficient for solubility of CFC [mol/l/atm] 
     27   REAL(wp), DIMENSION(jptra) ::   sob1, sob2, sob3         !    "               " 
     28   REAL(wp), DIMENSION(jptra) ::   sca1, sca2, sca3, sca4   ! coefficients for schmidt number in degre Celcius 
     29       
     30   !                          ! coefficients for conversion 
     31   REAL(wp) ::   xconv1 = 1.0          ! conversion from to  
     32   REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:  
     33   REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm 
     34   REAL(wp) ::   xconv4 = 1.0e-12      ! conversion from mol/m3/atm to mol/m3/pptv  
    3635 
    3736   !! * Substitutions 
    3837#  include "passivetrc_substitute.h90" 
    39  
    40    !!---------------------------------------------------------------------- 
    41    !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    42    !! $Header$  
    43    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     38   !!---------------------------------------------------------------------- 
     39   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     40   !! $Id:$  
     41   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4442   !!---------------------------------------------------------------------- 
    4543 
    … …  
    6260      !!          - the input function is in pico-mol/m3/s and the 
    6361      !!            freons concentration in pico-mol/m3 
    64       !! 
    65       !! History : 
    66       !!   8.1  !  99-10  (JC. Dutay)  original code 
    67       !!   9.0  !  04-03  (C. Ethe)  free form + modularity 
    6862      !!---------------------------------------------------------------------- 
    69       !! * Arguments 
    7063      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    71  
    72       !! * Local declarations 
    73       INTEGER ::  & 
    74          ji, jj, jn, jm 
    75  
    76       INTEGER ::   & 
    77          iyear_beg, iyear_end, & 
    78          imonth, im1, im2 
    79  
    80       REAL(wp) :: & 
    81          ztap, zdtap, & 
    82          zt1, zt2, zt3, zv2 
    83  
    84       REAL(wp), DIMENSION(jphem,jptra)   ::  &    
    85          zpatm       ! atmospheric function 
    86  
    87       REAL(wp) ::  &  
    88          zsol,     & ! solubility 
    89          zsch        ! schmidt number  
    90  
     64      !! 
     65      INTEGER ::   ji, jj, jn, jm 
     66      INTEGER ::   iyear_beg, iyear_end 
     67      INTEGER ::   imonth, im1, im2 
     68 
     69      REAL(wp) ::   ztap, zdtap         
     70      REAL(wp) ::   zt1, zt2, zt3, zv2 
     71      REAL(wp) ::   zsol   ! solubility 
     72      REAL(wp) ::   zsch   ! schmidt number  
    9173       
    92       REAL(wp), DIMENSION(jpi,jpj,jptra)   ::  &  
    93          zca_cfc,  & ! concentration 
    94          zak_cfc     ! transfert coefficients 
    95  
     74      REAL(wp), DIMENSION(jphem,jptra) ::   zpatm       ! atmospheric function 
     75      REAL(wp), DIMENSION(jpi,jpj,jptra) ::   zca_cfc   ! concentration 
     76      REAL(wp), DIMENSION(jpi,jpj,jptra) ::   zak_cfc   ! transfert coefficients 
    9677      !!---------------------------------------------------------------------- 
    97  
    9878 
    9979      IF( kt == nittrc000 )   CALL trc_freons_cst 
    … …  
    11797 
    11898 
    119  
    120  
    12199      !  Temporal and spatial interpolation at time k 
    122100      ! -------------------------------------------------- 
    … …  
    125103            zpatm(jm,jn) = (  p_cfc(iyear_beg, jm, jn) * FLOAT (im1)  & 
    126104               &           +  p_cfc(iyear_end, jm, jn) * FLOAT (im2) ) / 12. 
    127          ENDDO 
    128       END DO 
    129  
    130       DO jn = 1, jptra 
    131          DO jj = 1, jpj  
    132             DO ji = 1, jpi 
    133                pp_cfc(ji,jj,jn) =     xphem(ji,jj)   * zpatm(1,jn)  & 
    134                   &           + ( 1.- xphem(ji,jj) ) * zpatm(2,jn) 
    135             END DO 
    136          END DO 
    137       ENDDO 
     105         END DO 
     106      END DO 
     107 
     108      DO jn = 1, jptra 
     109         pp_cfc(:,:,jn) =       xphem(:,:)   * zpatm(1,jn)   & 
     110            &           + ( 1.- xphem(:,:) ) * zpatm(2,jn) 
     111      END DO 
    138112 
    139113 
    … …  
    160134            END DO 
    161135         END DO 
    162       ENDDO 
     136      END DO 
    163137 
    164138   
    … …  
    181155            END DO 
    182156         END DO 
    183       ENDDO 
     157      END DO 
    184158 
    185159 
    … …  
    199173            END DO 
    200174         END DO 
    201       ENDDO 
     175      END DO 
    202176 
    203177 
    … …  
    212186            END DO 
    213187         END DO 
    214       ENDDO 
     188      END DO 
    215189 
    216190      ! -------------------------------------------- 
    … …  
    223197            END DO 
    224198         END DO 
    225       ENDDO 
    226  
    227  
     199      END DO 
     200      ! 
    228201   END SUBROUTINE trc_freons 
     202 
    229203 
    230204   SUBROUTINE trc_freons_cst 
    … …  
    232206      !!                     ***  trc_freons_cst  ***   
    233207      !! 
    234       !!   Purpose : sets constants for CFC model 
    235       !!  --------- 
    236       !! 
    237       !! 
    238       !! History : 
    239       !!   8.2  !  04-06  (JC. Dutay)  original code 
    240       !!   9.0  !  05-10  (C. Ethe) Modularity  
     208      !! ** Purpose : sets constants for CFC model 
    241209      !!--------------------------------------------------------------------- 
    242       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    243    !! $Header$  
    244    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    245       !!---------------------------------------------------------------- 
    246       !! Local declarations 
    247       INTEGER :: jn 
     210      INTEGER ::   jn 
     211      !!--------------------------------------------------------------------- 
    248212 
    249213      DO jn = 1, jptra 
    … …  
    290254         WRITE(numout,*) 'coefficient for schmidt of tracer',ctrcnm(jn) 
    291255         WRITE(numout,*) sca1(jn), sca2(jn),sca3(jn), sca4(jn) 
    292       ENDDO 
    293  
     256      END DO 
     257      ! 
    294258   END SUBROUTINE trc_freons_cst 
     259    
    295260#else 
    296261   !!---------------------------------------------------------------------- 
    297    !!   Default option                                         Dummy module 
     262   !!   Dummy module                                           No CFC model 
    298263   !!---------------------------------------------------------------------- 
    299264CONTAINS 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcini.cfc.h90

    r719 r763  
     1   !!====================================================================== 
     2   !!                         ***  trcini.cfc.h90  *** 
     3   !! TOP :   Initialisation of CFC chemical model 
     4   !!====================================================================== 
     5   !! History :    -   !  2004-06  (JC. Dutay) Original code 
     6   !!             1.0  !  2005-03  (O. Aumont, A. El Moussaoui) F90 
     7   !!              -   !  2005-10  (C. Ethe) Modularity 
    18   !!---------------------------------------------------------------------- 
    2    !!                    ***  trcini.cfc.h90 *** 
     9 
     10   CHARACTER (len=34) ::   clname = 'cfc1112.atm' ! ??? 
     11 
     12   INTEGER  ::   inum                   ! unit number 
     13   REAL(wp) ::   ylats = -10.           ! 10 degrees south 
     14   REAL(wp) ::   ylatn =  10.           ! 10 degrees north 
     15 
    316   !!---------------------------------------------------------------------- 
    4    !! * Module variables 
    5    INTEGER  ::  & 
    6       inum                   ! unit number 
    7    CHARACTER (len=34) :: & 
    8       clname = 'cfc1112.atm' ! ??? 
    9    REAL(wp) ::  & 
    10       ylats = -10.,    &     ! 10 degrees south 
    11       ylatn =  10.           ! 10 degrees north 
     17   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     18   !! $Id:$  
     19   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     20   !!---------------------------------------------------------------------- 
    1221 
    1322CONTAINS 
    1423 
    1524   SUBROUTINE trc_ini 
    16       !!--------------------------------------------------------------------- 
     25      !!---------------------------------------------------------------------- 
    1726      !!                     ***  trcini.cfc.h90  ***   
    1827      !! 
    19       !!   Purpose : special initialization for cfc model 
    20       !!  --------- 
    21       !! 
    22       !! 
    23       !! History : 
    24       !!   8.2  !  04-06  (JC. Dutay)  original code 
    25       !!   8.5  !  05-03  (O. Aumont and A. El Moussaoui F90 
    26       !!   9.0  !  05-10  (C. Ethe) Modularity  
    27       !!--------------------------------------------------------------------- 
    28       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    29    !! $Header$  
    30    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    31       !!--------------------------------------------------------------------- 
    32       !! Local declarations 
    33       INTEGER  :: ji, jj, jn, jl, jm 
    34       REAL(wp) :: zyy,  zyd 
     28      !! ** Purpose : special initialization for cfc model 
     29      !!---------------------------------------------------------------------- 
     30      INTEGER  ::   ji, jj, jn, jl, jm 
     31      REAL(wp) ::   zyy,  zyd 
     32      !!---------------------------------------------------------------------- 
    3533 
    36     
    37       ! 
    3834      ! Initialization of boundaries conditions 
    3935      ! ---------------------------------------  
    40  
    41       pp_cfc(:,:,:) = 0.0 
    42       qtr  (:,:,:) = 0.0 
    43       xphem(:,:  ) = 0.0 
    44  
    45   
     36      pp_cfc(:,:,:) = 0.e0 
     37      qtr   (:,:,:) = 0.e0 
     38      xphem (:,:)   = 0.e0 
    4639      DO jn = 1, jptra 
    4740         DO jm = 1, jphem 
    … …  
    5043            END DO 
    5144         END DO 
    52       ENDDO 
     45      END DO 
    5346       
    5447       
    … …  
    6154         ENDIF 
    6255         DO jn = 1, jptra 
    63             DO jj = 1, jpj 
    64                DO ji = 1, jpi 
    65                   qint(ji,jj,jn) = 0. 
    66                END DO 
    67             END DO 
    68          ENDDO 
     56            qint(:,:,jn) = 0.e0 
     57         END DO 
    6958      ENDIF 
    7059 
    7160 
    72       ! 
    7361      !   READ CFC partial pressure atmospheric value : 
    7462      !     p11(year,nt) = PCFC11  in northern (1) and southern (2) hemisphere  
    … …  
    127115      DO jj = 1 , jpj 
    128116         DO ji = 1 , jpi 
    129             IF( gphit(ji,jj) .GE. ylatn ) THEN 
    130                xphem(ji,jj) = 1. 
    131             ELSE IF (gphit(ji,jj) .LE. ylats) THEN 
    132                xphem(ji,jj) = 0. 
    133             ELSE  
    134                xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd 
     117            IF(     gphit(ji,jj) >= ylatn ) THEN   ;   xphem(ji,jj) = 1.e0 
     118            ELSEIF( gphit(ji,jj) <= ylats ) THEN   ;   xphem(ji,jj) = 0.e0 
     119            ELSE                                   ;   xphem(ji,jj) = ( gphit(ji,jj) - ylats) / zyd 
    135120            ENDIF 
    136121         END DO 
    137122      END DO 
    138  
     123      ! 
    139124   END SUBROUTINE trc_ini 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcini.lobster1.h90

    r719 r763  
     1   !!====================================================================== 
     2   !!                         ***  trcini.lobster1.h90  *** 
     3   !! TOP :   Initialisation of LOBSTER 1 biological model 
     4   !!====================================================================== 
     5   !! History :    -   !  1999-09  (M. Levy) Original code 
     6   !!              -   !  2000-12  (0. Aumont, E. Kestenare) add sediment  
     7   !!             1.0  !  2004-03  (C. Ethe) Modularity 
     8   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90 
    19   !!---------------------------------------------------------------------- 
    2    !!                    ***  trcini.lobster1.h90 *** 
    3    !!---------------------------------------------------------------------- 
     10 
    411#  include "domzgr_substitute.h90" 
    512#  include "passivetrc_substitute.h90" 
     13   !!---------------------------------------------------------------------- 
     14   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     15   !! $Id:$  
     16   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     17   !!---------------------------------------------------------------------- 
     18 
    619CONTAINS 
    720 
    821   SUBROUTINE trc_ini 
    9       !!--------------------------------------------------------------------- 
     22      !!---------------------------------------------------------------------- 
    1023      !!                    ***  ROUTINE trc_ini  *** 
    11       !!  purpose : 
    12       !!  --------- 
    13       !!     specific initialisation for lobster1 model 
    14       !! 
    15       !!   History : 
    16       !!   -------- 
    17       !!      original    : 99-09 (M. Levy)  
    18       !!      additions   : 00-12 (0. Aumont, E. Kestenare) 
    19       !!                           add sediment computations 
    20       !!    03-05 : O. Aumont and A. El Moussaoui F90   
     24      !! ** purpose :   specific initialisation for lobster1 model 
    2125      !!---------------------------------------------------------------------- 
    22       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    23    !! $Header$  
    24    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     26      INTEGER  ::   ji, jj, jk, jn 
     27      REAL(wp) ::   zdm0(jpi,jpj,jpk), zrro(jpi,jpj), zfluo, zfluu 
     28      REAL(wp) ::   ztest, zfluo, zfluu 
     29      REAL(wp), DIMENSION(jpi,jpj) ::   zrro 
     30      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdm0 
    2531      !!---------------------------------------------------------------------- 
    26       !! local declarations 
    27       !! ================== 
    28       INTEGER ji,jj,jk,jn 
    29       REAL zdm0(jpi,jpj,jpk),zrro(jpi,jpj),zfluo,zfluu 
    30       REAL ztest 
    3132 
    32       !! 1. initialization of fields for optical model 
    33       !! -------------------------------------------- 
     33      ! initialization of fields for optical model 
     34      ! -------------------------------------------- 
     35      xze (:,:)   = 5.e0 
     36      xpar(:,:,:) = 0.e0 
    3437 
    35       xze(:,:)=5. 
    36       xpar(:,:,:)=0. 
     38      ! initialization for passive tracer remineralisation-damping  array 
     39      ! ----------------------------------------------------------------- 
    3740 
    38       !! 2. initialization for passive tracer remineralisation-damping  array 
    39       !! ------------------------------------------------------------------------- 
    40  
    41       DO jn=1,jptra 
    42          remdmp(:,jn)=tminr 
     41      DO jn = 1, jptra 
     42         remdmp(:,jn) = tminr 
    4343      END DO 
    4444 
    … …  
    4949      ENDIF 
    5050 
    51       !! 3. initialization of biological variables 
    52       !! ------------------------------------------ 
     51      ! initialization of biological variables 
     52      ! ------------------------------------------ 
    5353 
    54       !! Calculate vertical distribution of newly formed biogenic poc 
    55       !! in the water column in the case of max. possible bottom depth 
    56       !! ------------------------------------------------------------ 
     54      ! Calculate vertical distribution of newly formed biogenic poc 
     55      ! in the water column in the case of max. possible bottom depth 
     56      ! ------------------------------------------------------------ 
    5757 
    58       zdm0   = 0. 
    59       zrro = 1. 
     58      zdm0   = 0.e0 
     59      zrro = 1.e0 
    6060      DO jk = jpkb,jpkm1 
    6161         DO jj =1, jpj 
    6262            DO ji =1, jpi 
    63                zfluo = (fsdepw(ji,jj,jk)/fsdepw(ji,jj,jpkb))**xhr  
    64                zfluu = (fsdepw(ji,jj,jk+1)/fsdepw(ji,jj,jpkb))**xhr 
    65                IF (zfluo.GT.1.) zfluo = 1. 
    66                zdm0(ji,jj,jk) = zfluo-zfluu 
    67                IF (jk.LE.jpkb-1) zdm0(ji,jj,jk)=0. 
    68                zrro(ji,jj) = zrro(ji,jj)-zdm0(ji,jj,jk) 
    69             ENDDO 
    70          ENDDO 
    71       ENDDO 
    72 !!! 
     63               zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr  
     64               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr 
     65               IF( zfluo.GT.1. )   zfluo = 1.e0 
     66               zdm0(ji,jj,jk) = zfluo - zfluu 
     67               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0.e0 
     68               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
     69            END DO 
     70         END DO 
     71      END DO 
    7372 
    7473      zdm0(:,:,jpk) = zrro(:,:) 
    7574 
    76       !! Calculate vertical distribution of newly formed biogenic poc 
    77       !! in the water column with realistic topography (first "dry" layer 
    78       !! contains total fraction, which has passed to the upper layers) 
    79       !! ---------------------------------------------------------------------- 
    80  
     75      ! Calculate vertical distribution of newly formed biogenic poc 
     76      ! in the water column with realistic topography (first "dry" layer 
     77      ! contains total fraction, which has passed to the upper layers) 
     78      ! ---------------------------------------------------------------------- 
    8179      dminl = 0. 
    8280      dmin3 = zdm0 
     81      DO jk = 1, jpk 
     82         DO jj = 1, jpj 
     83            DO ji = 1, jpi 
     84               IF( tmask(ji,jj,jk) == 0. ) THEN 
     85                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
     86                  dmin3(ji,jj,jk) = 0.e0 
     87               ENDIF 
     88            END DO 
     89         END DO 
     90      END DO 
    8391 
    84       DO jk = 1,jpk 
    85          DO jj = 1,jpj 
    86             DO ji = 1,jpi 
     92      DO jj = 1, jpj 
     93         DO ji = 1, jpi 
     94            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0.e0 
     95         END DO 
     96      END DO 
    8797 
    88                IF(tmask(ji,jj,jk) == 0) THEN 
    89                   dminl(ji,jj) = dminl(ji,jj)+dmin3(ji,jj,jk) 
    90                   dmin3(ji,jj,jk) = 0.0 
    91                ENDIF 
    92  
    93             ENDDO 
    94          ENDDO 
    95       ENDDO 
    96  
    97       DO jj = 1,jpj 
    98          DO ji = 1,jpi 
    99             IF (tmask(ji,jj,1) == 0) dmin3(ji,jj,1) = 0. 
    100          ENDDO 
    101       ENDDO 
    102  
    103       !! CALCUL DU MASK DE COTE 
    104       !! ----------------------    
    105       cmask=0. 
    106       do ji=2,jpi-1 
    107          do jj=2,jpj-1 
     98      ! Coastal mask  
     99      ! ------------    
     100      cmask = 0.e0 
     101      DO ji = 2, jpi-1 
     102         DO jj = 2, jpj-1 
    108103            if (tmask(ji,jj,1) == 1) then 
    109104               ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1) 
    110105               IF (ztest == 0) cmask(ji,jj) = 1. 
    111106            endif 
    112          end do 
    113       end do 
     107         END DO 
     108      END DO 
    114109 
    115       cmask(1,:)=cmask(jpi-1,:) 
    116       cmask(jpi,:)=cmask(2,:) 
     110      cmask( 1 ,:) = cmask(jpi-1,:) 
     111      cmask(jpi,:) = cmask( 2   ,:) 
    117112 
     113      !!gm BUG !!!!!   not valid in mpp and also not valid for north fold   !!!!! 
    118114 
    119       !! CALCUL DE LA SURFACE COTIERE 
    120       !! ---------------------------- 
    121       areacot=0. 
    122       do ji=2,jpi-1 
    123          do jj=2,jpj-1 
    124             areacot=areacot+e1t(ji,jj)*e2t(ji,jj)*cmask(ji,jj) 
    125          end do 
    126       end do 
    127  
     115      ! Coastal surface 
     116      ! --------------- 
     117      areacot = 0.e0 
     118      DO ji = 2, jpi-1 
     119         DO jj = 2, jpj-1 
     120            areacot = areacot + e1t(ji,jj) * e2t(ji,jj) * cmask(ji,jj) 
     121         END DO 
     122      END DO 
     123      ! 
    128124   END SUBROUTINE trc_ini 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcini.pisces.h90

    r728 r763  
     1   !!====================================================================== 
     2   !!                         ***  trcini.pisces.h90  *** 
     3   !! TOP :   Initialisation of PISCES biological model 
     4   !!====================================================================== 
     5   !! History :    -   !  1988-07  (E. Maier-Reiner) Original code 
     6   !!              -   !  1999-10  (O. Aumont, C. Le Quere) 
     7   !!              -   !  2002     (O. Aumont)  PISCES 
     8   !!             1.0  !  2005-03  (O. Aumont, A. El Moussaoui) F90 
    19   !!---------------------------------------------------------------------- 
    2    !!                    ***  trcini.pisces.h90 *** 
    3    !!---------------------------------------------------------------------- 
     10 
    411#  include "domzgr_substitute.h90" 
    512#  include "passivetrc_substitute.h90" 
     13   !!---------------------------------------------------------------------- 
     14   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     15   !! $Id:$  
     16   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     17   !!---------------------------------------------------------------------- 
     18 
    619CONTAINS 
    720 
    821   SUBROUTINE trc_ini 
    9       !!----------------------------------------------------------------- 
     22      !!---------------------------------------------------------------------- 
     23      !!                   ***  ROUTINE trc_ini *** 
    1024      !! 
    11       !!                   ***  ROUTINE trc_ini *** 
    12       !!                      
     25      !! ** Purpose :   Initialisation of PISCES biological and chemical variables 
     26      !!---------------------------------------------------------------------- 
     27      USE iom 
    1328      !! 
    14       !!  Purpose : 
    15       !!  --------- 
    16       !!     Initialisation of PISCES biological and chemical variables 
    17       !! 
    18       !!   INPUT : 
    19       !!   ----- 
    20       !!      common 
    21       !!              all the common defined in opa  
    22       !! 
    23       !! 
    24       !!   OUTPUT :                   : no 
    25       !!   ------ 
    26       !! 
    27       !!   EXTERNAL : 
    28       !!   ---------- 
    29       !!         p4zche 
    30       !! 
    31       !!   MODIFICATIONS: 
    32       !!   -------------- 
    33       !!      original  : 1988-07  E. MAIER-REIMER      MPI HAMBURG 
    34       !!      additions : 1999-10  O. Aumont and C. Le Quere 
    35       !!      additions : 2002     O. Aumont (PISCES) 
    36       !!     03-2005 O. Aumont and A. El Moussaoui F90 
    37       !!---------------------------------------------------------------------- 
    38       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    39       !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcini.pisces.h90,v 1.9 2007/10/12 09:35:04 opalod Exp $  
    40       !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    41       !!---------------------------------------------------------------------- 
    42       !!Module used 
    43       USE iom 
    44  
    45       !! local declarations 
    46       !! ================== 
    4729      INTEGER :: ji,jj,jk 
    4830      INTEGER :: ichl,iband,jm 
    4931      INTEGER , PARAMETER :: jpmois = 12, jpan   = 1  
    5032 
     33      REAL(wp) :: zcoef 
    5134      REAL(wp) :: ztoto,expide,denitide,ztra,zmaskt 
    5235      REAL(wp) , DIMENSION (jpi,jpj) :: riverdoc,river,ndepo 
    5336      REAL(wp) , DIMENSION (jpi,jpj,jpk) :: cmask 
    5437 
    55       INTEGER :: numriv,numdust,numbath,numdep 
     38      INTEGER :: numriv, numdust, numbath, numdep 
    5639      INTEGER :: numlight  
    5740 
    5841#if defined key_trc_kriest 
    59       REAL(wp) ::  & 
    60          znum, zdiv, & 
    61          zws,zwr, zwl,wmax, xnummax, & 
    62          zmin, zmax, zl, zr, xacc 
    63  
    64       INTEGER :: jn, kiter 
     42      INTEGER  ::   jn, kiter 
     43      REAL(wp) ::   znum, zdiv 
     44      REAL(wp) ::   zws,zwr, zwl,wmax, xnummax, & 
     45      REAL(wp) ::   zmin, zmax, zl, zr, xacc 
    6546#endif 
    66  
    67       !! 1. initialization 
    68       !! ----------------- 
    69  
    70       !! computation of the record length for direct access FILE 
    71       !! this length depend of 512 for the t3d machine 
    72       !! 
    73       rfact = rdttra(1) * float(ndttrc) 
    74       rfactr = 1./rfact 
    75       IF(lwp) WRITE(numout,*) ' Tracer time step=',rfact,' rdt=',rdt 
    76       rfact2= rfact / float(nrdttrc) 
    77       rfact2r = 1./rfact2 
    78       IF(lwp) write(numout,*) ' Biology time step=',rfact2 
    79  
    80  
    81       !!    INITIALISE DUST INPUT FROM ATMOSPHERE 
    82       !!    ------------------------------------- 
    83  
    84       IF ( bdustfer ) THEN 
    85          IF(lwp) WRITE(numout,*) ' Initialize dust input from atmosphere ' 
     47      !!---------------------------------------------------------------------- 
     48 
     49 
     50      IF(lwp) WRITE(numout,*) 
     51      IF(lwp) WRITE(numout,*) ' trc_ini :   PISCES biological and chemical initialisation' 
     52      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     53 
     54 
     55      !                                            ! Time-step 
     56      rfact   = rdttra(1) * float(ndttrc)          ! --------- 
     57      rfactr  = 1. / rfact 
     58      rfact2  = rfact / float(nrdttrc) 
     59      rfact2r = 1. / rfact2 
     60 
     61      IF(lwp) WRITE(numout,*) '    Tracer  time step=', rfact, ' rdt = ', rdt 
     62      IF(lwp) write(numout,*) '    Biology time step=', rfact2 
     63 
     64 
     65      !                                            ! Dust input from the atmosphere 
     66      IF( bdustfer ) THEN                          ! ------------------------------ 
     67         IF(lwp) WRITE(numout,*) '    Initialize dust input from atmosphere ' 
    8668         CALL iom_open ( 'dust.orca.nc', numdust ) 
    8769         DO jm = 1, jpmois 
    88             CALL iom_get  ( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 
    89          ENDDO 
     70            CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 
     71         END DO 
    9072         CALL iom_close( numdust ) 
    9173      ELSE 
    92          dustmo(:,:,:) = 0. 
     74         dustmo(:,:,:) = 0.e0 
    9375      ENDIF 
    9476 
    9577 
    96  
    97       !!    INITIALISE THE NUTRIENT INPUT BY RIVERS 
    98       !!    --------------------------------------- 
    99  
    100       IF ( briver ) THEN 
    101          IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by rivers ' 
     78      !                                            ! Nutrient input from rivers 
     79      IF( briver ) THEN                            ! -------------------------- 
     80         IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by rivers from river.orca.nc file' 
    10281         CALL iom_open ( 'river.orca.nc', numriv ) 
    10382         CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpan ) 
    … …  
    10584         CALL iom_close( numriv ) 
    10685      ELSE 
    107          river   (:,:) = 0. 
    108          riverdoc(:,:) = 0. 
     86         river   (:,:) = 0.e0 
     87         riverdoc(:,:) = 0.e0 
    10988      endif 
    11089 
    111       !!    INITIALISE THE N INPUT BY DUST 
    112       !!  --------------------------------------- 
    113  
    114       IF ( bndepo ) THEN 
    115          IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by dust ' 
     90      !                                            ! Nutrient input from dust 
     91      IF( bndepo ) THEN                            ! ------------------------ 
     92         IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by dust from ndeposition.orca.nc' 
    11693         CALL iom_open ( 'ndeposition.orca.nc', numdep ) 
    11794         CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan ) 
    11895         CALL iom_close( numdep ) 
    11996      ELSE 
    120          ndepo(:,:) = 0. 
     97         ndepo(:,:) = 0.e0 
    12198      ENDIF 
    12299 
    123       !!    Computation of the coastal mask. 
    124       !!    Computation of an island mask to enhance coastal supply of iron 
    125       !!    --------------------------------------------------------------- 
    126  
    127       IF ( bsedinput ) THEN 
    128          IF(lwp) WRITE(numout,*) '  Computation of an island mask to enhance coastal supply of iron ' 
     100      !                                            ! Coastal and island masks 
     101      IF( bsedinput ) THEN                         ! ------------------------ 
     102         IF(lwp) WRITE(numout,*) '    Computation of an island mask to enhance coastal supply of iron ' 
     103         IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file ' 
    129104         CALL iom_open ( 'bathy.orca.nc', numbath ) 
    130105         CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan ) 
    131  
     106         CALL iom_close( numbath ) 
     107         ! 
    132108         DO jk = 1, 5 
    133109            DO jj = 2, jpjm1 
    134110               DO ji = 2, jpim1 
    135                   IF ( tmask(ji,jj,jk) /= 0. ) THEN 
     111                  IF( tmask(ji,jj,jk) /= 0. ) THEN 
    136112                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    & 
    137                         &          * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 
    138                      IF ( zmaskt == 0. ) THEN 
    139                         cmask(ji,jj,jk ) = 0.1 
    140                      ENDIF 
     113                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 
     114                     IF( zmaskt == 0. )   cmask(ji,jj,jk ) = 0.1 
    141115                  ENDIF 
    142116               END DO 
    … …  
    151125               END DO 
    152126            END DO 
    153          END DO 
    154           
    155          CALL iom_close( numbath ) 
     127         END DO     
    156128      ELSE 
    157          cmask(:,:,:) = 0. 
     129         cmask(:,:,:) = 0.e0 
    158130      ENDIF 
    159131 
    160       ! Lateral boundary conditions on ( avt, en )   (sign unchanged) 
    161       CALL lbc_lnk( cmask , 'T', 1. ) 
    162  
    163       !!     Computation of the total atmospheric supply of Si 
    164       !!     ------------------------------------------------- 
    165  
    166       sumdepsi = 0. 
     132      CALL lbc_lnk( cmask , 'T', 1. )      ! Lateral boundary conditions on cmask   (sign unchanged) 
     133 
     134 
     135      !                                            ! total atmospheric supply of Si 
     136      !                                            ! ------------------------------ 
     137      sumdepsi = 0.e0 
    167138      DO jm = 1, jpmois 
    168139         DO jj = 2, jpjm1 
    169140            DO ji = 2, jpim1 
    170                sumdepsi = sumdepsi + dustmo(ji,jj,jm)/(12.*rmoss)*8.8        & 
    171                   *0.075/28.1*e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,1)*tmask_i(ji,jj) 
     141               sumdepsi = sumdepsi + dustmo(ji,jj,jm) / (12.*rmoss) * 8.8        & 
     142                  &     * 0.075/28.1 * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * tmask_i(ji,jj) 
    172143            END DO 
    173144         END DO 
    174145      END DO 
    175  
    176146      IF( lk_mpp )   CALL mpp_sum( sumdepsi )  ! sum over the global domain 
    177147 
    178       !!    COMPUTATION OF THE N/P RELEASE DUE TO COASTAL RIVERS 
    179       !!    COMPUTATION OF THE Si RELEASE DUE TO COASTAL RIVERS  
    180       !!    --------------------------------------------------- 
    181  
    182       DO jj=1,jpj 
    183          DO ji=1,jpi 
    184             cotdep(ji,jj)=river(ji,jj)*1E9/(12.*raass                          & 
    185                *e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,1)+rtrn)*tmask(ji,jj,1) 
    186             rivinp(ji,jj)=(river(ji,jj)+riverdoc(ji,jj))*1E9                   & 
    187                /(31.6*raass*e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,1)+rtrn)   & 
    188                *tmask(ji,jj,1) 
    189             nitdep(ji,jj)=7.6*ndepo(ji,jj)*tmask(ji,jj,1)/(14E6*raass          & 
    190                *fse3t(ji,jj,1)+rtrn) 
     148      !                                            ! N/P and Si releases due to coastal rivers 
     149      !                                            ! ----------------------------------------- 
     150      DO jj = 1, jpj 
     151         DO ji = 1, jpi 
     152            zcoef = raass * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) 
     153            cotdep(ji,jj) =  river(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1) 
     154            rivinp(ji,jj) = (river(ji,jj)+riverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) * tmask(ji,jj,1) 
     155            nitdep(ji,jj) = 7.6 * ndepo(ji,jj)                  / ( 14E6*raass*fse3t(ji,jj,1) + rtrn ) * tmask(ji,jj,1) 
    191156         END DO 
    192157      END DO 
    … …  
    194159      CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. ) 
    195160 
    196       rivpo4input=0. 
    197       rivalkinput=0. 
    198       nitdepinput=0. 
    199       DO jj=2,jpjm1 
    200          DO ji=2,jpim1 
    201             rivpo4input=rivpo4input+rivinp(ji,jj)*(e1t(ji,jj)*e2t(ji,jj)    & 
    202                *fse3t(ji,jj,1))*tmask(ji,jj,1)*tmask_i(ji,jj)*raass 
    203             rivalkinput=rivalkinput+cotdep(ji,jj)*(e1t(ji,jj)*e2t(ji,jj)    & 
    204                *fse3t(ji,jj,1))*tmask(ji,jj,1)*tmask_i(ji,jj)*raass 
    205             nitdepinput=nitdepinput+nitdep(ji,jj)*(e1t(ji,jj)*e2t(ji,jj)    & 
    206                *fse3t(ji,jj,1))*tmask(ji,jj,1)*tmask_i(ji,jj)*raass 
     161      rivpo4input=0.e0 
     162      rivalkinput=0.e0 
     163      nitdepinput=0.e0 
     164      DO jj = 2 , jpjm1 
     165         DO ji = 2, jpim1 
     166            zcoef = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)) * tmask(ji,jj,1) * tmask_i(ji,jj) * raass 
     167            rivpo4input = rivpo4input + rivinp(ji,jj) * zcoef 
     168            rivalkinput = rivalkinput + cotdep(ji,jj) * zcoef 
     169            nitdepinput = nitdepinput + nitdep(ji,jj) * zcoef 
    207170         END DO 
    208171      END DO 
    209  
    210172      IF( lk_mpp ) THEN 
    211173         CALL mpp_sum( rivpo4input )  ! sum over the global domain 
    … …  
    215177 
    216178 
    217       !!    Coastal supply of iron 
    218       !!    ---------------------- 
    219  
    220       DO jk=1,jpkm1 
    221          ironsed(:,:,jk)=sedfeinput*cmask(:,:,jk)         & 
    222             /(fse3t(:,:,jk)*rjjss) 
     179      !                                            !    Coastal supply of iron 
     180      !                                            ! ------------------------- 
     181      DO jk = 1, jpkm1 
     182         ironsed(:,:,jk) = sedfeinput * cmask(:,:,jk) / ( fse3t(:,:,jk) * rjjss ) 
    223183      END DO 
    224  
    225       ! Lateral boundary conditions on ( ironsed )   (sign unchanged) 
    226       CALL lbc_lnk( ironsed , 'T', 1. ) 
     184      CALL lbc_lnk( ironsed , 'T', 1. )      ! Lateral boundary conditions on ( ironsed )   (sign unchanged) 
     185 
    227186 
    228187 
    … …  
    233192      !  Bissection Method 
    234193      !-------------------------------------------------------------------- 
    235       WRITE(numout,*)'  ' 
    236       WRITE(numout,*)'Compute maximum number of particles in aggregates' 
    237       WRITE(numout,*)'  ' 
     194      WRITE(numout,*) 
     195      WRITE(numout,*)'    kriest : Compute maximum number of particles in aggregates' 
    238196             
    239       xacc     = 0.001 
     197      xacc     =  0.001 
    240198      kiter    = 50 
    241       zmin     = 1.10 
    242       zmax     = xkr_mass_max/xkr_mass_min 
     199      zmin     =  1.10 
     200      zmax     = xkr_mass_max / xkr_mass_min 
    243201      xkr_frac = zmax 
    244202 
    … …  
    262220 
    263221iflag:  DO jn = 1, kiter                
    264            IF( zwl == 0. ) THEN 
     222           IF( zwl == 0.e0 ) THEN 
    265223              xnummax = zl 
    266            ELSE IF ( zwr == 0. ) THEN 
     224           ELSE IF ( zwr == 0.e0 ) THEN 
    267225              xnummax = zr 
    268226           ELSE 
    … …  
    297255           ENDIF 
    298256                     
    299         ENDDO iflag 
     257        END DO iflag 
    300258                
    301259        xnumm(jk) = xnummax 
    302         WRITE(numout,*) 'jk = ',jk,' wmax = ',wmax,' xnum max = ',xnumm(jk) 
     260        WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 
    303261         
    304262     END DO 
    305263 
    306      WRITE(numout,*) '------------------------------------' 
    307264#endif 
    308265 
    309       !!---------------------------------------------------------------------- 
    310       !! 
    311       !! Initialize biological variables  
    312       !! 
    313       !!---------------------------------------------------------------------- 
    314       !! Set biological ratios 
    315       !! --------------------- 
    316  
    317       rno3   = (16.+2.)/122. 
    318       po4r   = 1./122. 
    319       o2nit  = 32./122. 
    320       rdenit = 97.6/16. 
    321       o2ut   = 140./122. 
    322  
    323       !!---------------------------------------------------------------------- 
    324       !! 
    325       !! Initialize chemical variables  
    326       !! 
    327       !!---------------------------------------------------------------------- 
    328  
    329       !! set pre-industrial atmospheric [co2] (ppm) and o2/n2 ratio 
    330       !! ---------------------------------------------------------- 
    331  
     266      !---------------------------------------------------------------------- 
     267      ! Initialize biological variables  
     268      !---------------------------------------------------------------------- 
     269      ! Set biological ratios 
     270      ! --------------------- 
     271      rno3   = (16.+2.) / 122. 
     272      po4r   =   1.e0   / 122. 
     273      o2nit  =  32.     / 122. 
     274      rdenit =  97.6    /  16. 
     275      o2ut   = 140.     / 122. 
     276 
     277      !---------------------------------------------------------------------- 
     278      ! Initialize chemical variables  
     279      !---------------------------------------------------------------------- 
     280 
     281      ! set pre-industrial atmospheric [co2] (ppm) and o2/n2 ratio 
     282      ! ---------------------------------------------------------- 
    332283      atcox = 0.20946 
    333284 
    334       !! Set lower/upper limits for temperature and salinity 
    335       !! --------------------------------------------------- 
    336  
    337       salchl = 1./1.80655 
    338       calcon = 1.03E-2 
    339  
    340  
    341  
    342       !! Set coefficients for apparent solubility equilibrium of calcite 
    343       !! Millero et al. 1995 from Mucci 1983 
    344       !! -------------------------------------------------------------- 
     285      ! Set lower/upper limits for temperature and salinity 
     286      ! --------------------------------------------------- 
     287      salchl = 1.e0 / 1.80655 
     288      calcon = 1.03e-2 
     289 
     290      ! Set coefficients for apparent solubility equilibrium of calcite 
     291      ! Millero et al. 1995 from Mucci 1983 
     292      ! -------------------------------------------------------------- 
    345293      akcc1 = -171.9065 
    346       akcc2 = -0.077993 
     294      akcc2 =   -0.077993 
    347295      akcc3 = 2839.319 
    348       akcc4 = 71.595 
    349       akcc5 = -0.77712 
    350       akcc6 = 0.0028426 
    351       akcc7 = 178.34 
    352       akcc8 = -0.07711 
    353       akcc9 = 0.0041249 
    354  
    355  
    356  
    357       !! Set coefficients for seawater pressure correction 
    358       !! ------------------------------------------------- 
     296      akcc4 =   71.595 
     297      akcc5 =   -0.77712 
     298      akcc6 =    0.0028426 
     299      akcc7 =  178.34 
     300      akcc8 =   -0.07711 
     301      akcc9 =    0.0041249 
     302 
     303      ! Set coefficients for seawater pressure correction 
     304      ! ------------------------------------------------- 
    359305      devk1(1) = -25.5 
    360       devk2(1) = 0.1271 
    361       devk3(1) = 0. 
    362       devk4(1) = -3.08E-3 
    363       devk5(1) = 0.0877E-3 
    364       !! 
     306      devk2(1) =   0.1271 
     307      devk3(1) =   0.e0 
     308      devk4(1) =  -3.08E-3 
     309      devk5(1) =   0.0877E-3 
     310      ! 
    365311      devk1(2) = -15.82 
    366       devk2(2) = -0.0219 
    367       devk3(2) = 0. 
    368       devk4(2) = 1.13E-3 
    369       devk5(2) = -0.1475E-3 
    370       !! 
     312      devk2(2) =  -0.0219 
     313      devk3(2) =   0.e0 
     314      devk4(2) =   1.13E-3 
     315      devk5(2) =  -0.1475E-3 
     316      ! 
    371317      devk1(3) = -29.48 
    372       devk2(3) = 0.1622 
    373       devk3(3) = 2.608E-3 
    374       devk4(3) = -2.84E-3 
    375       devk5(3) = 0. 
    376       !! 
     318      devk2(3) =   0.1622 
     319      devk3(3) =   2.608E-3 
     320      devk4(3) =  -2.84E-3 
     321      devk5(3) =   0.e0 
     322      ! 
    377323      devk1(4) = -14.51 
    378       devk2(4) = 0.1211 
    379       devk3(4) = -0.321E-3 
    380       devk4(4) = -2.67E-3 
    381       devk5(4) = 0.0427E-3 
    382       !! 
     324      devk2(4) =   0.1211 
     325      devk3(4) =  -0.321E-3 
     326      devk4(4) =  -2.67E-3 
     327      devk5(4) =   0.0427E-3 
     328      ! 
    383329      devk1(5) = -23.12 
    384       devk2(5) = 0.1758 
    385       devk3(5) = -2.647E-3 
    386       devk4(5) = -5.15E-3 
    387       devk5(5) = 0.09E-3 
    388       !! 
     330      devk2(5) =   0.1758 
     331      devk3(5) =  -2.647E-3 
     332      devk4(5) =  -5.15E-3 
     333      devk5(5) =   0.09E-3 
     334      ! 
    389335      devk1(6) = -26.57 
    390       devk2(6) = 0.2020 
    391       devk3(6) = -3.042E-3 
    392       devk4(6) = -4.08E-3 
    393       devk5(6) = 0.0714E-3 
    394       !! 
     336      devk2(6) =   0.2020 
     337      devk3(6) =  -3.042E-3 
     338      devk4(6) =  -4.08E-3 
     339      devk5(6) =   0.0714E-3 
     340      ! 
    395341      devk1(7) = -25.60 
    396       devk2(7) = 0.2324 
    397       devk3(7) = -3.6246E-3 
    398       devk4(7) = -5.13E-3 
    399       devk5(7) = 0.0794E-3 
    400       !! 
    401       !! For calcite with Edmond and Gieske 1970 
    402       !!     devkst = 0.23 
    403       !!     devks  = 35.4 
    404       !! Millero 95 takes this depth dependance for calcite 
     342      devk2(7) =   0.2324 
     343      devk3(7) =  -3.6246E-3 
     344      devk4(7) =  -5.13E-3 
     345      devk5(7) =   0.0794E-3 
     346      ! 
     347      ! For calcite with Edmond and Gieske 1970 
     348      !     devkst = 0.23 
     349      !     devks  = 35.4 
     350      ! Millero 95 takes this depth dependance for calcite 
    405351      devk1(8) = -48.76 
    406       devk2(8) = 0.5304 
    407       devk3(8) = 0. 
     352      devk2(8) =   0.5304 
     353      devk3(8) =   0.e0 
    408354      devk4(8) = -11.76E-3 
    409       devk5(8) = 0.3692E-3 
    410       !! 
    411       !! Coefficients for sulfate and fluoride 
     355      devk5(8) =   0.3692E-3 
     356      ! 
     357      ! Coefficients for sulfate and fluoride 
    412358      devk1(9) = -18.03 
    413       devk2(9) = 0.0466 
    414       devk3(9) = 0.316E-3 
    415       devk4(9) = -4.53E-3 
    416       devk5(9) = 0.09E-3 
     359      devk2(9) =   0.0466 
     360      devk3(9) =   0.316e-3 
     361      devk4(9) =  -4.53e-3 
     362      devk5(9) =   0.09e-3 
    417363 
    418364      devk1(10) = -9.78 
    419365      devk2(10) = -0.0090 
    420       devk3(10) = -0.942E-3 
    421       devk4(10) = -3.91E-3 
    422       devk5(10) = 0.054E-3 
    423  
    424  
    425       !! Set universal gas constants 
    426       !! --------------------------- 
    427  
    428       rgas = 83.143 
    429       oxyco = 1./22.4144 
    430  
    431       !! Set boron constants 
    432       !! ------------------- 
    433  
     366      devk3(10) = -0.942e-3 
     367      devk4(10) = -3.91e-3 
     368      devk5(10) =  0.054e-3 
     369 
     370 
     371      ! Set universal gas constants 
     372      ! --------------------------- 
     373      rgas  = 83.143 
     374      oxyco =  1.e0 / 22.4144 
     375 
     376      ! Set boron constants 
     377      ! ------------------- 
    434378      bor1 = 0.00023 
    435       bor2 = 1./10.82 
    436  
    437       !! Set volumetric solubility constants for co2 in ml/l (Weiss, 1974) 
    438       !! ----------------------------------------------------------------- 
    439  
     379      bor2 = 1.e0 / 10.82 
     380 
     381      ! Set volumetric solubility constants for co2 in ml/l (Weiss, 1974) 
     382      ! ----------------------------------------------------------------- 
    440383      c00 = -60.2409 
    441       c01 = 93.4517 
    442       c02 = 23.3585 
    443       c03 = 0.023517 
    444       c04 = -0.023656 
    445       c05 = 0.0047036 
    446  
     384      c01 =  93.4517 
     385      c02 =  23.3585 
     386      c03 =   0.023517 
     387      c04 =  -0.023656 
     388      c05 =   0.0047036 
     389      ! 
    447390      ca0 = -162.8301 
    448       ca1 = 218.2968 
    449       ca2 = 90.9241 
    450       ca3 = -1.47696 
    451       ca4 = 0.025695 
    452       ca5 = -0.025225 
    453       ca6 = 0.0049867 
    454  
    455       !! Set coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 
    456       !! --------------------------------------------------------------------- 
    457  
     391      ca1 =  218.2968 
     392      ca2 =   90.9241 
     393      ca3 =   -1.47696 
     394      ca4 =    0.025695 
     395      ca5 =   -0.025225 
     396      ca6 =    0.0049867 
     397 
     398      ! Set coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 
     399      ! --------------------------------------------------------------------- 
    458400      c10 = -3670.7 
    459       c11 =  62.008 
    460       c12 = -9.7944 
    461       c13 = 0.0118 
    462       c14 = -0.000116 
    463  
    464       !! Set coeff. for 2. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 
    465       !! --------------------------------------------------------------------- 
    466  
     401      c11 =    62.008 
     402      c12 =    -9.7944 
     403      c13 =     0.0118 
     404      c14 =    -0.000116 
     405 
     406      ! Set coeff. for 2. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 
     407      ! --------------------------------------------------------------------- 
    467408      c20 = -1394.7 
    468       c21 = -4.777 
    469       c22 = 0.0184 
    470       c23 = -0.000118 
    471  
    472       !! Set constants for calculate concentrations for sulfate and fluoride 
    473       !! sulfates (Morris & Riley 1966) 
    474       !!---------------------------------------------------------------------- 
    475  
     409      c21 =    -4.777 
     410      c22 =     0.0184 
     411      c23 =    -0.000118 
     412 
     413      ! Set constants for calculate concentrations for sulfate and fluoride 
     414      ! sulfates (Morris & Riley 1966) 
     415      !---------------------------------------------------------------------- 
    476416      st1 = 0.14 
    477       st2 = 1./96.062 
    478  
    479       !! fluoride 
    480       !!------------ 
    481  
     417      st2 = 1.e0 / 96.062 
     418 
     419      ! fluoride 
     420      ! -------- 
    482421      ft1 = 0.000067 
    483       ft2 = 1./18.9984 
    484  
    485       !! sulfates (Dickson 1990 change to mol:kg soln, idem OCMIP) 
    486       !!---------------------------------------------------------- 
    487  
    488       ks0  = 141.328 
    489       ks1  = -4276.1 
    490       ks2  = -23.093 
    491       ks3  = -13856 
    492       ks4  = 324.57 
    493       ks5  = -47.986 
    494       ks6  = 35474 
    495       ks7  = -771.54 
    496       ks8  = 114.723 
    497       ks9  = -2698 
    498       ks10 = 1776 
    499       ks11 = 1. 
    500       ks12 = -0.001005 
    501  
    502       !! fluorides (Dickson & Riley 1979 change to mol/kg soln) 
    503       !!------------------------------------------------------- 
    504       kf0 = -12.641 
     422      ft2 = 1.e0 / 18.9984 
     423 
     424      ! sulfates (Dickson 1990 change to mol:kg soln, idem OCMIP) 
     425      !---------------------------------------------------------- 
     426      ks0  =    141.328 
     427      ks1  =  -4276.1 
     428      ks2  =    -23.093 
     429      ks3  = -13856. 
     430      ks4  =    324.57 
     431      ks5  =    -47.986 
     432      ks6  =  35474. 
     433      ks7  =   -771.54 
     434      ks8  =    114.723 
     435      ks9  =  -2698. 
     436      ks10 =   1776. 
     437      ks11 =      1. 
     438      ks12 =     -0.001005 
     439 
     440      ! fluorides (Dickson & Riley 1979 change to mol/kg soln) 
     441      !------------------------------------------------------- 
     442      kf0 =  -12.641 
    505443      kf1 = 1590.2 
    506       kf2 = 1.525 
    507       kf3 = 1.0 
    508       kf4 = -0.001005 
    509  
    510       !! 
    511       !! Set coeff. for 1. dissoc. of boric acid (Edmond and Gieskes, 1970) 
    512       !! ------------------------------------------------------------------ 
    513  
     444      kf2 =    1.525 
     445      kf3 =    1.0 
     446      kf4 =   -0.001005 
     447 
     448      ! Set coeff. for 1. dissoc. of boric acid (Edmond and Gieskes, 1970) 
     449      ! ------------------------------------------------------------------ 
    514450      cb0  = -8966.90 
    515451      cb1  = -2890.53 
    516       cb2  = -77.942 
    517       cb3  = 1.728 
    518       cb4  = -0.0996 
    519       cb5  = 148.0248 
    520       cb6  = 137.1942 
    521       cb7  = 1.62142 
    522       cb8  = -24.4344 
    523       cb9  = -25.085 
    524       cb10 = -0.2474 
    525       cb11 = 0.053105 
    526  
    527  
    528       !! Set coeff. for dissoc. of water (Dickson and Riley, 1979,  
    529       !!   eq. 7, coefficient cw2 corrected from 0.9415 to 0.09415  
    530       !!   after pers. commun. to B. Bacastow, 1988) 
    531       !! --------------------------------------------------------- 
    532  
     452      cb2  =   -77.942 
     453      cb3  =     1.728 
     454      cb4  =    -0.0996 
     455      cb5  =   148.0248 
     456      cb6  =   137.1942 
     457      cb7  =     1.62142 
     458      cb8  =   -24.4344 
     459      cb9  =   -25.085 
     460      cb10 =    -0.2474 
     461      cb11 =     0.053105 
     462 
     463      ! Set coeff. for dissoc. of water (Dickson and Riley, 1979,  
     464      !   eq. 7, coefficient cw2 corrected from 0.9415 to 0.09415  
     465      !   after pers. commun. to B. Bacastow, 1988) 
     466      ! --------------------------------------------------------- 
    533467      cw0 = -13847.26 
    534       cw1 = 148.9652 
    535       cw2 = -23.6521 
    536       cw3 = 118.67 
    537       cw4 = -5.977 
    538       cw5 = 1.0495 
    539       cw6 = -0.01615 
    540  
    541  
    542       !! Set coeff. for dissoc. of phosphate (Millero (1974) 
    543       !! --------------------------------------------------- 
    544        
    545       cp10 = 115.54 
     468      cw1 =    148.9652 
     469      cw2 =    -23.6521 
     470      cw3 =    118.67 
     471      cw4 =     -5.977 
     472      cw5 =      1.0495 
     473      cw6 =     -0.01615 
     474 
     475      ! Set coeff. for dissoc. of phosphate (Millero (1974) 
     476      ! --------------------------------------------------- 
     477      cp10 =   115.54 
    546478      cp11 = -4576.752 
    547       cp12 = -18.453 
    548       cp13 = -106.736 
    549       cp14 = 0.69171 
    550       cp15 = -0.65643 
    551       cp16 = -0.01844 
    552  
    553       cp20 = 172.1033 
     479      cp12 =   -18.453 
     480      cp13 =  -106.736 
     481      cp14 =     0.69171 
     482      cp15 =    -0.65643 
     483      cp16 =    -0.01844 
     484      ! 
     485      cp20 =   172.1033 
    554486      cp21 = -8814.715 
    555       cp22 = -27.927 
    556       cp23 = -160.340 
    557       cp24 = 1.3566 
    558       cp25 = 0.37335 
    559       cp26 = -0.05778 
    560  
    561  
    562       cp30 = -18.126 
     487      cp22 =   -27.927 
     488      cp23 =  -160.340 
     489      cp24 =     1.3566 
     490      cp25 =     0.37335 
     491      cp26 =    -0.05778 
     492      ! 
     493      cp30 =   -18.126 
    563494      cp31 = -3070.75 
    564       cp32 = 17.27039 
    565       cp33 = 2.81197 
    566       cp34 = -44.99486 
    567       cp35 = -0.09984 
    568  
    569  
    570       !! Set coeff. for dissoc. of phosphate (Millero (1974) 
    571       !! --------------------------------------------------- 
    572        
    573       cs10 = 117.385 
     495      cp32 =    17.27039 
     496      cp33 =     2.81197 
     497      cp34 =   -44.99486 
     498      cp35 =    -0.09984 
     499 
     500      ! Set coeff. for dissoc. of phosphate (Millero (1974) 
     501      ! --------------------------------------------------- 
     502      cs10 =   117.385 
    574503      cs11 = -8904.2 
    575       cs12 = -19.334 
    576       cs13 = -458.79 
    577       cs14 =  3.5913 
    578       cs15 = 188.74 
    579       cs16 = -1.5998 
    580       cs17 = -12.1652 
    581       cs18 = 0.07871 
    582       cs19 = 0. 
    583       cs20 = 1. 
    584       cs21 = -0.001005 
    585  
    586  
    587       !! Set volumetric solubility constants for o2 in ml/l (Weiss, 1970) 
    588       !! ---------------------------------------------------------------- 
    589  
     504      cs12 =   -19.334 
     505      cs13 =  -458.79 
     506      cs14 =     3.5913 
     507      cs15 =   188.74 
     508      cs16 =    -1.5998 
     509      cs17 =   -12.1652 
     510      cs18 =     0.07871 
     511      cs19 =     0.e0 
     512      cs20 =     1.e0 
     513      cs21 =    -0.001005 
     514 
     515 
     516      ! Set volumetric solubility constants for o2 in ml/l (Weiss, 1970) 
     517      ! ---------------------------------------------------------------- 
    590518      ox0 = -58.3877 
    591       ox1 = 85.8079 
    592       ox2 = 23.8439 
    593       ox3 = -0.034892 
    594       ox4 = 0.015568 
    595       ox5 = -0.0019387 
    596  
    597       !!  FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE 
    598       !!  A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT 
     519      ox1 =  85.8079 
     520      ox2 =  23.8439 
     521      ox3 =  -0.034892 
     522      ox4 =   0.015568 
     523      ox5 =  -0.0019387 
     524 
     525      !  FROM THE NEW BIOOPTIC MODEL PROPOSED JM ANDRE, WE READ HERE 
     526      !  A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT 
    599527 
    600528      CALL ctlopn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    601529         &           1, numout, .TRUE., 1 ) 
    602530      DO ichl = 1,61 
    603          READ(numlight,*) ztoto,(xkrgb(iband,ichl),iband = 1,3) 
     531         READ(numlight,*) ztoto, ( xkrgb(iband,ichl), iband = 1,3 ) 
    604532      END DO 
    605533      CLOSE(numlight) 
    606534 
    607535 
    608       !!  Call p4zche to initialize the chemical constants 
    609       !!  ------------------------------------------------ 
    610  
    611       CALL p4zche 
    612       !! 
    613       !!  Initialize a counter for the computation of chemistry 
    614       !! 
    615       ndayflxtr=0 
     536      CALL p4zche        ! initialize the chemical constants 
     537 
     538 
     539      ndayflxtr = 0      !  Initialize a counter for the computation of chemistry 
     540 
    616541 
    617542      IF(lwp) WRITE(numout,*) ' Initialisation of PISCES done' 
    618  
     543      ! 
    619544   END SUBROUTINE trc_ini 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trclsm.cfc.h90

    r719 r763  
    11   !!---------------------------------------------------------------------- 
    2    !!                    ***  trclsm.cfc.h90 *** 
     2   !!                     ***  trclsm.cfc.h90  ***   
     3   !! TOP :   Definition some run parameter for CFC chemical model 
    34   !!---------------------------------------------------------------------- 
     5   !! History :   1.0  !  2003-08 (C. Ethe)  Original code 
     6   !!---------------------------------------------------------------------- 
     7 
     8   !!---------------------------------------------------------------------- 
     9   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     10   !! $Id $  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     12   !!---------------------------------------------------------------------- 
     13 
    414CONTAINS 
    515 
    616   SUBROUTINE trc_lsm 
    717      !!------------------------------------------------------------------- 
    8       !!                  ***  ROUTINE trc_lsm *** 
     18      !!                  ***  ROUTINE trc_lsm  *** 
    919      !!                  
    1020      !! ** Purpose :   Definition some run parameter for CFC model 
    … …  
    1424      !! 
    1525      !! ** input   :   Namelist namcfc 
     26      !!---------------------------------------------------------------------- 
     27      CHARACTER (len=32) ::   clname = 'namelist.trc.sms' 
     28      INTEGER ::   numnat 
    1629      !! 
    17       !! history : 
    18       !!   2.0  !  03-08 (C. Ethe)  Original code 
    19       !!---------------------------------------------------------------------- 
    20       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    21    !! $Header$  
    22    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    23       !!---------------------------------------------------------------------- 
    24  
    25       CHARACTER (len=32) ::  & 
    26          clname = 'namelist.trc.sms' 
    27       INTEGER ::  & 
    28          numnat 
    29  
    30       NAMELIST/namdates/ndate_beg, nyear_res 
     30      NAMELIST/namdates/ ndate_beg, nyear_res 
    3131      !!------------------------------------------------------------------- 
    3232 
    33       ndate_beg = 300101 
     33      ndate_beg = 300101            ! default namelist value 
    3434      nyear_res = 1950 
    3535 
    36       IF(lwp) THEN 
    37          WRITE(numout,*) ' ' 
    38          WRITE(numout,*) ' Namelist for CFC model' 
    39          WRITE(numout,*) ' ***********************' 
    40          WRITE(numout,*) ' ' 
    41       ENDIF 
    42  
     36      !                             ! Open namelist file 
    4337      CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    4438         &           1, numout, .FALSE., 1 ) 
    45       READ( numnat , namdates ) 
     39          
     40      READ( numnat , namdates )     ! read namelist 
    4641 
    47       IF(lwp) THEN 
     42      IF(lwp) THEN                  ! control print 
    4843         WRITE(numout,*) 
    49          WRITE(numout,*) ' trc_lsm: Namelist parameter' 
    50          WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    51          WRITE(numout,*) '  initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg 
    52          WRITE(numout,*) '  restoring time constant (year)          nyear_res = ', nyear_res 
     44         WRITE(numout,*) ' trc_lsm: Read namdates, namelist for CFC chemical model' 
     45         WRITE(numout,*) ' ~~~~~~~' 
     46         WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg 
     47         WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res 
    5348      ENDIF 
    5449      nyear_beg = ndate_beg / 10000 
    55       IF(lwp) THEN 
    56          WRITE(numout,*) '  initial year (aa)                       nyear_beg = ', nyear_beg 
    57          WRITE(numout,*) ' ' 
    58       ENDIF 
    59  
     50      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg 
     51      ! 
    6052   END SUBROUTINE trc_lsm 
    61  

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trclsm.lobster1.h90

    r719 r763  
    1 !!---------------------------------------------------------------------- 
    2 !!                    ***  trclsm.lobster1.h90 *** 
    3 !!---------------------------------------------------------------------- 
     1   !!---------------------------------------------------------------------- 
     2   !!                     ***  trclsm.lobster1.h90  ***   
     3   !! TOP :   Definition some run parameter for LOBSTER biological model 
     4   !!---------------------------------------------------------------------- 
     5   !! History :    -  !  1999-10 (M.A. Foujols, M. Levy) original code 
     6   !!              -  !  2000-12 (O. Aumont, E. Kestenare) add sediments 
     7   !!             1.0 !  2003-08 (C. Ethe)  Original code 
     8   !!---------------------------------------------------------------------- 
     9 
     10   !!---------------------------------------------------------------------- 
     11   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     12   !! $Id $  
     13   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     14   !!---------------------------------------------------------------------- 
     15 
    416CONTAINS 
    517 
    618   SUBROUTINE trc_lsm 
    719      !!---------------------------------------------------------------------- 
    8       !!                        trclsm.lobster1.h 
    9       !!                     ********************** 
     20      !!                     ***  trc_lsm  ***   
    1021      !! 
    11       !!  PURPOSE : 
    12       !!  --------- 
    13       !!     READS the specific NAMELIST for LOBSTER1 model 
     22      !! ** Purpose :   read LOBSTER namelist 
    1423      !! 
    15       !!   WORKSPACE :                : no 
    16       !!   --------- 
     24      !! ** input   :   file 'namelist.trc.sms' containing the following 
     25      !!             namelist: natbio, natopt, and natdbi ("key_trc_diabio") 
     26      !!---------------------------------------------------------------------- 
     27      CHARACTER (len=32) :: clname 
    1728      !! 
    18       !!   MODIFICATIONS: 
    19       !!   -------------- 
    20       !!      original  : 99-10 (M.A. Foujols, M. Levy) passive tracer 
    21       !!      additions : 00-12 (O. Aumont, E. Kestenare) add sediments 
    22       !! ---------------------------------------------------------------------- 
    23       !! local declarations 
    24       !! ================== 
    25       CHARACTER (len=32) :: clname 
    26  
    27       !!--------------------------------------------------------------------- 
    28       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    29    !! $Header$  
    30    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    31       !!--------------------------------------------------------------------- 
    32  
    33       ! 0. initializations 
    34       ! ------------------ 
    35      NAMELIST/natbio/apmin,azmin,anmin,admin,   & 
    36       &   redf,reddom,slopet,toptp,psinut,akno3,aknh4,rcchl,        & 
    37       &   rgamma,toptgz,tmaxgz,rgz,             & 
    38       &   rppz,taus,aks,filmax,rpnaz,rdnaz,eggzoo,tauzn,   & 
    39       &   tmmaxp,tmminp,tmmaxz,tmminz,anumin,afdmin,taudn,   & 
    40       &   vsed,tmumax,aki,tmaxr,tminr, taunn, taudomn,xhr,   & 
    41       &   sedlam, sedlostpoc,  & 
    42       &    fphylab,fzoolab,fdetlab,fdbod 
    43       NAMELIST/natopt/xkg0,xkr0,xkgp,xkrp,xlg,xlr,rpig 
     29      NAMELIST/natbio/ apmin, azmin, anmin, admin,                       & 
     30         &   redf, reddom, slopet, toptp, psinut, akno3, aknh4, rcchl,   & 
     31         &   rgamma, toptgz, tmaxgz, rgz,                                & 
     32         &   rppz, taus, aks, filmax, rpnaz, rdnaz, eggzoo, tauzn,       & 
     33         &   tmmaxp, tmminp, tmmaxz, tmminz, anumin, afdmin, taudn,      & 
     34         &   vsed, tmumax, aki, tmaxr, tminr, taunn, taudomn, xhr,       & 
     35         &   sedlam, sedlostpoc,                                         & 
     36         &   fphylab, fzoolab, fdetlab, fdbod 
     37      NAMELIST/natopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig 
    4438#if defined key_trc_diabio 
    4539      INTEGER :: ji 
    4640      NAMELIST/natdbi/ctrbio,ctrbil,ctrbiu,nwritebio 
    4741#endif 
    48  
    49       IF(lwp) THEN 
    50          WRITE(numout,*) ' ' 
    51          WRITE(numout,*) ' ROUTINE trclsm' 
    52          WRITE(numout,*) ' **************' 
    53          WRITE(numout,*) ' ' 
    54          WRITE(numout,*) ' namelist for lobster1 model' 
    55          WRITE(numout,*) ' ***************************' 
    56          WRITE(numout,*) ' ' 
    57       ENDIF 
    58  
    59  
     42      !!---------------------------------------------------------------------- 
     43 
     44      IF(lwp) WRITE(numout,*) 
     45      IF(lwp) WRITE(numout,*) ' trc_lsm : read LOBSTER 1 namelists' 
     46      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     47 
     48      !                               ! Open the namelist file 
     49      !                               ! ---------------------- 
    6050      clname ='namelist.trc.sms' 
    6151      CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    6252         &           1, numout, .FALSE., 1 ) 
    6353 
    64       ! 1.4 namelist natbio : biological parameters 
    65       ! ------------------------------------------- 
    66  
    67       apmin = 0. 
     54      !                               ! natbio : biological parameters 
     55      !                               ! ------------------------------ 
     56      apmin = 0.                           ! default values 
    6857      azmin = 0. 
    6958      anmin = 0. 
    … …  
    111100      fdbod = 0. 
    112101 
    113       READ(numnat,natbio) 
     102      REWIND( numnat )                     ! read natbio 
     103      READ  ( numnat, natbio ) 
    114104 
    115105      IF(lwp) THEN 
    116           WRITE(numout,*) 'natbio' 
    117           WRITE(numout,*) ' ' 
    118           WRITE(numout,*)     & 
    119           &   ' minimum phytoplancton concentration  apmin =', apmin 
    120           WRITE(numout,*)     & 
    121           &   ' minimum zooplancton   concentration  azmin =', azmin 
    122           WRITE(numout,*)     & 
    123           &   ' minimum nutrients     concentration  anmin =', anmin 
    124           WRITE(numout,*)     & 
    125           &   ' minimum detritus      concentration  admin =', admin 
    126           WRITE(numout,*)     & 
    127           &   ' redfield ratio  c:n                   redf =', redf 
    128           WRITE(numout,*)     & 
    129           &   ' van t hoff coefficient              slopet =', slopet 
    130           WRITE(numout,*)     & 
    131           &   ' optimal photosynthesis temperature   toptp =', toptp 
    132           WRITE(numout,*)     & 
    133           &   ' inhibition of no3 uptake by nh4      psinut =', psinut 
    134           WRITE(numout,*)     & 
    135           &   ' half-saturation nutrient for no3 uptake   akno3 =', akno3 
    136           WRITE(numout,*)     & 
    137           &   ' half-saturation nutrient for nh4 uptake   aknh4 =', aknh4 
    138           WRITE(numout,*)     & 
    139           &   ' carbone/chlorophyl ratio             rcchl =', rcchl 
    140           WRITE(numout,*)     & 
    141           &   ' phytoplankton exudation fraction    rgamma =', rgamma 
    142           WRITE(numout,*)     & 
    143           &   ' optimal temperature for zoo growth  toptgz =', toptgz 
    144           WRITE(numout,*)     & 
    145           &   ' maximal temperature for zoo growth  tmaxgz =', tmaxgz 
    146           WRITE(numout,*)     & 
    147           &   ' widtht of zoo temperature FUNCTION     rgz =', rgz 
    148           WRITE(numout,*)     & 
    149           &   ' zoo preference for phyto              rppz =', rppz 
    150           WRITE(numout,*)     & 
    151           &   ' maximal zoo grazing rate              taus =',86400*taus 
    152           WRITE(numout,*)     & 
    153           &   ' half saturation constant for zoo food  aks =', aks 
    154           WRITE(numout,*)     & 
    155           &   ' maximal mass clearance rate for zoo filmax =', filmax 
    156           WRITE(numout,*)     & 
    157           &   ' non-assimilated phyto by zoo         rpnaz =', rpnaz 
    158           WRITE(numout,*)     & 
    159           &   ' non-assimilated detritus by zoo      rdnaz =', rdnaz 
    160           WRITE(numout,*)     & 
    161           &   ' minimum  for zoo concentration      eggzoo =', eggzoo 
    162           WRITE(numout,*)     & 
    163           &   ' zoo specific excretion rate          tauzn =',86400   & 
    164           &   *tauzn 
    165           WRITE(numout,*)     & 
    166           &   ' maximal phyto mortality rate        tmmaxp =',86400   & 
    167           &   *tmmaxp 
    168           WRITE(numout,*)     & 
    169           &   ' minimal phyto mortality rate        tmminp =',86400   & 
    170           &   *tmminp 
    171           WRITE(numout,*)     & 
    172           &   ' maximal zoo mortality rate          tmmaxz =',86400   & 
    173           &   *tmmaxz 
    174           WRITE(numout,*)     & 
    175           &   ' minimal zoo mortality rate          tmminz =',86400   & 
    176           &   *tmminz 
    177           WRITE(numout,*)     & 
    178           &   ' nutrient threshold for phyto mort   anumin =', anumin 
    179           WRITE(numout,*)     & 
    180           &   ' food threshold for zoo mort         afdmin =', afdmin 
    181           WRITE(numout,*)     & 
    182           &   ' detrital breakdown rate              taudn =',86400   & 
    183           &   *taudn 
    184           WRITE(numout,*)     & 
    185           &   ' detritus sedimentation speed          vsed =',86400*vsed 
    186           WRITE(numout,*)     & 
    187           &   ' phyto max growth rate               tmumax =',86400   & 
    188           &   *tmumax 
    189           WRITE(numout,*)     & 
    190           &   ' light hlaf saturation constant         aki =', aki 
    191           WRITE(numout,*)     & 
    192           &   ' maximum damping for d z or p         tmaxr =', tmaxr 
    193           WRITE(numout,*)     & 
    194           &   ' damping-remineralisation rate        tminr =', tminr 
    195           WRITE(numout,*)     &  
    196           &   ' nitrification rate                   taunn =', taunn 
    197           WRITE(numout,*)     &  
    198           &   ' dom remineralisation rate          taudomn =', taudomn 
    199           WRITE(numout,*)     &  
    200           &   ' coeff for martin''s remineralistion    xhr =', xhr 
    201           WRITE(numout,*)     &  
    202           &   ' time coeff of POC in sediments      sedlam =', sedlam 
    203           WRITE(numout,*)     & 
    204           &   ' Sediment geol loss for POC  sedlostpoc =', sedlostpoc 
    205           WRITE(numout,*)     & 
    206           & ' NH4 fraction of phytoplankton exsudation fphylab =', fphylab 
    207           WRITE(numout,*)     & 
    208           & ' NH4 fraction of zooplankton excretion fzoolab =', fzoolab 
    209           WRITE(numout,*)     & 
    210           & ' NH4 fraction of detritus dissolution  fdetlab =', fdetlab 
    211           WRITE(numout,*)     & 
    212           & ' Zooplankton mortality fraction that goes to detritus fdbod =', fdbod 
     106          WRITE(numout,*) ' Namelist natbio' 
     107          WRITE(numout,*) '    minimum phytoplancton concentration                  apmin     =', apmin 
     108          WRITE(numout,*) '    minimum zooplancton   concentration                  azmin     =', azmin 
     109          WRITE(numout,*) '    minimum nutrients     concentration                  anmin     =', anmin 
     110          WRITE(numout,*) '    minimum detritus      concentration                  admin     =', admin 
     111          WRITE(numout,*) '    redfield ratio  c:n                                  redf      =', redf 
     112          WRITE(numout,*) '    van t hoff coefficient                               slopet    =', slopet 
     113          WRITE(numout,*) '    optimal photosynthesis temperature                   toptp     =', toptp 
     114          WRITE(numout,*) '    inhibition of no3 uptake by nh4                      psinut    =', psinut 
     115          WRITE(numout,*) '    half-saturation nutrient for no3 uptake              akno3     =', akno3 
     116          WRITE(numout,*) '    half-saturation nutrient for nh4 uptake              aknh4     =', aknh4 
     117          WRITE(numout,*) '    carbone/chlorophyl ratio                             rcchl     =', rcchl 
     118          WRITE(numout,*) '    phytoplankton exudation fraction                     rgamma    =', rgamma 
     119          WRITE(numout,*) '    optimal temperature for zoo growth                   toptgz    =', toptgz 
     120          WRITE(numout,*) '    maximal temperature for zoo growth                   tmaxgz    =', tmaxgz 
     121          WRITE(numout,*) '    widtht of zoo temperature FUNCTION                   rgz       =', rgz 
     122          WRITE(numout,*) '    zoo preference for phyto                             rppz      =', rppz 
     123          WRITE(numout,*) '    maximal zoo grazing rate                             taus      =', 86400 * taus, ' d' 
     124          WRITE(numout,*) '    half saturation constant for zoo food                aks       =', aks 
     125          WRITE(numout,*) '    maximal mass clearance rate for zoo                  filmax    =', filmax 
     126          WRITE(numout,*) '    non-assimilated phyto by zoo                         rpnaz     =', rpnaz 
     127          WRITE(numout,*) '    non-assimilated detritus by zoo                      rdnaz     =', rdnaz 
     128          WRITE(numout,*) '    minimum  for zoo concentration                       eggzoo    =', eggzoo 
     129          WRITE(numout,*) '    zoo specific excretion rate                          tauzn     =', 86400 * tauzn 
     130          WRITE(numout,*) '    maximal phyto mortality rate                         tmmaxp    =', 86400 * tmmaxp 
     131          WRITE(numout,*) '    minimal phyto mortality rate                         tmminp    =', 86400 * tmminp 
     132          WRITE(numout,*) '    maximal zoo mortality rate                           tmmaxz    =', 86400 * tmmaxz 
     133          WRITE(numout,*) '    minimal zoo mortality rate                           tmminz    =', 86400 * tmminz 
     134          WRITE(numout,*) '    nutrient threshold for phyto mort                    anumin    =', anumin 
     135          WRITE(numout,*) '    food threshold for zoo mort                          afdmin    =', afdmin 
     136          WRITE(numout,*) '    detrital breakdown rate                              taudn     =', 86400 * taudn , ' d' 
     137          WRITE(numout,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d' 
     138          WRITE(numout,*) '    phyto max growth rate                                tmumax    =', 86400 * tmumax, ' d' 
     139          WRITE(numout,*) '    light hlaf saturation constant                       aki       =', aki 
     140          WRITE(numout,*) '    maximum damping for d z or p                         tmaxr     =', tmaxr 
     141          WRITE(numout,*) '    damping-remineralisation rate                        tminr     =', tminr 
     142          WRITE(numout,*) '    nitrification rate                                   taunn     =', taunn 
     143          WRITE(numout,*) '    dom remineralisation rate                            taudomn   =', taudomn 
     144          WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr 
     145          WRITE(numout,*) '    time coeff of POC in sediments                       sedlam    =', sedlam 
     146          WRITE(numout,*) '    Sediment geol loss for POC                           sedlostpoc=', sedlostpoc 
     147          WRITE(numout,*) '    NH4 fraction of phytoplankton exsudation             fphylab   =', fphylab 
     148          WRITE(numout,*) '    NH4 fraction of zooplankton excretion                fzoolab   =', fzoolab 
     149          WRITE(numout,*) '    NH4 fraction of detritus dissolution                 fdetlab   =', fdetlab 
     150          WRITE(numout,*) '    Zooplankton mortality fraction that goes to detritus fdbod     =', fdbod 
    213151      ENDIF 
    214152 
    215       ! 1.5 namelist natopt : parameters for optic 
    216       ! ------------------------------------------ 
    217  
    218       xkg0  = 0. 
     153      !                               ! natopt : optical parameters 
     154      !                               ! --------------------------- 
     155      xkg0  = 0.                           ! default values 
    219156      xkr0  = 0. 
    220157      xkgp  = 0. 
    … …  
    224161      rpig  = 0. 
    225162 
    226       READ(numnat,natopt) 
     163      REWIND( numnat )                     ! read natopt 
     164      READ  ( numnat, natopt )        
     165 
     166      IF(lwp) THEN                         ! control print 
     167         WRITE(numout,*) 
     168         WRITE(numout,*) ' Namelist natopt' 
     169         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0 
     170         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0 
     171         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp 
     172         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp 
     173         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg 
     174         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr 
     175         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig 
     176      ENDIF 
     177 
     178#if defined key_trc_diabio 
     179 
     180      !                               ! natdbi : bio diagnostics 
     181      !                               ! ------------------------ 
     182      nwritebio = 10                     ! default values 
     183      DO ji = 1, jpdiabio 
     184         IF(     ji <  10 ) THEN   ;   WRITE (ctrbio(ji),'("BIO_",I1)') ji      ! short name 
     185         ELSEIF (ji < 100 ) THEN   ;   WRITE (ctrbio(ji),'("BIO_",I2)') ji    
     186         ELSE                      ;   WRITE (ctrbio(ji),'("BIO_",I3)') ji 
     187         ENDIF 
     188         WRITE(ctrbil(ji),'("BIOLOGICAL TREND NUMBER ",I2)') ji                 ! long name 
     189         ctrbiu(ji) = 'mmoleN/m3/s '                                            ! units 
     190      END DO 
     191 
     192      REWIND( numnat )                     ! read natdbi 
     193      READ  ( numnat, natdbi )   
    227194 
    228195      IF(lwp) THEN 
    229          WRITE(numout,*) 'natopt' 
    230          WRITE(numout,*) ' ' 
    231          WRITE(numout,*) ' green   water absorption coeff  xkg0  = ',xkg0 
    232          WRITE(numout,*) ' red water absorption coeff      xkr0  = ',xkr0 
    233          WRITE(numout,*) ' pigment red absorption coeff    xkrp  = ',xkrp 
    234          WRITE(numout,*) ' pigment green absorption coeff  xkgp  = ',xkgp 
    235          WRITE(numout,*) ' green chl exposant              xlg   = ',xlg 
    236          WRITE(numout,*) ' red   chl exposant              xlr   = ',xlr 
    237          WRITE(numout,*) ' chla/chla+phea ratio            rpig  = ',rpig 
    238          WRITE(numout,*) ' ' 
    239  
    240       ENDIF 
    241  
    242 #if defined key_trc_diabio 
    243  
    244       ! NAMELIST : natdbi  
    245  
    246       ! default name for biological trends : short and long name, units 
    247  
    248       DO ji=1,jpdiabio 
    249          IF (ji < 10) THEN  
    250             WRITE (ctrbio(ji),'("BIO_",I1)') ji 
    251          ELSE IF (ji < 100) THEN 
    252             WRITE (ctrbio(ji),'("BIO_",I2)') ji 
    253          ELSE 
    254             WRITE (ctrbio(ji),'("BIO_",I3)') ji 
    255          ENDIF 
    256          WRITE (ctrbil(ji),'("BIOLOGICAL TREND NUMBER ",I2)') ji 
    257          ctrbiu(ji)='mmoleN/m3/s ' 
    258       END DO 
    259  
    260       nwritebio = 10 
    261  
    262       READ(numnat,natdbi) 
    263  
    264       IF(lwp) THEN 
    265          WRITE(numout,*) 'natdbi' 
    266          WRITE(numout,*) ' ' 
    267          WRITE(numout,*)      & 
    268             &   ' frequency of outputs for biological outputs = '    & 
    269             &   ,nwritebio 
    270          WRITE(numout,*) ' ' 
    271          DO ji=1,jpdiabio 
    272             WRITE(numout,*)     & 
    273                &   'name of biological trend number :',ji,' : ',ctrbio(ji)   
    274             WRITE(numout,*) ctrbil(ji)   
    275             WRITE(numout,*) ' in unit = ',ctrbiu(ji) 
     196         WRITE(numout,*) 
     197         WRITE(numout,*) ' Namelist natdbi' 
     198         WRITE(numout,*) '    frequency of outputs for biological outputs  nwritebio = ', nwritebio 
     199         DO ji = 1, jpdiabio 
     200            WRITE(numout,*) '     name of biological trend No :',ji,' : ',ctrbio(ji), ctrbil(ji), ' in ', ctrbiu(ji) 
    276201         END DO 
    277202      END IF 
    278203#endif 
    279  
     204      ! 
    280205   END SUBROUTINE trc_lsm 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trclsm.pisces.h90

    r730 r763  
    1 !!---------------------------------------------------------------------- 
    2 !!                    ***  trclsm.pisces.h90 *** 
    3 !!---------------------------------------------------------------------- 
     1   !!---------------------------------------------------------------------- 
     2   !!                     ***  trclsm.pisces.h90  ***   
     3   !! TOP :   Definition some run parameter for PISCES biological model 
     4   !!---------------------------------------------------------------------- 
     5   !! History :    -  !  1999-10 (M.A. Foujols, M. Levy) original code 
     6   !!              -  !  2000-01 (L. Bopp) hamocc3, p3zd 
     7   !!             1.0 !  2003-08 (C. Ethe)  module F90 
     8   !!---------------------------------------------------------------------- 
     9 
     10   !!---------------------------------------------------------------------- 
     11   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     12   !! $Id $  
     13   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     14   !!---------------------------------------------------------------------- 
     15 
    416CONTAINS 
    517 
    618   SUBROUTINE trc_lsm 
    719      !!---------------------------------------------------------------------- 
     20      !!                     ***  trc_lsm  ***   
    821      !! 
    9       !!                       trclsm.pisces.h 
    10       !!                       **************** 
     22      !! ** Purpose :   read PISCES namelist 
    1123      !! 
    12       !!  PURPOSE : 
    13       !!  --------- 
    14       !!     READs and PRINT options for PISCES namelist 
     24      !! ** input   :   file 'namelist.trc.sms' containing the following 
     25      !!             namelist: natext, natbio, natsms 
     26      !!                       natkriest ("key_trc_kriest") 
     27      !!---------------------------------------------------------------------- 
     28      CHARACTER (len=32) ::   clname 
    1529      !! 
    16       !!   MODIFICATIONS: 
    17       !!   -------------- 
    18       !!      original  : 99-10 (M.A. Foujols, M. Levy) passive tracer 
    19       !!      addition  : 00-01 (L. Bopp) hamocc3,p3zd 
    20       !!      
    21       !!---------------------------------------------------------------------- 
    22       !!---------------------------------------------------------------------- 
    23       !! local declarations 
    24       !! ================== 
    25       CHARACTER (len=32) clname 
    26  
    27       !!--------------------------------------------------------------------- 
    28       !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    29    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trclsm.pisces.h90,v 1.7 2007/10/17 14:50:13 opalod Exp $  
    30    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    31       !!--------------------------------------------------------------------- 
    32  
    33       ! 0. initializations 
    34       ! ------------------ 
    35       ! 
    3630      NAMELIST/natext/ atcco2 
    37       NAMELIST/natbio/caco3r, kdca, nca, part,                       & 
    38          &          dispo0,conc0,oxymin,grosip, nrdttrc,              & 
    39          &          pislope, excret,wsbio,wchl,wchld,resrat,mprat,mzrat,   & 
    40          &          grazrat,xprefc,xprefp,unass,xkgraz,xkmort,xksi1, & 
    41          &          xksi2,xremip,xremik,xsirem,xkdoc1,xkdoc2, & 
    42          &          excret2,resrat2,mprat2,mpratm,mzrat2,grazrat2,   & 
    43          &          xprefz,xprefpoc,unass2,xkgraz2,xlam1,      & 
    44          &          ferat3,conc1,conc2,conc3,concnnh4,concdnh4,      & 
    45          &          nitrif,epsher,epsher2,pislope2,wsbio2,sigma1,    & 
    46          &          sigma2, zprefc, zprefp, zprefd,fecnm,fecdm,      & 
    47          &          chlcnm,chlcdm, sedfeinput 
     31      NAMELIST/natbio/ caco3r, kdca, nca, part,                               & 
     32         &             dispo0,conc0,oxymin,grosip, nrdttrc,                   & 
     33         &             pislope, excret,wsbio,wchl,wchld,resrat,mprat,mzrat,   & 
     34         &             grazrat,xprefc,xprefp,unass,xkgraz,xkmort,xksi1,      & 
     35         &             xksi2,xremip,xremik,xsirem,xkdoc1,xkdoc2,              & 
     36         &             excret2,resrat2,mprat2,mpratm,mzrat2,grazrat2,         & 
     37         &             xprefz, xprefpoc, unass2, xkgraz2, xlam1,              & 
     38         &             ferat3,conc1,conc2,conc3,concnnh4,concdnh4,            & 
     39         &             nitrif,epsher,epsher2,pislope2,wsbio2,sigma1,          & 
     40         &             sigma2, zprefc, zprefp, zprefd,fecnm,fecdm,            & 
     41         &             chlcnm,chlcdm, sedfeinput 
    4842      NAMELIST/natsms/bdustfer, briver, bndepo, bsedinput 
    4943#if defined key_trc_kriest 
    50       NAMELIST/natkriest/xkr_eta,xkr_zeta,xkr_sfact,xkr_mass_min,xkr_mass_max,& 
    51          &               xkr_dnano,xkr_ddiat,xkr_dmeso,xkr_daggr,xkr_stick 
     44      NAMELIST/natkriest/ xkr_eta  , xkr_zeta , xkr_sfact, xkr_mass_min, xkr_mass_max,   & 
     45         &                xkr_dnano, xkr_ddiat, xkr_dmeso, xkr_daggr   , xkr_stick 
    5246#endif 
    53  
    54       ! initialize the number of LOGICAL UNIT used 
    55       ! ------------------------------------------ 
    56  
    57       IF(lwp) THEN 
    58          WRITE(numout,*) ' ' 
    59          WRITE(numout,*) ' ROUTINE trclec' 
    60          WRITE(numout,*) ' **************' 
    61          WRITE(numout,*) ' ' 
    62          WRITE(numout,*) ' namelist for PISCES model' 
    63          WRITE(numout,*) ' ***********************' 
    64          WRITE(numout,*) ' ' 
    65       ENDIF 
    66  
     47      !!---------------------------------------------------------------------- 
     48 
     49 
     50      IF(lwp) WRITE(numout,*) 
     51      IF(lwp) WRITE(numout,*) ' trc_lsm : read PISCES namelists' 
     52      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     53 
     54 
     55      !                               ! Open the namelist file 
     56      !                               ! ---------------------- 
    6757      clname ='namelist.trc.sms' 
    6858      CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    6959         &           1, numout, .FALSE., 1 ) 
    7060 
    71       ! 1 Namelist natext : 
    72       ! ------------------- 
    73       READ(numnat,natext) 
    74  
     61      !                               ! natext : Atmospheric parameters 
     62      !                               ! -------------------- ---------- 
     63      REWIND( numnat )                     ! read natext 
     64      READ  ( numnat, natext ) 
     65 
     66      IF(lwp) THEN                         ! control print 
     67         WRITE(numout,*) 
     68         WRITE(numout,*) ' Namelist : natext' 
     69         WRITE(numout,*) '    atmospheric pCO2                         atcco2 = ',atcco2 
     70      ENDIF 
     71 
     72 
     73      !                               ! natbio : biological parameters 
     74      !                               ! ------------------------------ 
     75      REWIND( numnat )                     ! read natbio 
     76      READ  ( numnat, natbio ) 
     77 
     78      IF(lwp) THEN                         ! control print 
     79         WRITE(numout,*) ' Namelist : natbio' 
     80         WRITE(numout,*) '    mean rainratio                            caco3r    =', caco3r 
     81         WRITE(numout,*) '    diss. rate constant calcite (per month)   kdca      =', kdca 
     82         WRITE(numout,*) '    order of reaction for calcite dissolution nca       =', nca 
     83         WRITE(numout,*) '    part of calcite not dissolved in guts     part      =', part 
     84         WRITE(numout,*) '    mean Si/C ratio                           grosip    =', grosip 
     85         WRITE(numout,*) '    Calcite dissolution half saturation       dispo0    =', dispo0 
     86         WRITE(numout,*) '    Phosphate half saturation                 conc0     =', conc0 
     87         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc 
     88         WRITE(numout,*) '    P-I slope                                 pislope   =', pislope 
     89         WRITE(numout,*) '    excretion ratio of phytoplankton          excret    =', excret 
     90         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio 
     91         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl 
     92         WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchld     =', wchld 
     93         WRITE(numout,*) '    exsudation rate of zooplankton            resrat    =', resrat 
     94         WRITE(numout,*) '    phytoplankton mortality rate              mprat     =', mprat 
     95         WRITE(numout,*) '    zooplankton mortality rate                mzrat     =', mzrat 
     96         WRITE(numout,*) '    zoo preference for phyto                  xprefc    =', xprefc 
     97         WRITE(numout,*) '    zoo preference for POC                    xprefp    =', xprefp 
     98         WRITE(numout,*) '    maximal zoo grazing rate                  grazrat   =', grazrat 
     99         WRITE(numout,*) '    non assimilated fraction of phyto by zoo  unass     =', unass 
     100         WRITE(numout,*) '    half sturation constant for grazing       xkgraz    =', xkgraz 
     101         WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort 
     102         WRITE(numout,*) '    half saturation constant for Si uptake    xksi1     =', xksi1 
     103         WRITE(numout,*) '    half saturation constant for Si/C         xksi2     =', xksi2 
     104         WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip 
     105         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik 
     106         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem  
     107         WRITE(numout,*) '    1st half-sat. of DOC remineralization     xkdoc1    =', xkdoc1 
     108         WRITE(numout,*) '    2nd half-sat. of DOC remineralization     xkdoc2    =', xkdoc2 
     109         WRITE(numout,*) '    excretion ratio of diatoms                excret2   =', excret2 
     110         WRITE(numout,*) '    exsudation rate of mesozooplankton        resrat2   =', resrat2 
     111         WRITE(numout,*) '    Diatoms mortality rate                    mprat2    =', mprat2 
     112         WRITE(numout,*) '    Phytoplankton minimum mortality rate      mpratm    =', mpratm 
     113         WRITE(numout,*) '    mesozooplankton mortality rate            mzrat2    =', mzrat2 
     114         WRITE(numout,*) '    zoo preference for zoo                    xprefz    =', xprefz 
     115         WRITE(numout,*) '    zoo preference for poc                    xprefpoc  =', xprefpoc 
     116         WRITE(numout,*) '    maximal mesozoo grazing rate              grazrat2  =', grazrat2 
     117         WRITE(numout,*) '    non assimilated fraction of P by mesozoo  unass2    =', unass2 
     118         WRITE(numout,*) '    Efficicency of Mesozoo growth             epsher2   =', epsher2  
     119         WRITE(numout,*) '    Efficiency of microzoo growth             epsher    =', epsher 
     120         WRITE(numout,*) '    half sturation constant for grazing 2     xkgraz2   =', xkgraz2 
     121         WRITE(numout,*) '    Maximum aggregation rate for diatoms      wchld     =', wchld 
     122         WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1 
     123         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3 
     124         WRITE(numout,*) '    Phosphate half saturation for diatoms     conc1     =', conc1 
     125         WRITE(numout,*) '    Iron half saturation for phyto            conc2     =', conc2 
     126         WRITE(numout,*) '    Iron half saturation for diatoms          conc3     =', conc3 
     127         WRITE(numout,*) '    NH4 half saturation for phyto             concnnh4  =', concnnh4 
     128         WRITE(numout,*) '    NH4 half saturation for diatoms           concdnh4  =', concdnh4 
     129         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif 
     130         WRITE(numout,*) '    P-I slope  for diatoms                    pislope2  =', pislope2 
     131         WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2 
     132         WRITE(numout,*) '    Fraction of microzoo excretion as DOM     sigma1    =', sigma1 
     133         WRITE(numout,*) '    Fraction of mesozoo excretion as DOM      sigma2    =', sigma2 
     134         WRITE(numout,*) '    Microzoo preference for POM               zprefc    =', zprefc 
     135         WRITE(numout,*) '    Microzoo preference for Nanophyto         zprefp    =', zprefp 
     136         WRITE(numout,*) '    Microzoo preference for Diatoms           zprefd    =', zprefd 
     137         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm    =', chlcnm 
     138         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm    =', chlcdm 
     139         WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm     =', fecnm 
     140         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm 
     141         WRITE(numout,*) '    Coastal release of Iron                   sedfeinput=', sedfeinput 
     142      ENDIF 
     143 
     144      !                               ! natsms : SMS parameters 
     145      !                               ! ----------------------- 
     146      REWIND( numnat )                     ! read natsms 
     147      READ  ( numnat, natsms ) 
    75148      IF(lwp) THEN 
    76149         WRITE(numout,*) ' ' 
    77          WRITE(numout,*) 'natext' 
    78          WRITE(numout,*) ' ' 
    79          WRITE(numout,*) 'atmospheric pCO2= ',atcco2 
    80          WRITE(numout,*) ' ' 
     150         WRITE(numout,*) ' Namelist : natsms' 
     151         WRITE(numout,*) '    Dust input from the atmosphere           bdustfer  = ', bdustfer 
     152         WRITE(numout,*) '    River input of nutrients                 briver    = ', briver 
     153         WRITE(numout,*) '    Atmospheric deposition of N              bndepo    = ', bndepo 
     154         WRITE(numout,*) '    Fe input from sediments                  bsedinput = ', bsedinput 
    81155      ENDIF 
    82156 
    83  
    84       READ(numnat,natbio) 
     157#if defined key_trc_kriest 
     158 
     159      !                               ! natkriest : kriest parameters 
     160      !                               ! ----------------------------- 
     161      REWIND( numnat )                     ! read natkriest 
     162      READ  ( numnat, natkriest ) 
     163 
    85164      IF(lwp) THEN 
    86          WRITE(numout,*) 'natbio' 
    87          WRITE(numout,*) ' ' 
    88          WRITE(numout,*)      & 
    89             &   ' mean rainratio                             =', caco3r 
    90          WRITE(numout,*)      & 
    91             &   ' diss. rate constant calcite (per month)    =', kdca 
    92          WRITE(numout,*)      & 
    93             &   ' order of reaction for calcite dissolution  =', nca 
    94          WRITE(numout,*)      & 
    95             &   ' part of calcite not dissolved in guts      =', part 
    96          WRITE(numout,*)      & 
    97             &   ' mean Si/C ratio                            =', grosip 
    98          WRITE(numout,*)      & 
    99             &   ' Calcite dissolution half saturation        =', dispo0 
    100          WRITE(numout,*)      & 
    101             &   ' Phosphate half saturation                  =', conc0 
    102          WRITE(numout,*)      & 
    103             &   ' frequence pour la biologie                 =', nrdttrc 
    104          WRITE(numout,*)      & 
    105             &   ' P-I slope                                  =', pislope 
    106          WRITE(numout,*)      & 
    107             &   ' excretion ratio of phytoplankton           =', excret 
    108          WRITE(numout,*)      & 
    109             &   ' POC sinking speed                          =', wsbio 
    110          WRITE(numout,*)      & 
    111             &   ' quadratic mortality of phytoplankton       =', wchl 
    112          WRITE(numout,*)      & 
    113             &   ' maximum quadratic mortality of diatoms     =', wchld 
    114          WRITE(numout,*)      & 
    115             &   ' exsudation rate of zooplankton             =', resrat 
    116          WRITE(numout,*)      & 
    117             &   ' phytoplankton mortality rate               =', mprat 
    118          WRITE(numout,*)      & 
    119             &   ' zooplankton mortality rate                 =', mzrat 
    120          WRITE(numout,*)      & 
    121             &   ' zoo preference for phyto                   =', xprefc 
    122          WRITE(numout,*)      & 
    123             &   ' zoo preference for POC                     =', xprefp 
    124          WRITE(numout,*)      & 
    125             &   ' maximal zoo grazing rate                   =', grazrat 
    126          WRITE(numout,*)      & 
    127             &   ' non assimilated fraction of phyto by zoo   =', unass 
    128          WRITE(numout,*)      & 
    129             &   ' half sturation constant for grazing        =', xkgraz 
    130          WRITE(numout,*)      & 
    131             &   ' half saturation constant for mortality     =', xkmort 
    132          WRITE(numout,*)      & 
    133             &   ' half saturation constant for Si uptake     =', xksi1 
    134          WRITE(numout,*)      & 
    135             &   ' half saturation constant for Si/C          =', xksi2 
    136          WRITE(numout,*)      & 
    137             &   ' remineralisation rate of POC               =', xremip 
    138          WRITE(numout,*)      & 
    139             &   ' remineralization rate of DOC               =', xremik 
    140          WRITE(numout,*)      &  
    141             &   ' remineralization rate of Si                =', xsirem  
    142          WRITE(numout,*)      & 
    143             &   ' 1st half-sat. of DOC remineralization      =', xkdoc1 
    144          WRITE(numout,*)      & 
    145             &   ' 2nd half-sat. of DOC remineralization      =', xkdoc2 
    146          WRITE(numout,*)      & 
    147             &   ' excretion ratio of diatoms                 =', excret2 
    148          WRITE(numout,*)      & 
    149             &   ' exsudation rate of mesozooplankton         =', resrat2 
    150          WRITE(numout,*)      & 
    151             &   ' Diatoms mortality rate                     =', mprat2 
    152          WRITE(numout,*)      & 
    153             &   ' Phytoplankton minimum mortality rate       =', mpratm 
    154          WRITE(numout,*)      & 
    155             &   ' mesozooplankton mortality rate             =', mzrat2 
    156          WRITE(numout,*)      & 
    157             &   ' zoo preference for zoo                     =', xprefz 
    158          WRITE(numout,*)      & 
    159             &   ' zoo preference for poc                   =', xprefpoc 
    160          WRITE(numout,*)      & 
    161             &   ' maximal mesozoo grazing rate               =', grazrat2 
    162          WRITE(numout,*)      & 
    163             &   ' non assimilated fraction of P by mesozoo   =', unass2 
    164          WRITE(numout,*)      & 
    165             &   ' Efficicency of Mesozoo growth              =', epsher2  
    166          WRITE(numout,*)      & 
    167             &   ' Efficiency of microzoo growth              =', epsher 
    168          WRITE(numout,*)      & 
    169             &   ' half sturation constant for grazing 2      =', xkgraz2 
    170          WRITE(numout,*)      & 
    171             &   ' Maximum aggregation rate for diatoms       =', wchld 
    172          WRITE(numout,*)      & 
    173             &   ' scavenging rate of Iron                    =', xlam1 
    174          WRITE(numout,*)      & 
    175             &   ' Fe/C in zooplankton                        =', ferat3 
    176          WRITE(numout,*)      & 
    177             &   ' Phosphate half saturation for diatoms      =', conc1 
    178          WRITE(numout,*)      & 
    179             &   ' Iron half saturation for phyto             =', conc2 
    180          WRITE(numout,*)      & 
    181             &   ' Iron half saturation for diatoms           =', conc3 
    182          WRITE(numout,*)      & 
    183             &   ' NH4 half saturation for phyto              =', concnnh4 
    184          WRITE(numout,*)      & 
    185             &   ' NH4 half saturation for diatoms            =', concdnh4 
    186          WRITE(numout,*)      & 
    187             &   ' NH4 nitrification rate                     =', nitrif 
    188          WRITE(numout,*)      & 
    189             &   ' P-I slope  for diatoms                     =', pislope2 
    190          WRITE(numout,*)      & 
    191             &   ' Big particles sinking speed                =', wsbio2 
    192          WRITE(numout,*)      & 
    193             &   ' Fraction of microzoo excretion as DOM      =', sigma1 
    194          WRITE(numout,*)      & 
    195             &   ' Fraction of mesozoo excretion as DOM       =', sigma2 
    196          WRITE(numout,*)      & 
    197             &   ' Microzoo preference for POM                =', zprefc 
    198          WRITE(numout,*)      & 
    199             &   ' Microzoo preference for Nanophyto          =', zprefp 
    200          WRITE(numout,*)      & 
    201             &   ' Microzoo preference for Diatoms          =', zprefd 
    202          WRITE(numout,*)      & 
    203             &   ' Minimum Chl/C in nanophytoplankton         =', chlcnm 
    204          WRITE(numout,*)      & 
    205             &   ' Minimum Chl/C in diatoms                   =', chlcdm 
    206          WRITE(numout,*)      & 
    207             &   ' Maximum Fe/C in nanophytoplankton          =', fecnm 
    208          WRITE(numout,*)      & 
    209             &   ' Minimum Fe/C in diatoms                    =', fecdm 
    210          WRITE(numout,*)      & 
    211             &   ' Coastal release of Iron                 =', sedfeinput 
    212       ENDIF 
    213  
    214       READ(numnat,natsms) 
    215       IF(lwp) THEN 
    216          WRITE(numout,*) ' ' 
    217          WRITE(numout,*) 'natsms' 
    218          WRITE(numout,*) ' ' 
    219          WRITE(numout,*) 'Dust input from the atmosphere : ', bdustfer 
    220          WRITE(numout,*) ' ' 
    221          WRITE(numout,*) 'River input of nutrients : ', briver 
    222          WRITE(numout,*) ' ' 
    223          WRITE(numout,*) 'Atmospheric deposition of N : ', bndepo 
    224          WRITE(numout,*) ' ' 
    225          WRITE(numout,*) 'Fe input from sediments : ', bsedinput 
    226          WRITE(numout,*) ' ' 
    227       ENDIF 
    228  
    229 #if defined key_trc_kriest 
    230  
    231       READ(numnat,natkriest) 
    232       IF(lwp) THEN 
    233          WRITE(numout,*) ' ' 
    234          WRITE(numout,*) 'natkriest' 
    235          WRITE(numout,*) ' ' 
    236          WRITE(numout,*) 'Sinking  exponent                    xkr_eta       = ', xkr_eta  
    237          WRITE(numout,*) 'N content exponent                   xkr_zeta      = ', xkr_zeta 
    238          WRITE(numout,*) 'Sinking factor                       xkr_sfact     = ', xkr_sfact 
    239          WRITE(numout,*) 'Stickiness                           xkr_stick     = ', xkr_stick 
    240          WRITE(numout,*) 'Minimum mass for Aggregates          xkr_mass_min  = ', xkr_mass_min 
    241          WRITE(numout,*) 'Maximum mass for Aggregates          xkr_mass_max  = ', xkr_mass_max 
    242          WRITE(numout,*) 'Size of particles in nano pool       xkr_dnano     = ', xkr_dnano 
    243          WRITE(numout,*) 'Size of particles in diatoms pool    xkr_ddiat     = ', xkr_ddiat 
    244          WRITE(numout,*) 'Size of particles in mesozoo pool    xkr_dmeso     = ', xkr_dmeso 
    245          WRITE(numout,*) 'Size of particles in aggregates pool xkr_daggr     = ', xkr_daggr 
     165         WRITE(numout,*) 
     166         WRITE(numout,*) ' Namelist : natkriest' 
     167         WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta  
     168         WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta 
     169         WRITE(numout,*) '    Sinking factor                           xkr_sfact    = ', xkr_sfact 
     170         WRITE(numout,*) '    Stickiness                               xkr_stick    = ', xkr_stick 
     171         WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min 
     172         WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max 
     173         WRITE(numout,*) '    Size of particles in nano pool           xkr_dnano    = ', xkr_dnano 
     174         WRITE(numout,*) '    Size of particles in diatoms pool        xkr_ddiat    = ', xkr_ddiat 
     175         WRITE(numout,*) '    Size of particles in mesozoo pool        xkr_dmeso    = ', xkr_dmeso 
     176         WRITE(numout,*) '    Size of particles in aggregates pool     xkr_daggr    = ', xkr_daggr 
    246177     ENDIF 
    247178 
    248179 
    249180     ! Computation of some variables 
    250      xkr_massp     = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta 
     181     xkr_massp = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta 
     182      
    251183     ! max and min vertical particle speed 
    252184     xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 
    253185     xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 
    254      WRITE(numout,*) ' max and min vertical particle speed ',xkr_wsbio_min,xkr_wsbio_max 
     186     WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 
     187      
    255188     ! 
    256189     !    effect of the sizes of the different living pools on particle numbers 
    … …  
    267200     xkr_naggr = 1. / ( xkr_massp * xkr_daggr ) 
    268201     
    269  
    270202#endif 
    271  
     203      ! 
    272204   END SUBROUTINE trc_lsm 

  • branches/dev_001_GM/NEMO/TOP_SRC/SMS/trp_trc.F90

    r719 r763  
    11MODULE trp_trc 
     2   !!====================================================================== 
     3   !!                         ***  MODULE trp_trc  *** 
     4   !! TOP :   TOP parameters used in TRP 
     5   !!====================================================================== 
     6   !! History :   1.0  !  2004-03 (C. Ethe) original code 
     7   !!---------------------------------------------------------------------- 
     8   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     9   !! $Id:$  
     10   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     11   !!---------------------------------------------------------------------- 
     12#if defined key_passivetrc 
     13   !!---------------------------------------------------------------------- 
     14   !!   'key_passivetrc'                                    Passive tracers 
     15   !!---------------------------------------------------------------------- 
    216 
    3 #if defined key_passivetrc 
    4    !!====================================================================== 
    5    !! Module trp_trc 
    6    !!====================================================================== 
    7    !!  TOP 1.0,  LOCEAN-IPSL (2005) 
    8    !! $Header$ 
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     17   !! passive tracers number 
     18   USE par_trc_trp , ONLY :   jptra    =>   jptra    !: number of passive tracers 
     19 
     20   !! passive tracers fields  
     21   USE trc         , ONLY :   trai     =>   trai     !: initial total tracer 
     22   USE trc         , ONLY :   trb      =>   trb      !: tracer field (before) 
     23   USE trc         , ONLY :   tra      =>   tra      !: tracer field (now) 
     24   USE trc         , ONLY :   trn      =>   trn      !: tracer field (after) 
     25 
     26   !! time step 
     27   USE trc         , ONLY :   ndttrc   =>   ndttrc   !: frequency of step on passive tracers (NAMELIST) 
     28 
     29   !! non-centered advection scheme (smolarkiewicz) 
     30   USE trc         , ONLY :   rtrn     =>   rtrn     !: value for truncation (NAMELIST) 
     31   USE trc         , ONLY :   ctrcnm   =>   ctrcnm   !: value for truncation (NAMELIST) 
     32 
     33# if defined key_trc_diaadd 
     34   USE par_trc_trp , ONLY :   jpdia2d  =>  jpdia2d   !: number of 2D passive tracers diag 
     35   USE par_trc_trp , ONLY :   jpdia3d  =>  jpdia3d   !: number of 3D passive tracers diag 
     36   USE trc         , ONLY :   trc2d    =>   trc2d    !: additional 2D variable for ouputs 
     37   USE trc         , ONLY :   trc3d    =>   trc3d    !: additional 3D variable for ouputs 
     38# endif 
     39 
     40#else 
    1041   !!---------------------------------------------------------------------- 
    11    !! passive tracers number 
    12    USE par_trc_trp , ONLY : & 
    13       jptra    =>   jptra       !!: number of passive tracers 
    14  
    15 #if defined key_trc_diaadd 
    16    USE par_trc_trp , ONLY : & 
    17       jpdia2d  =>  jpdia2d , &  !!: number of passive tracers 
    18       jpdia3d  =>  jpdia3d 
     42   !!  Empty module :                                     No passive tracer 
     43   !!---------------------------------------------------------------------- 
    1944#endif 
    2045 
    21    !! passive tracers fields  
    22    USE trc , ONLY :  & 
    23       trai   =>   trai , &  !!: initial total tracer 
    24       trb    =>   trb  , &  !!: tracer field (before) 
    25       tra    =>   tra  , &  !!: tracer field (now) 
    26       trn    =>   trn       !!: tracer field (after) 
    27  
    28 #if defined key_trc_diaadd 
    29    USE trc , ONLY :  & 
    30       trc2d   =>   trc2d , &  !!: additional 2D variable for ouputs 
    31       trc3d   =>   trc3d      !!: additional 3D variable for ouputs 
    32 #endif 
    33    !! time step 
    34    USE trc , ONLY :  & 
    35       ndttrc =>   ndttrc    !!: frequency of step on passive tracers (NAMELIST) 
    36  
    37    !! non-centered advection scheme (smolarkiewicz) 
    38    USE trc , ONLY : & 
    39       rtrn   =>   rtrn      !!: value for truncation (NAMELIST) 
    40  
    41    USE trc , ONLY : & 
    42       ctrcnm   =>   ctrcnm      !!: value for truncation (NAMELIST) 
    43 #else 
    4446   !!====================================================================== 
    45    !!  Empty module : No passive tracer  
    46    !!====================================================================== 
    47 #endif 
    48  
    4947END MODULE trp_trc 

  • branches/dev_001_GM/NEMO/TOP_SRC/agrif_top_interp.F90

    r719 r763  
    11MODULE agrif_top_interp 
    22   !!====================================================================== 
    3    !!                       ***  MODULE agrif_top_interp  *** 
    4    !!  Dummy module 
     3   !!                   ***  MODULE agrif_top_interp  *** 
     4   !! TOP :   Dummy module when AGRIF is not used 
    55   !!====================================================================== 
    66 
    77   !!---------------------------------------------------------------------- 
    8    !!   Dummy module                                     NO agrif use 
     8   !!   Dummy module                                               NO AGRIF 
    99   !!---------------------------------------------------------------------- 
     10   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     11   !! $Header$  
     12   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    1013   !!---------------------------------------------------------------------- 
    11    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    12    !! $Header$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    14    !!---------------------------------------------------------------------- 
     14 
     15   !!====================================================================== 
    1516END MODULE agrif_top_interp 

  • branches/dev_001_GM/NEMO/TOP_SRC/agrif_top_update.F90

    r719 r763  
    11MODULE agrif_top_update 
    22   !!====================================================================== 
    3    !!                       ***  MODULE agrif_top_update  *** 
    4    !!  Dummy module 
     3   !!                   ***  MODULE agrif_top_update  *** 
     4   !! TOP :   Dummy module when AGRIF is not used 
    55   !!====================================================================== 
    66 
    77   !!---------------------------------------------------------------------- 
    8    !!   Dummy module                                     NO agrif use 
     8   !!   Dummy module                                               NO AGRIF 
    99   !!---------------------------------------------------------------------- 
     10   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     11   !! $Header$  
     12   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    1013   !!---------------------------------------------------------------------- 
    11    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    12    !! $Header$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    14    !!---------------------------------------------------------------------- 
     14 
     15   !!====================================================================== 
    1516END MODULE agrif_top_update 

  • branches/dev_001_GM/NEMO/TOP_SRC/initrc.F90

    r719 r763  
    11MODULE initrc 
    2    !!================================================ 
    3    !! 
    4    !!                       *** MODULE initrc *** 
    5    !! Initialisation the tracer model 
    6    !!================================================ 
    7                                                                                                                              
     2   !!====================================================================== 
     3   !!                         ***  MODULE initrc  *** 
     4   !! TOP :   Initialisation of passive tracers 
     5   !!====================================================================== 
     6   !! History :    -   !  1991-03  ()  original code 
     7   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     8   !!              -   !  2005-10 (C. Ethe) print control 
     9   !!---------------------------------------------------------------------- 
    810#if defined key_passivetrc 
    9  
    10    !!------------------------------------------------------- 
    11    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    12    !! $Header$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    14    !!------------------------------------------------------- 
    15  
    16    !!-------------------------------------------------------------- 
    17    !! * Modules used 
    18    !! ============== 
     11   !!---------------------------------------------------------------------- 
     12   !!   'key_passivetrc'                                    Passive tracers 
     13   !!---------------------------------------------------------------------- 
     14   !!   ini_trc    :  initialisation of passive tracers 
     15   !!---------------------------------------------------------------------- 
    1916   USE oce_trc 
    2017   USE trc 
    … …  
    2926   PRIVATE 
    3027    
    31     
    32    !! * Accessibility 
    33    PUBLIC ini_trc 
     28   PUBLIC   ini_trc   ! called by ??? 
    3429 
    3530    !! * Substitutions 
    3631#  include "domzgr_substitute.h90" 
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     34   !! $Id:$  
     35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
    3737   
    3838CONTAINS 
    … …  
    4040   SUBROUTINE ini_trc 
    4141      !!--------------------------------------------------------------------- 
     42      !!                     ***  ROUTINE ini_trc  *** 
    4243      !! 
    43       !!                       ROUTINE ini_trc 
    44       !!                     ****************** 
     44      !! ** Purpose :   Initialization of the passive tracer fields  
    4545      !! 
    46       !!  PURPOSE : 
    47       !!  --------- 
    48       !!     initialize the tracer model 
    49       !! 
    50       !!   METHOD : 
    51       !!   ------- 
    52       !! 
    53       !! 
    54       !!   History: 
    55       !!   ------- 
    56       !!      original  : 91-03 () 
    57       !!      additions : 92-01 (C. Levy) 
    58       !!                  05-03 (O. Aumont and A. El Moussaoui) F90 
    59       !!                  05-10 (C. Ethe ) print control initialization  
    60       !!---------------------------------------------------------------------- 
     46      !! ** Method  : - read namelist 
     47      !!              - control the consistancy  
     48      !!              - compute specific initialisations 
     49      !!              - set initial tracer fields (either read restart  
     50      !!                or read data or analytical formulation 
     51      !!--------------------------------------------------------------------- 
     52      INTEGER ::   ji, jj, jk, jn    ! dummy loop indices 
     53      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zbt   ! workspace: masked grid volume 
     54      !!--------------------------------------------------------------------- 
    6155 
    62       !!--------------------------------------------------------------------- 
    63       !!  OPA.9, 03-2005 
    64       !!--------------------------------------------------------------------- 
    65       INTEGER :: ji, jj, jk, jn    !: dummy loop indices 
     56      IF(lwp) WRITE(numout,*) 
     57      IF(lwp) WRITE(numout,*) 'ini_trc : initial set up of the passive tracers' 
     58      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    6659 
    67       !! 0.b PRINT the number of tracer 
    68       !! ------------------------------ 
     60      !                 ! masked grid volume 
     61      DO jk = 1, jpk 
     62         zbt(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
     63      END DO 
     64#if defined key_off_degrad 
     65      zbt(:,:,:) = zbt(:,:,:) * facvol(ji,jj,jk)      ! degrad option: reduction by facvol 
     66#endif 
    6967 
    70       IF(lwp) WRITE(numout,*) ' ' 
    71       IF(lwp) WRITE(numout,*) ' *** number of passive tracer jptra = ',jptra 
    72       IF(lwp) WRITE(numout,*) ' ' 
     68      !                 ! total volume of the ocean 
     69      areatot = SUM( zbt(:,:,:) ) 
     70      IF( lk_mpp )   CALL mpp_sum( areatot )     ! sum over the global domain   
    7371 
    74       ! 1. READ passive tracers namelists 
    75       ! --------------------------------- 
     72      CALL trc_lec      ! READ passive tracers namelists 
    7673 
    77       CALL trc_lec 
     74      CALL trc_ctl      ! control consistency between parameters, cpp key and namelists 
    7875 
    79       ! 2. control consistency between parameters, cpp key and namelists 
    80       ! ---------------------------------------------------------------- 
     76      CALL trc_ini      ! computes some initializations 
    8177 
    82       CALL trc_ctl 
    83  
    84       ! 3. computes some initializations 
    85       ! -------------------------------- 
    86  
    87       CALL trc_ini 
    88  
    89   
    90       ! 4. total volume of the ocean 
    91       !----------------------------- 
    92  
    93       areatot = 0. 
    94       DO jk = 1, jpk 
    95          DO jj = 1, jpj 
    96             DO ji = 1, jpi 
    97                areatot = areatot + tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
    98 #if defined key_off_degrad 
    99                   &                * facvol(ji,jj,jk)    & 
    100 #endif 
    101                   &                * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)  
    102             END DO 
    103          END DO 
    104       END DO 
    105       IF( lk_mpp ) THEN  
    106          CALL mpp_sum(areatot)     ! sum over the global domain   
    107       END IF 
    108  
    109       IF(lwp) WRITE(numout,*) ' ' 
    110       IF (lwp) WRITE(numout,*) 'Total volume of ocean =',areatot 
    111       IF(lwp) WRITE(numout,*) ' ' 
    112  
    113       ! 5. Initialization of tracers 
    114       ! ----------------------------- 
    115  
    116       IF( lrsttr ) THEN 
    117  
    118          ! 5.1 restart from a file 
    119          !------------------------ 
    120          CALL trc_rst_read 
    121  
    122       ELSE 
    123  
    124          !  5.2 analytical formulation or global data 
    125          !------------------------------------- 
    126          CALL trc_dtr 
    127  
     78      !                 ! set initial tracer values  
     79      IF( lrsttr ) THEN   ;   CALL trc_rst_read      ! restart from a file 
     80      ELSE                ;   CALL trc_dtr           ! analytical formulation or from data 
    12881      ENDIF 
    12982 
     83      !                 ! Computation content of all tracers 
     84      trai = 0.e0 
     85      DO jn = 1, jptra 
     86         trai = trai + SUM( trn(:,:,:,jn) * zbt(:,:,:) ) 
     87      END DO       
     88      IF( lk_mpp )   CALL mpp_sum( trai )     ! sum over the global domain   
    13089 
    131       ! 6. Computation integral of all tracers 
    132       !------------------ 
    13390 
    134       trai = 0. 
    135       DO jn = 1, jptra 
    136          DO jk = 1, jpk 
    137             DO jj = 1, jpj 
    138                DO ji = 1, jpi 
    139                   trai = trai + trn(ji,jj,jk,jn) * tmask(ji,jj,jk) * tmask_i(ji,jj)    & 
    140 #if defined key_off_degrad 
    141                      &              * facvol(ji,jj,jk)   & 
    142 #endif 
     91      !                 ! control print 
     92      IF(lwp) WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
     93      IF(lwp) WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
     94      IF(lwp) WRITE(numout,*) '          *** Total inital content of all tracers  = ', trai 
     95      IF(lwp) WRITE(numout,*) 
    14396 
    144                      &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    145                END DO 
    146             END DO 
    147          END DO 
    148       ENDDO 
    149        
    150       IF( lk_mpp ) THEN  
    151          CALL mpp_sum(trai)         ! sum over the global domain   
    152       END IF 
    153  
    154       IF(lwp) WRITE(numout,*) ' '      
    155       IF(lwp) WRITE(numout,*) 'Integral of all tracers over the full domain at initial time =',trai 
    156       IF(lwp) WRITE(numout,*) ' ' 
    157  
    158       ! 6. Print control 
    159       !------------------ 
    160  
    161       IF( ln_ctl )    CALL prt_ctl_trc_init 
    162  
     97      IF( ln_ctl )   CALL prt_ctl_trc_init      ! control print 
     98      ! 
    16399   END SUBROUTINE ini_trc 
    164100 
    165  
    166101#else 
    167    !!====================================================================== 
    168    !!  Empty module : No passive tracer 
    169    !!====================================================================== 
     102   !!---------------------------------------------------------------------- 
     103   !!  Empty module :                                     No passive tracer 
     104   !!---------------------------------------------------------------------- 
    170105CONTAINS 
    171    SUBROUTINE ini_trc       
     106   SUBROUTINE ini_trc                      ! Dummy routine    
    172107   END SUBROUTINE ini_trc 
    173108#endif 
    174109 
     110   !!====================================================================== 
    175111END MODULE initrc  

  • branches/dev_001_GM/NEMO/TOP_SRC/oce_trc.F90

    r719 r763  
    22   !!====================================================================== 
    33   !!                      ***  MODULE  oce_trc  *** 
    4    !! Ocean passive tracer  :  share ocean-passive tracers variables 
     4   !! TOP :   variables shared between ocean and passive tracers 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   9.0  !  04-03  (C. Ethe)  F90: Free form and module 
    8    !!---------------------------------------------------------------------- 
    9    !!  TOP 1.0,  LOCEAN-IPSL (2005) 
    10    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/oce_trc.F90,v 1.17 2007/05/28 02:55:05 opalod Exp $ 
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    12    !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    14    !! Domain characteristics 
    15    USE par_oce , ONLY :       & 
    16       cp_cfg   =>   cp_cfg,  & !: name of the configuration 
    17       jp_cfg   =>   jp_cfg,  & !: resolution of the configuration 
    18       jpiglo   =>   jpiglo,  & !: first  dimension of global domain --> i 
    19       jpjglo   =>   jpjglo,  & !: second dimension of global domain --> j 
    20       jpi      =>   jpi   ,  & !: first  dimension of grid --> i  
    21       jpj      =>   jpj   ,  & !: second dimension of grid --> j   
    22       jpk      =>   jpk   ,  & !: number of levels   
    23       jpim1    =>   jpim1 ,  & !: jpi - 1 
    24       jpjm1    =>   jpjm1 ,  & !: jpj - 1  
    25       jpkm1    =>   jpkm1 ,  & !: jpk - 1   
    26       jpij     =>   jpij  ,  & !: jpi x jpj 
    27       jpidta   =>   jpidta,  & !: first horizontal dimension  > or = jpi 
    28       jpjdta   =>   jpjdta,  & !: second horizontal dimension > or = jpj 
    29       jpkdta   =>   jpkdta,  & !: number of levels            > or = jpk 
    30       lk_esopa =>   lk_esopa   !: flag to activate the all option 
    31  
    32  
    33    !! run controm    
    34  
    35    USE in_out_manager 
    36        
    37    USE dom_oce , ONLY :           &             
    38       lzoom      => lzoom     ,  & !: zoom flag 
    39       lzoom_e    => lzoom_e   ,  & !: East  zoom type flag 
    40       lzoom_w    => lzoom_w   ,  & !: West  zoom type flag 
    41       lzoom_s    => lzoom_s   ,  & !: South zoom type flag 
    42       lzoom_n    => lzoom_n   ,  & !: North zoom type flag 
    43       lzoom_arct => lzoom_arct,  & !: ORCA    arctic zoom flag 
    44       lzoom_anta => lzoom_anta     !: ORCA antarctic zoom flag 
    45  
    46  
    47  
    48    USE dom_oce , ONLY :       &  
    49       nperio   =>   nperio,  & !: type of lateral boundary condition        
    50       nimpp    =>   nimpp ,  & !: i index for mpp-subdomain left bottom 
    51       njmpp    =>   njmpp ,  & !: j index for mpp-subdomain left bottom 
    52       nproc    =>   nproc ,  & !: number for local processor 
    53       narea    =>   narea ,  & !: number for local area 
    54       mig      =>   mig   ,  & !: local  ==> global  domain i-indice 
    55       mjg      =>   mjg   ,  & !: local  ==> global  domain i-indice 
    56       mi0      =>   mi0   ,  & !: global ==> local domain i-indice  
    57       mi1      =>   mi1   ,  & !: (mi0=1 and mi1=0 if the global indice is not in the local domain) 
    58       mj0      =>   mj0   ,  & !: global ==> local domain j-indice  
    59       mj1      =>   mj1   ,  & !: (mj0=1 and mj1=0 if the global indice is not in the local domain) 
    60       nidom    =>   nidom 
     6   !! History :   1.0  !  2004-03  (C. Ethe)  original code 
     7   !!             2.0  !  2007-12 (C. Ethe, G. Madec)  rewritting 
     8   !!---------------------------------------------------------------------- 
     9   !! NEMO/TOP 2.0,  LOCEAN-IPSL (2007) 
     10   !! $Header: $ 
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     12   !!---------------------------------------------------------------------- 
     13#if defined key_passivetrc 
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_passivetrc'                                    Passive tracers 
     16   !!---------------------------------------------------------------------- 
     17 
     18   !* Domain size * 
     19   USE par_oce , ONLY :   cp_cfg   =>   cp_cfg     !: name of the configuration 
     20   USE par_oce , ONLY :   jp_cfg   =>   jp_cfg     !: resolution of the configuration 
     21   USE par_oce , ONLY :   jpiglo   =>   jpiglo     !: first  dimension of global domain --> i 
     22   USE par_oce , ONLY :   jpjglo   =>   jpjglo     !: second dimension of global domain --> j 
     23   USE par_oce , ONLY :   jpi      =>   jpi        !: first  dimension of grid --> i  
     24   USE par_oce , ONLY :   jpj      =>   jpj        !: second dimension of grid --> j   
     25   USE par_oce , ONLY :   jpk      =>   jpk        !: number of levels   
     26   USE par_oce , ONLY :   jpim1    =>   jpim1      !: jpi - 1 
     27   USE par_oce , ONLY :   jpjm1    =>   jpjm1      !: jpj - 1  
     28   USE par_oce , ONLY :   jpkm1    =>   jpkm1      !: jpk - 1   
     29   USE par_oce , ONLY :   jpij     =>   jpij       !: jpi x jpj 
     30   USE par_oce , ONLY :   jpidta   =>   jpidta     !: first horizontal dimension  > or = jpi 
     31   USE par_oce , ONLY :   jpjdta   =>   jpjdta     !: second horizontal dimension > or = jpj 
     32   USE par_oce , ONLY :   jpkdta   =>   jpkdta     !: number of levels            > or = jpk 
     33   USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option 
     34 
     35   !* IO manager * 
     36   USE in_out_manager      ! use all the variables 
     37   !* physical constants * 
     38   USE phycst              ! use all the variables 
     39 
     40   !* model domain * 
     41   USE dom_oce , ONLY :   lzoom      => lzoom        !: zoom flag 
     42   USE dom_oce , ONLY :   lzoom_e    => lzoom_e      !: East  zoom type flag 
     43   USE dom_oce , ONLY :   lzoom_w    => lzoom_w      !: West  zoom type flag 
     44   USE dom_oce , ONLY :   lzoom_s    => lzoom_s      !: South zoom type flag 
     45   USE dom_oce , ONLY :   lzoom_n    => lzoom_n      !: North zoom type flag 
     46   USE dom_oce , ONLY :   lzoom_arct => lzoom_arct   !: ORCA    arctic zoom flag 
     47   USE dom_oce , ONLY :   lzoom_anta => lzoom_anta   !: ORCA antarctic zoom flag 
     48   USE dom_oce , ONLY :   nperio     =>   nperio     !: type of lateral boundary condition        
     49   USE dom_oce , ONLY :   nimpp      =>   nimpp      !: i index for mpp-subdomain left bottom 
     50   USE dom_oce , ONLY :   njmpp      =>   njmpp      !: j index for mpp-subdomain left bottom 
     51   USE dom_oce , ONLY :   nproc      =>   nproc      !: number for local processor 
     52   USE dom_oce , ONLY :   narea      =>   narea      !: number for local area 
     53   USE dom_oce , ONLY :   mig        =>   mig        !: local  ==> global  domain i-indice 
     54   USE dom_oce , ONLY :   mjg        =>   mjg        !: local  ==> global  domain i-indice 
     55   USE dom_oce , ONLY :   mi0        =>   mi0        !: global ==> local domain i-indice  
     56   USE dom_oce , ONLY :   mi1        =>   mi1        !: (mi0=1 and mi1=0 if the global indice is not in the local one) 
     57   USE dom_oce , ONLY :   mj0        =>   mj0        !: global ==> local domain j-indice  
     58   USE dom_oce , ONLY :   mj1        =>   mj1        !: (mj0=1 and mj1=0 if the global indice is not in the local one) 
     59   USE dom_oce , ONLY :   nidom      =>   nidom 
     60   USE dom_oce , ONLY :   nimppt     => nimppt     !:i-indexes for each processor 
     61   USE dom_oce , ONLY :   njmppt     => njmppt       !:j-indexes for each processor 
     62   USE dom_oce , ONLY :   ibonit     => ibonit       !:i-processor neighbour existence 
     63   USE dom_oce , ONLY :   ibonjt     => ibonjt       !:j- processor neighbour existence  
     64   USE dom_oce , ONLY :   nlci       => nlci         !:i- & j-dimensions of the local subdomain 
     65   USE dom_oce , ONLY :   nlcj       => nlcj         !: 
     66   USE dom_oce , ONLY :   nldi       => nldi         !:first and last indoor i- and j-indexes 
     67   USE dom_oce , ONLY :   nlei       => nlei         !: 
     68   USE dom_oce , ONLY :   nldj       => nldj         !: 
     69   USE dom_oce , ONLY :   nlej       => nlej         !: 
     70   USE dom_oce , ONLY :   nlcit      => nlcit        !:dimensions of every i-subdomain 
     71   USE dom_oce , ONLY :   nlcjt      => nlcjt        !:dimensions of every j-subdomain 
     72   USE dom_oce , ONLY :   nldit      => nldit        !:first indoor index for each i-domain  
     73   USE dom_oce , ONLY :   nleit      => nleit        !:last indoor index for each i-domain  
     74   USE dom_oce , ONLY :   nldjt      => nldjt        !:first indoor index for each j-domain  
     75   USE dom_oce , ONLY :   nlejt      => nlejt        !:last indoor index for each j-domain  
    6176  
    62    USE dom_oce , ONLY :       &  
    63       nimppt   => nimppt  ,  & !:i-indexes for each processor 
    64       njmppt   => njmppt  ,  & !:j-indexes for each processor 
    65       ibonit   => ibonit  ,  & !:i-processor neighbour existence 
    66       ibonjt   => ibonjt  ,  & !:j- processor neighbour existence  
    67       nlci     => nlci    ,  & !:i- & j-dimensions of the local subdomain 
    68       nlcj     => nlcj    ,  & !: 
    69       nldi     => nldi    ,  & !:first and last indoor i- and j-indexes 
    70       nlei     => nlei    ,  & !: 
    71       nldj     => nldj    ,  & !: 
    72       nlej     => nlej    ,  & !: 
    73       nlcit    => nlcit   ,  & !:dimensions of every i-subdomain 
    74       nlcjt    => nlcjt   ,  & !:dimensions of every j-subdomain 
    75       nldit    => nldit   ,  & !:first indoor index for each i-domain  
    76       nleit    => nleit   ,  & !:last indoor index for each i-domain  
    77       nldjt    => nldjt   ,  & !:first indoor index for each j-domain  
    78       nlejt    => nlejt        !:last indoor index for each j-domain  
    79  
    80      
    81       !! horizontal curvilinear coordinate and scale factors 
    82    USE dom_oce , ONLY :            &     
    83       glamt    =>   glamt ,  & !: longitude of t-point (degre)   
    84       glamu    =>   glamu ,  & !: longitude of t-point (degre)   
    85       glamv    =>   glamv ,  & !: longitude of t-point (degre)   
    86       glamf    =>   glamf ,  & !: longitude of t-point (degre)   
    87       gphit    =>   gphit ,  & !: latitude  of t-point (degre)    
    88       gphiu    =>   gphiu ,  & !: latitude  of t-point (degre)    
    89       gphiv    =>   gphiv ,  & !: latitude  of t-point (degre)    
    90       gphif    =>   gphif ,  & !: latitude  of t-point (degre)    
    91       e1t      =>   e1t   ,  & !: horizontal scale factors at t-point (m)   
    92       e2t      =>   e2t   ,  & !: horizontal scale factors at t-point (m)    
    93       e1u      =>   e1u   ,  & !: horizontal scale factors at u-point (m) 
    94       e2u      =>   e2u   ,  & !: horizontal scale factors at u-point (m) 
    95       e1v      =>   e1v   ,  & !: horizontal scale factors at v-point (m) 
    96       e2v      =>   e2v        !: horizontal scale factors at v-point (m)   
    97  
    98    !! vertical coordinate and scale factors 
    99    USE dom_oce , ONLY :              &    
    100       gdept_0    =>   gdept_0 ,  & !: reference depth of t-points (m) 
    101       e3t_0      =>   e3t_0   ,  & !: reference depth of t-points (m)   
    102       e3w_0      =>   e3w_0   ,  & !: reference depth of w-points (m) 
    103       gdepw_0    =>   gdepw_0      !: reference depth of w-points (m) 
    104  
    105 #if ! defined key_zco 
    106    USE dom_oce , ONLY :                & 
    107       gdep3w   =>  gdep3w  ,  & !: ??? 
    108       gdept =>  gdept,  & !: depth of t-points (m) 
    109       gdepw =>  gdepw,  & !: depth of t-points (m) 
    110       e3t   =>  e3t  ,  & !: vertical scale factors at t- 
    111       e3u   =>  e3u  ,  & !: vertical scale factors at u- 
    112       e3v   =>  e3v  ,  & !: vertical scale factors v- 
    113       e3w   =>  e3w  ,  & !: w-points (m) 
    114       e3f   =>  e3f  ,  & !: f-points (m) 
    115       e3uw  =>  e3uw ,  & !: uw-points (m) 
    116       e3vw  =>  e3vw      !: vw-points (m) 
     77   !* horizontal mesh * 
     78   USE dom_oce , ONLY :   glamt      =>   glamt      !: longitude of t-point (degre)   
     79   USE dom_oce , ONLY :   glamu      =>   glamu      !: longitude of t-point (degre)   
     80   USE dom_oce , ONLY :   glamv      =>   glamv      !: longitude of t-point (degre)   
     81   USE dom_oce , ONLY :   glamf      =>   glamf      !: longitude of t-point (degre)   
     82   USE dom_oce , ONLY :   gphit      =>   gphit      !: latitude  of t-point (degre)    
     83   USE dom_oce , ONLY :   gphiu      =>   gphiu      !: latitude  of t-point (degre)    
     84   USE dom_oce , ONLY :   gphiv      =>   gphiv      !: latitude  of t-point (degre)    
     85   USE dom_oce , ONLY :   gphif      =>   gphif      !: latitude  of t-point (degre)    
     86   USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)   
     87   USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)    
     88   USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m) 
     89   USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m) 
     90   USE dom_oce , ONLY :   e1v        =>   e1v        !: horizontal scale factors at v-point (m) 
     91   USE dom_oce , ONLY :   e2v        =>   e2v        !: horizontal scale factors at v-point (m)   
     92 
     93   !* vertical mesh * 
     94   USE dom_oce , ONLY :   gdept_0    =>   gdept_0    !: reference depth of t-points (m) 
     95   USE dom_oce , ONLY :   e3t_0      =>   e3t_0      !: reference depth of t-points (m)   
     96   USE dom_oce , ONLY :   e3w_0      =>   e3w_0      !: reference depth of w-points (m) 
     97   USE dom_oce , ONLY :   gdepw_0    =>   gdepw_0    !: reference depth of w-points (m) 
     98# if ! defined key_zco 
     99   USE dom_oce , ONLY :   gdep3w     =>  gdep3w      !: ??? 
     100   USE dom_oce , ONLY :   gdept      =>  gdept       !: depth of t-points (m) 
     101   USE dom_oce , ONLY :   gdepw      =>  gdepw       !: depth of t-points (m) 
     102   USE dom_oce , ONLY :   e3t        =>  e3t         !: vertical scale factors at t- 
     103   USE dom_oce , ONLY :   e3u        =>  e3u         !: vertical scale factors at u- 
     104   USE dom_oce , ONLY :   e3v        =>  e3v         !: vertical scale factors v- 
     105   USE dom_oce , ONLY :   e3w        =>  e3w         !: w-points (m) 
     106   USE dom_oce , ONLY :   e3f        =>  e3f         !: f-points (m) 
     107   USE dom_oce , ONLY :   e3uw       =>  e3uw        !: uw-points (m) 
     108   USE dom_oce , ONLY :   e3vw       =>  e3vw        !: vw-points (m) 
     109# endif 
     110   USE dom_oce , ONLY :   ln_zps     =>  ln_zps      !: partial steps flag 
     111   USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag 
     112   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 
     123   !* masks, bathymetry * 
     124   USE dom_oce , ONLY :   mbathy    =>   mbathy      !: number of ocean level (=0,  & 1, ... , jpk-1)  
     125   USE dom_oce , ONLY :   tmask_i   =>   tmask_i     !: Interior mask at t-points 
     126   USE dom_oce , ONLY :   tmask     =>   tmask       !: land/ocean mask at t-points 
     127   USE dom_oce , ONLY :   umask     =>   umask       !: land/ocean mask at u-points    
     128   USE dom_oce , ONLY :   vmask     =>   vmask       !: land/ocean mask at v-points  
     129   USE dom_oce , ONLY :   fmask     =>   fmask       !: land/ocean mask at f-points  
     130# if defined key_off_degrad 
     131   USE dom_oce , ONLY :   facvol    =>   facvol      !: volume factor for degradation 
     132# endif 
     133 
     134   !* time domain * 
     135   USE dom_oce , ONLY :   neuler    =>   neuler      !: restart euler forward option (0=Euler) 
     136   USE dom_oce , ONLY :   rdt       =>   rdt         !: time step for the dynamics  
     137   USE dom_oce , ONLY :   atfp      =>   atfp        !: asselin time filter parameter 
     138   USE dom_oce , ONLY :   atfp1     =>   atfp1       !: asselin time filter coeff. (atfp1= 1-2*atfp) 
     139   USE dom_oce , ONLY :   rdttra    =>   rdttra      !: vertical profile of tracer time step 
     140   USE daymod  , ONLY :   ndastp    =>   ndastp      !: time step date in year/month/day aammjj 
     141   USE daymod  , ONLY :   nday_year =>   nday_year   !: curent day counted from jan 1st of the current year 
     142   USE daymod  , ONLY :   nyear     =>   nyear       !: Current year 
     143   USE daymod  , ONLY :   nmonth    =>   nmonth      !: Current month 
     144   USE daymod  , ONLY :   nday      =>   nday        !: Current day 
     145 
     146   !* ocean fields: here now and after fields * 
     147   USE oce , ONLY :   ua      =>    ua      !: i-horizontal velocity (m s-1)  
     148   USE oce , ONLY :   va      =>    va      !: j-horizontal velocity (m s-1) 
     149   USE oce , ONLY :   un      =>    un      !: i-horizontal velocity (m s-1)  
     150   USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1) 
     151   USE oce , ONLY :   wn      =>    wn      !: vertical velocity (m s-1)   
     152   USE oce , ONLY :   tn      =>    tn      !: pot. temperature (celsius) 
     153   USE oce , ONLY :   sn      =>    sn      !: salinity (psu) 
     154   USE oce , ONLY :   rhop    =>    rhop    !: potential volumic mass (kg m-3)  
     155   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
     156# if defined key_trc_diatrd 
     157   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
     158# endif 
     159 
     160 
     161   USE lib_mpp , ONLY :   lk_mpp    =>  lk_mpp       !: Mpp flag 
     162 
     163   USE dynspg_oce , ONLY :   lk_dynspg_rl   =>  lk_dynspg_rl      !: rigid lid flag 
     164 
     165   USE dom_oce , ONLY :   n_cla     =>   n_cla         !: flag (0/1) for cross land advection  
     166 
     167 
     168 
     169   !* surface fluxes * 
     170# if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 
     171   USE blk_oce, ONLY :   vatm       =>    vatm       !: wind speed at sea surface (m s-1) 
     172# endif 
     173   USE taumod , ONLY :   taux       =>    taux       !: i-surface stress component 
     174   USE taumod , ONLY :   tauy       =>    tauy       !: j-surface stress component 
     175   USE ocesbc , ONLY :   qt         =>    qt         !: total surface heat flux (w m-2)    
     176   USE ocesbc , ONLY :   qsr        =>    qsr        !: penetrative solar radiation (w m-2)   
     177   USE ocesbc , ONLY :   emp        =>    emp        !: evaporation minus precipitation (kg m-2 s-2)  
     178   USE ocesbc , ONLY :   emps       =>    emps       !: evaporation minus precipitation (kg m-2 s-2) 
     179   USE traqsr , ONLY :   xsi1       =>   xsi1        !: first depth of extinction 
     180   USE traqsr , ONLY :   ln_qsr_sms =>  ln_qsr_sms   !: flag to use or not the biological fluxes for light 
     181   USE flxrnf , ONLY :   upsrnfh    =>   upsrnfh     !: mixed adv scheme in runoffs vicinity (hori.)  
     182   USE flxrnf , ONLY :   upsrnfz    =>   upsrnfz     !: mixed adv scheme in runoffs vicinity (vert.) 
     183   USE flxrnf , ONLY :   upsadv     =>   upsadv      !: mixed adv scheme in straits vicinity (hori.) 
     184 
     185   !* freezing area * 
     186   USE ocfzpt , ONLY :   freeze      =>    freeze     !: ice mask (0 or 1)   
     187   USE ocfzpt , ONLY :   fzptn       =>    fzptn      !: now freezing temperature at ocean surface   
     188 
     189   !* bottom boundary layer * 
     190# if   defined key_trabbl_dif   ||   defined key_trabbl_adv 
     191   USE trabbl , ONLY :   atrbbl   =>   atrbbl     !: lateral coeff. for bottom boundary layer scheme (m2/s) 
     192#  if defined key_off_tra 
     193   USE trabbl, ONLY :   bblx   => bblx         !: ??? 
     194   USE trabbl, ONLY :   bbly   => bbly         !: ??? 
     195#  endif 
     196# endif 
     197 
     198   !* lateral diffusivity (tracers) * 
     199   USE ldftra_oce , ONLY :   aht0    =>   aht0     !: horizontal eddy diffusivity for tracers (m2/s) 
     200   USE ldftra_oce , ONLY :   ahtb0   =>   ahtb0    !: background eddy diffusivity for isopycnal diff. (m2/s) 
     201   USE ldftra_oce , ONLY :   ahtu    =>   ahtu     !: lateral diffusivity coef. at u-points  
     202   USE ldftra_oce , ONLY :   ahtv    =>   ahtv     !: lateral diffusivity coef. at v-points  
     203   USE ldftra_oce , ONLY :   ahtw    =>   ahtw     !: lateral diffusivity coef. at w-points  
     204   USE ldftra_oce , ONLY :   ahtt    =>   ahtt     !: lateral diffusivity coef. at t-points 
     205   USE ldftra_oce , ONLY :   aeiv0   =>   aeiv0    !: eddy induced velocity coefficient (m2/s)  
     206   USE ldftra_oce , ONLY :   aeiu    =>   aeiu     !: eddy induced velocity coef. at u-points (m2/s)    
     207   USE ldftra_oce , ONLY :   aeiv    =>   aeiv     !: eddy induced velocity coef. at v-points (m2/s)  
     208   USE ldftra_oce , ONLY :   aeiw    =>   aeiw     !: eddy induced velocity coef. at w-points (m2/s)  
     209 
     210   !* vertical diffusion * 
     211   USE zdf_oce , ONLY :   avt        =>   avt         !: vert. diffusivity coef. at w-point for temp   
     212   USE zdf_oce , ONLY :   avt0       =>   avt0        !: vertical eddy diffusivity for tracers (m2/s) 
     213   USE zdf_oce , ONLY :   ln_zdfnpc  =>   ln_zdfnpc   !: convection: non-penetrative convection flag 
     214# if defined key_zdfddm 
     215   USE zdfddm  , ONLY :   avs        =>    avs        !: salinity vertical diffusivity coeff. at w-point 
     216# endif 
     217 
     218   !* mixing & mixed layer depth * 
     219   USE zdfmxl , ONLY :   hmld        =>   hmld        !: mixing layer depth (turbocline) 
     220   USE zdfmxl , ONLY :   hmlp        =>   hmlp        !: mixed layer depth  (rho=rho0+zdcrit) (m) 
     221   USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m) 
     222 
     223   !* direction of lateral diffusion * 
     224   USE ldfslp , ONLY :   lk_ldfslp  =>  lk_ldfslp     !: slopes flag 
     225# if   defined key_ldfslp 
     226   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-direction slope at u-, w-points 
     227   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-direction slope at v-, w-points 
     228   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-direction slope at u-, w-points 
     229   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-direction slope at v-, w-points 
     230# endif 
     231 
     232#else 
     233   !!---------------------------------------------------------------------- 
     234   !!  Empty module :                                     No passive tracer 
     235   !!---------------------------------------------------------------------- 
    117236#endif 
    118237 
    119    USE dom_oce ,   ONLY :            &       
    120       ln_zps   =>  ln_zps ,  & !: partial steps flag 
    121       ln_sco   =>  ln_sco ,  & !: s-coordinate flag 
    122       ln_zco   =>  ln_zco ,  & !: z-coordinate flag 
    123       lk_zco   =>  lk_zco      !: z-coordinate flag (1D or 3D arrays) 
    124  
    125    USE lib_mpp ,   ONLY :            &      
    126       lk_mpp   =>  lk_mpp      !: Mpp flag 
    127  
    128    USE dynspg_oce ,   ONLY :            &      
    129       lk_dynspg_rl   =>  lk_dynspg_rl      !: rigid lid flag 
    130  
    131  
    132    USE dom_oce , ONLY :              &    
    133       hbatt   =>   hbatt  ,  & !: ocean depth at the vertical of  t-point (m) 
    134       hbatu   =>   hbatu  ,  & !: ocean depth at the vertical of  u-point (m) 
    135       hbatv   =>   hbatv  ,  & !: ocean depth at the vertical of w-point (m) 
    136       gsigt   =>   gsigt  ,  & !: model level depth coefficient at t-,  & w-levelsvertical scale factors at u- 
    137       gsigw   =>   gsigw  ,  & !: model level depth coefficient at t-,  & w-levelsvertical scale factors v- 
    138       gsi3w   =>   gsi3w  ,  & !: model level depth coef at w-levels (defined as the sum of e3w) 
    139       esigt   =>   esigt  ,  & !: vertical scale factor coef. at t-levels 
    140       esigw   =>   esigw       !: vertical scale factor coef. at w-levels 
    141  
    142    !! masks, bathymetry 
    143    USE dom_oce , ONLY :             &     
    144       mbathy   =>   mbathy,  & !: number of ocean level (=0,  & 1, ... , jpk-1)  
    145       tmask_i  =>   tmask_i, & !: Interior mask at t-points 
    146       tmask    =>   tmask ,  & !: land/ocean mask at t-points 
    147       umask    =>   umask ,  & !: land/ocean mask at u-points    
    148       vmask    =>   vmask ,  & !: land/ocean mask at v-points  
    149       fmask    =>   fmask      !: land/ocean mask at f-points  
    150  
    151 #if defined key_off_degrad 
    152    USE dom_oce , ONLY :                 & 
    153       facvol   =>   facvol     !: volume factor for degradation 
    154 #endif 
    155  
    156    USE dom_oce , ONLY :         & 
    157       n_cla   =>   n_cla       !: flag (0/1) for cross land advection  
    158  
    159    !! time domain 
    160    USE dom_oce , ONLY :                 & 
    161       neuler   =>   neuler,  & !: restart euler forward option (0=Euler) 
    162       rdt      =>   rdt   ,  & !: time step for the dynamics  
    163       atfp     =>   atfp  ,  & !: asselin time filter parameter 
    164       atfp1    =>   atfp1 ,  & !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    165       rdttra   =>   rdttra     !: vertical profile of tracer time step 
    166  
    167    USE daymod , ONLY :                 & 
    168       ndastp    =>   ndastp,  &    !: time step date in year/month/day aammjj 
    169       nday_year =>   nday_year, &  !: curent day counted from jan 1st of the current year 
    170       nyear     =>   nyear,   &  !: Current year 
    171       nmonth    =>   nmonth,  &  !: Current month 
    172       nday      =>   nday        !: Current day 
    173  
    174    !! physical constants 
    175    USE phycst ,   ONLY :                &   
    176       ra       =>   ra    ,  & !: earth radius 
    177       rpi      =>   rpi   ,  & !: pi 
    178       rday     =>   rday  ,  & !: day 
    179       rauw     =>   rauw  ,  & !: density of pure water kg/m3 
    180       ro0cpr   =>   ro0cpr,  & !: = 1. / ( rau0 * rcp ) 
    181       rad      =>   rad   ,  & !: conversion coeff. from degre into radian 
    182       raass    =>   raass ,  & !: number of seconds in one year 
    183       rmoss    =>   rmoss ,  & !: number of seconds in one month 
    184       rjjss    =>   rjjss      !: number of seconds in one day 
    185  
    186    !! present fields (now) 
    187    USE oce , ONLY :            &      
    188       ua      =>    ua    ,  & !: i-horizontal velocity (m s-1)  
    189       va      =>    va    ,  & !: j-horizontal velocity (m s-1) 
    190       un      =>    un    ,  & !: i-horizontal velocity (m s-1)  
    191       vn      =>    vn    ,  & !: j-horizontal velocity (m s-1) 
    192       wn      =>    wn    ,  & !: vertical velocity (m s-1)   
    193       tn      =>    tn    ,  & !: pot. temperature (celsius) 
    194       sn      =>    sn    ,  & !: salinity (psu) 
    195       rhop    =>    rhop  ,  & !: potential volumic mass (kg m-3)  
    196       rhd     =>    rhd        !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    197  
    198 #if defined key_trc_diatrd 
    199    USE oce , ONLY :          & 
    200       hdivn   =>    hdivn      !: horizontal divergence (1/s) 
    201 #endif 
    202  
    203 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 
    204    !! wind speed 
    205    USE blk_oce , ONLY :        &      
    206       vatm    =>    vatm       !: wind speed at sea surface (m s-1) 
    207 #endif 
    208  
    209    !! wind speed 
    210    USE taumod , ONLY :        &      
    211       taux    =>    taux ,  &  !: i-surface stress component 
    212       tauy    =>    tauy       !: j-surface stress component 
    213  
    214 #if   defined key_trabbl_dif   ||   defined key_trabbl_adv 
    215    USE trabbl , ONLY :           &       
    216       atrbbl   =>   atrbbl     !: lateral coeff. for bottom boundary layer scheme (m2/s) 
    217 #  if defined key_off_tra 
    218    USE trabbl, ONLY :            & 
    219       bblx   => bblx,       & 
    220       bbly   => bbly 
    221 #  endif 
    222 #endif 
    223  
    224    !! lateral diffusivity (tracers) 
    225    USE ldftra_oce ,   ONLY :             &     
    226       aht0    =>   aht0  ,  &  !: horizontal eddy diffusivity for tracers (m2/s) 
    227       ahtb0   =>   ahtb0 ,  &  !: background eddy diffusivity for isopycnal diff. (m2/s) 
    228       ahtu    =>   ahtu  ,  &  !: lateral diffusivity coef. at u-points  
    229       ahtv    =>   ahtv  ,  &  !: lateral diffusivity coef. at v-points  
    230       ahtw    =>   ahtw  ,  &  !: lateral diffusivity coef. at w-points  
    231       ahtt    =>   ahtt  ,  &  !: lateral diffusivity coef. at t-points 
    232       aeiv0   =>   aeiv0 ,  &  !: eddy induced velocity coefficient (m2/s)  
    233       aeiu    =>   aeiu  ,  &  !: eddy induced velocity coef. at u-points (m2/s)    
    234       aeiv    =>   aeiv  ,  &  !: eddy induced velocity coef. at v-points (m2/s)  
    235       aeiw    =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s)  
    236  
    237    !! vertical diffusion 
    238    USE zdf_oce , ONLY :      &     
    239       avt            =>   avt          ,  & !: vert. diffusivity coef. at w-point for temp   
    240       avt0           =>   avt0         ,  & !: vertical eddy diffusivity for tracers (m2/s) 
    241       ln_zdfnpc      =>   ln_zdfnpc         !: convection: non-penetrative convection flag 
    242  
    243  
    244 #if defined key_zdfddm 
    245    USE zdfddm , ONLY :             &      
    246       avs     =>    avs        !: salinity vertical diffusivity coeff. at w-point 
    247 #endif 
    248  
    249    !! penetrative solar radiation 
    250    USE traqsr , ONLY :            & 
    251       xsi1        =>   xsi1    ,  & !: first depth of extinction 
    252       ln_qsr_sms  =>  ln_qsr_sms    !: flag to use or not the biological fluxes for light 
    253  
    254    !! surface fluxes 
    255    USE ocesbc , ONLY :             &    
    256       qt      =>    qt    ,  & !: total surface heat flux (w m-2)    
    257       qsr     =>    qsr   ,  & !: penetrative solar radiation (w m-2)   
    258       emp     =>    emp   ,  & !: evaporation minus precipitation (kg m-2 s-2)  
    259       emps    =>    emps       !: evaporation minus precipitation (kg m-2 s-2) 
    260  
    261    !! freezing area 
    262    USE ocfzpt , ONLY :            &       
    263       freeze  =>    freeze,  & !: ice mask (0 or 1)   
    264       fzptn   =>    fzptn      !: now freezing temperature at ocean surface   
    265  
    266  
    267    !! mixing layer depth (turbocline) 
    268    USE zdfmxl , ONLY :             &     
    269       hmld    =>   hmld   ,  & !: mixing layer depth (turbocline) 
    270       hmlp    =>   hmlp   ,  & !: mixed layer depth  (rho=rho0+zdcrit) (m) 
    271       hmlpt   =>   hmlpt       !: mixed layer depth at t-points (m) 
    272  
    273    USE ldfslp , ONLY :              &  
    274       lk_ldfslp  =>  lk_ldfslp     !: slopes flag 
    275 #if   defined key_ldfslp 
    276    !! direction of lateral diffusion (momentum  tracers)  
    277    USE ldfslp , ONLY :              &  
    278       uslp       =>   uslp    ,  & !: i-direction slope at u-, w-points 
    279       vslp       =>   vslp    ,  & !: j-direction slope at v-, w-points 
    280       wslpi      =>   wslpi   ,  & !: i-direction slope at u-, w-points 
    281       wslpj      =>   wslpj        !: j-direction slope at v-, w-points 
    282 #endif 
    283  
    284    !! ocean forcings runoff 
    285    USE flxrnf , ONLY :              &    
    286       upsrnfh =>   upsrnfh ,  & !: mixed adv scheme in runoffs vicinity (hori.)  
    287       upsrnfz =>   upsrnfz ,  & !: mixed adv scheme in runoffs vicinity (vert.) 
    288       upsadv  =>   upsadv       !: mixed adv scheme in straits vicinity (hori.) 
    289  
     238   !!====================================================================== 
    290239END MODULE oce_trc 

  • branches/dev_001_GM/NEMO/TOP_SRC/par_trc.F90

    r724 r763  
    22   !!====================================================================== 
    33   !!                        ***  par_trc  *** 
    4    !! passive tracers :   set the passive tracers parameters 
     4   !! TOP :   set the passive tracers parameters 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   8.2  !  96-01  (M. Levy)  Original code 
    8    !!        !  99-07  (M. Levy)  for LOBSTER1 or NPZD model 
    9    !!        !  00-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    10    !!   9.0  !  04-03  (C. Ethe)  Free form and module 
     6   !! History :    -   !  1996-01  (M. Levy)  original code 
     7   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model 
     8   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
     9   !!             1.0  !  2004-03  (C. Ethe) Free form and module 
     10   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  rewritting 
    1111   !!---------------------------------------------------------------------- 
    12    !!  TOP 1.0,  LOCEAN-IPSL (2005) 
    13    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/par_trc.F90,v 1.6 2007/10/12 09:22:19 opalod Exp $ 
    14    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     12   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     13   !! $Header:$  
     14   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1515   !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    1716#if defined key_passivetrc 
    18  
     17   !!---------------------------------------------------------------------- 
     18   !!   'key_passivetrc'                                    Passive tracers 
     19   !!---------------------------------------------------------------------- 
    1920   USE par_trc_trp 
    2021 
    … …  
    2223   PUBLIC 
    2324 
     25# if defined key_trc_diatrd 
     26   !!---------------------------------------------------------------------- 
     27   !!   'key_trc_diatrd'                                  trend diagnostics 
     28   !!---------------------------------------------------------------------- 
     29#  if defined key_trcldf_eiv 
     30#   if defined key_trcdmp 
     31   INTEGER, PARAMETER :: jpdiatrc = 11      !: trends: 3*(advection + diffusion + eiv ) + damping + sms 
     32#   else 
     33   INTEGER, PARAMETER :: jpdiatrc = 10      !: trends: 3*(advection + diffusion + eiv )           + sms 
     34#   endif 
     35#  else 
     36#   if defined key_trcdmp 
     37   INTEGER, PARAMETER :: jpdiatrc =  8      !: trends: 3*(advection + diffusion       ) + damping + sms 
     38#   else 
     39   INTEGER, PARAMETER :: jpdiatrc =  7      !: trends: 3*(advection + diffusion       ) + damping + sms 
     40#   endif 
     41#  endif 
    2442 
    25 #if defined key_trc_diatrd 
    26  
    27 !! number of dynamical trends 
    28 #  if defined key_trcldf_eiv 
    29 !! we keep 3 more trends for eddy induced flux (gent velocity) 
    30 #    if defined key_trcdmp 
    31    INTEGER , PARAMETER :: jpdiatrc = 11 
    32 #    else 
    33    INTEGER , PARAMETER :: jpdiatrc = 10 
    34 #    endif 
    35 #  else 
    36 #    if defined key_trcdmp 
    37    INTEGER , PARAMETER :: jpdiatrc = 8 
    38 #    else 
    39    INTEGER , PARAMETER :: jpdiatrc = 7 
    40 #    endif 
    41 #  endif 
    4243# endif 
    4344 
    4445#else 
    4546   !!====================================================================== 
    46    !!  Empty module : No passive tracer  
     47   !!  Empty module :                                     No passive tracer  
    4748   !!====================================================================== 
    4849#endif 
    4950 
     51   !!====================================================================== 
    5052END MODULE par_trc 

  • branches/dev_001_GM/NEMO/TOP_SRC/par_trc_trp.F90

    r719 r763  
    22   !!====================================================================== 
    33   !!                        ***  par_trc_trp  *** 
    4    !! passive tracers :   set the number of passive tracers 
     4   !! TOP :   set the number of passive tracers 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   9.0  !  04-03  (C. Ethe)  Orignal 
     6   !! History :   1.0  !  2004-03  (C. Ethe)  Original cade 
     7   !!             2.0  !  04-03  (C. Ethe, G. Madec)  rewriting 
    88   !!---------------------------------------------------------------------- 
    9    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    10    !! $Header$  
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     9   !! NEMO/TOP 1.0,  LOCEAN-IPSL (2005) 
     10   !! $Id$ 
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1212   !!---------------------------------------------------------------------- 
    1313#if defined key_passivetrc 
    14    !!--------------------------------------------------------------------- 
    15    !!   'key_passivetrc'   :                               Passive tracer 
    16    !!--------------------------------------------------------------------- 
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_passivetrc'                                    Passive tracers 
     16   !!---------------------------------------------------------------------- 
    1717 
    1818   IMPLICIT NONE 
    1919   PUBLIC 
    2020    
    21    !! jptra   : number of passive tracers 
    22    !! jpdia2d : additional 2d output 
    23    !! jpdia3d : additional 3d output 
    24  
    25 #if defined key_trc_lobster1 
     21# if defined key_trc_lobster1 
    2622   !!--------------------------------------------------------------------- 
    27    !!   'key_trc_lobster1'   :            LOBSTER1 Source Minus Sink model 
     23   !!   'key_trc_lobster1'   :                    LOBSTER biological model 
    2824   !!--------------------------------------------------------------------- 
    29    INTEGER, PUBLIC, PARAMETER :: jptra   = 6 
    30 #if defined key_trc_diaadd 
    31    INTEGER, PUBLIC, PARAMETER :: jpdia2d = 19 
    32    INTEGER, PUBLIC, PARAMETER :: jpdia3d = 3 
    33 #endif 
    34 #elif defined key_cfc 
     25   INTEGER, PUBLIC, PARAMETER ::   jptra   =  6   !: number of passive tracers 
     26#  if defined key_trc_diaadd 
     27   INTEGER, PUBLIC, PARAMETER ::   jpdia2d = 19   !: additional 2d output 
     28   INTEGER, PUBLIC, PARAMETER ::   jpdia3d =  3   !: additional 3d output 
     29#  endif 
     30# elif defined key_cfc 
    3531   !!--------------------------------------------------------------------- 
    3632   !!   'key_cfc'   :                      CFC Source Minus Sink model 
    3733   !!--------------------------------------------------------------------- 
    38    INTEGER, PUBLIC, PARAMETER :: jptra   = 2 
    39 #if defined key_trc_diaadd 
    40    INTEGER, PUBLIC, PARAMETER :: jpdia2d = 1 
    41    INTEGER, PUBLIC, PARAMETER :: jpdia3d = 1 
    42 #endif 
    43 #elif defined key_trc_pisces 
     34   INTEGER, PUBLIC, PARAMETER ::   jptra   = 2   !: number of passive tracers 
     35#  if defined key_trc_diaadd 
     36   INTEGER, PUBLIC, PARAMETER ::   jpdia2d = 1   !: additional 2d output 
     37   INTEGER, PUBLIC, PARAMETER ::   jpdia3d = 1   !: additional 3d output 
     38#  endif 
     39# elif defined key_trc_pisces 
    4440   !!--------------------------------------------------------------------- 
    4541   !!   'key_trc_pisces'   :                  PISCES Source Minus Sink model 
    4642   !!--------------------------------------------------------------------- 
    47 #if ! defined key_trc_kriest 
    48    INTEGER, PUBLIC, PARAMETER :: jptra   = 24 
    49 #if defined key_trc_diaadd 
    50    INTEGER, PUBLIC, PARAMETER :: jpdia2d = 13 
    51    INTEGER, PUBLIC, PARAMETER :: jpdia3d = 11 
     43#  if ! defined key_trc_kriest 
     44   INTEGER, PUBLIC, PARAMETER ::   jptra   = 24   !: number of passive tracers 
     45#   if defined key_trc_diaadd 
     46   INTEGER, PUBLIC, PARAMETER ::   jpdia2d = 13   !: additional 2d output 
     47   INTEGER, PUBLIC, PARAMETER ::   jpdia3d = 11   !: additional 3d output 
     48#   endif 
     49#  else 
     50   INTEGER, PUBLIC, PARAMETER ::   jptra   = 23   !: number of passive tracers 
     51#   if defined key_trc_diaadd 
     52   INTEGER, PUBLIC, PARAMETER ::   jpdia2d = 13   !: additional 2d output 
     53   INTEGER, PUBLIC, PARAMETER ::   jpdia3d = 18   !: additional 3d output 
     54#   endif 
    5255#  endif 
    53 #else 
    54    INTEGER, PUBLIC, PARAMETER :: jptra   = 23 
    55 #if defined key_trc_diaadd 
    56    INTEGER, PUBLIC, PARAMETER :: jpdia2d = 13 
    57    INTEGER, PUBLIC, PARAMETER :: jpdia3d = 18 
    58 #  endif 
    59 #endif 
    60 #else 
     56# else 
    6157   !!--------------------------------------------------------------------- 
    6258   !!   'default'   :          temperature and salinity as passive tracers 
    6359   !!--------------------------------------------------------------------- 
    64    INTEGER, PUBLIC, PARAMETER :: jptra   = 2 
    65 #if defined key_trc_diaadd 
    66    INTEGER, PUBLIC, PARAMETER :: jpdia2d = 1 
    67    INTEGER, PUBLIC, PARAMETER :: jpdia3d = 1 
    68 #endif 
     60   INTEGER, PUBLIC, PARAMETER ::   jptra   = 2   !: number of passive tracers 
     61#  if defined key_trc_diaadd 
     62   INTEGER, PUBLIC, PARAMETER ::   jpdia2d = 1   !: additional 2d output 
     63   INTEGER, PUBLIC, PARAMETER ::   jpdia3d = 1   !: additional 3d output 
     64#  endif 
     65# endif 
     66 
     67#else 
     68   !!---------------------------------------------------------------------- 
     69   !!  Empty module :                                     No passive tracer 
     70   !!---------------------------------------------------------------------- 
    6971#endif 
    7072 
    71 #else 
    7273   !!====================================================================== 
    73    !!  Empty module : No passive tracer  
    74    !!====================================================================== 
    75 #endif 
    76  
    7774END MODULE par_trc_trp 

  • branches/dev_001_GM/NEMO/TOP_SRC/passivetrc_substitute.h90

    r719 r763  
    55   !!              concerning passive tracer model  
    66   !!---------------------------------------------------------------------- 
    7    !!  TOP 1.0,  LOCEAN-IPSL (2005) 
    8    !! $Header$ 
    9    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     7   !! History :   1.0  !  2004-03 (C. Ethe) Original code 
     8   !!---------------------------------------------------------------------- 
     9   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2007)  
     10   !! $Header:$  
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1012   !!---------------------------------------------------------------------- 
    1113 

  • branches/dev_001_GM/NEMO/TOP_SRC/prtctl_trc.F90

    r719 r763  
    11MODULE prtctl_trc 
    2    !!============================================================================== 
    3    !!                       ***  MODULE prtctl   *** 
    4    !! Ocean system   : print all SUM trends for each processor domain 
    5    !!============================================================================== 
     2   !!====================================================================== 
     3   !!                         ***  MODULE prtctl_trc  *** 
     4   !! TOP :   print all SUM trends for each processor domain 
     5   !!====================================================================== 
     6   !! History :    -   !  2005-07  (C. Talandier) original code for OPA 
     7   !!             1.0  !  2005-10  (C. Ethe     ) adapted to passive tracer 
     8   !!---------------------------------------------------------------------- 
    69#if defined key_passivetrc 
    7  
    8    USE par_trc_trp 
     10   !!---------------------------------------------------------------------- 
     11   !!   'key_passivetrc'                                    Passive tracers 
     12   !!---------------------------------------------------------------------- 
     13   !!   prt_ctl_trc      :   control print in mpp for passive tracers 
     14   !!   prt_ctl_trc_info :   ??? 
     15   !!   prt_ctl_trc_init :   ??? 
     16   !!---------------------------------------------------------------------- 
     17   USE par_trc_trp      ! ??? 
    918   USE oce_trc          ! ocean space and time domain variables 
    1019   USE in_out_manager   ! I/O manager 
    … …  
    1423   PRIVATE 
    1524 
    16    !! * Module declaration 
    17    INTEGER, DIMENSION(:), ALLOCATABLE :: numid_trc  ! logical unit  
    18    INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   &  !: 
    19       nlditl , nldjtl ,   &  !: first, last indoor index for each i-domain 
    20       nleitl , nlejtl ,   &  !: first, last indoor index for each j-domain 
    21       nimpptl, njmpptl,   &  !: i-, j-indexes for each processor 
    22       nlcitl , nlcjtl ,   &  !: dimensions of every subdomain 
    23       ibonitl, ibonjtl 
    24  
    25    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   &  !: 
    26       tra_ctl                   !: previous trend values 
    27  
    28    !! * Routine accessibility 
     25   INTEGER , DIMENSION(:), ALLOCATABLE ::   numid_trc          !: logical unit  
     26   INTEGER , DIMENSION(:), ALLOCATABLE ::   nlditl , nldjtl    !: first, last indoor index for each i-domain 
     27   INTEGER , DIMENSION(:), ALLOCATABLE ::   nleitl , nlejtl    !: first, last indoor index for each j-domain 
     28   INTEGER , DIMENSION(:), ALLOCATABLE ::   nimpptl, njmpptl   !: i-, j-indexes for each processor 
     29   INTEGER , DIMENSION(:), ALLOCATABLE ::   nlcitl , nlcjtl    !: dimensions of every subdomain 
     30   INTEGER , DIMENSION(:), ALLOCATABLE ::   ibonitl, ibonjtl 
     31 
     32   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   tra_ctl         !: previous trend values 
     33 
    2934   PUBLIC prt_ctl_trc         ! called by all subroutines 
    3035   PUBLIC prt_ctl_trc_info    ! 
    3136   PUBLIC prt_ctl_trc_init    ! called by opa.F90 
    32    !!---------------------------------------------------------------------- 
    33    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    34    !! $Header$  
    35    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    36    !!---------------------------------------------------------------------- 
    37  
     37 
     38   !!---------------------------------------------------------------------- 
     39   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     40   !! $Header:$  
     41   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     42   !!---------------------------------------------------------------------- 
    3843 
    3944CONTAINS 
    4045 
    41    SUBROUTINE prt_ctl_trc (tab4d, mask, clinfo, ovlap, kdim, clinfo2) 
     46   SUBROUTINE prt_ctl_trc( tab4d, mask, clinfo, ovlap, kdim, clinfo2 ) 
    4247      !!---------------------------------------------------------------------- 
    4348      !!                     ***  ROUTINE prt_ctl  *** 
    … …  
    6166      !!                name must be explicitly typed if used. For instance if the mask 
    6267      !!                array tmask(:,:,:) must be passed through the prt_ctl subroutine,  
    63       !!                it must looks like: CALL prt_ctl(mask=tmask). 
    64       !! 
    65       !!                    tab4d   : 4D array 
    66       !!                    mask    : mask (3D) to apply to the tab4d array 
    67       !!                    clinfo  : information about the tab3d array 
    68       !!                    ovlap   : overlap value 
    69       !!                    kdim    : k- direction for 4D arrays  
    70       !! 
    71       !! History : 
    72       !!   9.0  !  05-07  (C. Talandier) original code 
    73       !!        !  05-10  (C. Ethe     ) adapted to passive tracer 
    74       !!---------------------------------------------------------------------- 
    75       !! * Arguments 
    76       REAL(wp), DIMENSION(:,:,:,:), INTENT(in), OPTIONAL :: tab4d 
    77       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask 
    78       CHARACTER (len=*), DIMENSION(:), INTENT(in), OPTIONAL :: clinfo 
    79       CHARACTER (len=*), INTENT(in), OPTIONAL :: clinfo2 
    80       INTEGER, INTENT(in), OPTIONAL :: ovlap 
    81       INTEGER, INTENT(in), OPTIONAL :: kdim 
    82  
    83       !! * Local declarations 
    84       INTEGER  :: overlap, jn, js, sind, eind, kdir, j_id 
    85       REAL(wp) :: zsum, zvctl 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, ztab3d 
    87       CHARACTER (len=20), DIMENSION(jptra) :: cl 
    88       CHARACTER (len=10) :: cl2 
    89       !!---------------------------------------------------------------------- 
    90  
    91       ! Arrays, scalars initialization  
     68      !!                it must looks like: CALL prt_ctl( mask=tmask ). 
     69      !!---------------------------------------------------------------------- 
     70      REAL(wp)         , DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d     ! 4D array 
     71      REAL(wp)         , DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask      ! 3D mask to apply to the tab4d array 
     72      CHARACTER (len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array 
     73      CHARACTER (len=*)                    , INTENT(in), OPTIONAL ::   clinfo2   ! ??? 
     74      INTEGER                              , INTENT(in), OPTIONAL ::   ovlap     ! overlap value 
     75      INTEGER                              , INTENT(in), OPTIONAL ::   kdim      ! k- direction for 4D arrays 
     76      !! 
     77      INTEGER  ::   overlap, jn, js, sind, eind, kdir, j_id 
     78      REAL(wp) ::   zsum, zvctl 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask, ztab3d 
     80      CHARACTER (len=20), DIMENSION(jptra) ::   cl 
     81      CHARACTER (len=10) ::   cl2 
     82      !!---------------------------------------------------------------------- 
     83 
     84      !                                      ! Arrays, scalars initialization  
    9285      overlap       = 0 
    9386      kdir          = jpkm1 
    … …  
    9992      zmask (:,:,:) = 1.e0 
    10093 
    101       ! Control of optional arguments 
    102  
    103       IF( PRESENT(ovlap)   )  overlap       = ovlap 
    104       IF( PRESENT(kdim)    )  kdir          = kdim 
    105       IF( PRESENT(clinfo ) )  cl(:)         = clinfo(:) 
    106       IF( PRESENT(clinfo2) )  cl2           = clinfo2 
    107       IF( PRESENT(mask)    )  zmask (:,:,:) = mask(:,:,:) 
    108  
    109       IF( lk_mpp )   THEN 
    110          ! processor number 
     94      !                                      ! Control of optional arguments 
     95      IF( PRESENT(ovlap)   )   overlap       = ovlap 
     96      IF( PRESENT(kdim)    )   kdir          = kdim 
     97      IF( PRESENT(clinfo ) )   cl(:)         = clinfo(:) 
     98      IF( PRESENT(clinfo2) )   cl2           = clinfo2 
     99      IF( PRESENT(mask)    )   zmask (:,:,:) = mask(:,:,:) 
     100 
     101      IF( lk_mpp )   THEN      ! processor number 
    111102         sind = narea 
    112103         eind = narea 
    113       ELSE 
    114          ! processors total number 
     104      ELSE                     ! processors total number 
    115105         sind = 1 
    116106         eind = ijsplt 
    … …  
    119109      ! Loop over each sub-domain, i.e. the total number of processors ijsplt 
    120110      DO js = sind, eind 
    121  
     111         ! 
    122112         ! Set logical unit 
    123          j_id = numid_trc(js - narea + 1) 
     113         j_id = numid_trc( js - narea + 1 ) 
    124114         ! Set indices for the SUM control 
    125115         IF( .NOT. lsp_area ) THEN 
    … …  
    130120               njctle = nlejtl(js) + overlap * MIN( 1, nlcjtl(js) - nlejtl(js)) 
    131121               ! Do not take into account the bound of the domain 
    132                IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 ) nictls = MAX(2, nictls) 
    133                IF( ibonitl(js) ==  1 .OR. ibonitl(js) == 2 ) nictle = MIN(nictle, nleitl(js) - 1) 
    134                IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 ) njctls = MAX(2, njctls) 
    135                IF( ibonjtl(js) ==  1 .OR. ibonjtl(js) == 2 ) njctle = MIN(njctle, nlejtl(js) - 1) 
     122               IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 )   nictls = MAX( 2, nictls ) 
     123               IF( ibonitl(js) ==  1 .OR. ibonitl(js) == 2 )   nictle = MIN( nictle, nleitl(js) - 1 ) 
     124               IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 )   njctls = MAX( 2, njctls ) 
     125               IF( ibonjtl(js) ==  1 .OR. ibonjtl(js) == 2 )   njctle = MIN( njctle, nlejtl(js) - 1 ) 
    136126            ELSE 
    137127               nictls = MAX( 1, nimpptl(js) + nlditl(js) - 1 - overlap ) 
    … …  
    140130               njctle = njmpptl(js) + nlejtl(js) - 1 + overlap * MIN( 1, nlcjtl(js) - nlejtl(js) )  
    141131               ! Do not take into account the bound of the domain 
    142                IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 ) nictls = MAX(2, nictls) 
    143                IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 ) njctls = MAX(2, njctls) 
    144                IF( ibonitl(js) ==  1 .OR. ibonitl(js) == 2 ) nictle = MIN(nictle, nimpptl(js) + nleitl(js) - 2) 
    145                IF( ibonjtl(js) ==  1 .OR. ibonjtl(js) == 2 ) njctle = MIN(njctle, njmpptl(js) + nlejtl(js) - 2) 
     132               IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 )   nictls = MAX( 2, nictls ) 
     133               IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 )   njctls = MAX( 2, njctls ) 
     134               IF( ibonitl(js) ==  1 .OR. ibonitl(js) == 2 )   nictle = MIN( nictle, nimpptl(js) + nleitl(js) - 2 ) 
     135               IF( ibonjtl(js) ==  1 .OR. ibonjtl(js) == 2 )   njctle = MIN( njctle, njmpptl(js) + nlejtl(js) - 2 ) 
    146136            ENDIF 
    147137         ENDIF 
    148           
     138         ! 
    149139         IF( PRESENT(clinfo2) ) THEN 
    150140            DO jn = 1, jptra 
    151141               zvctl  = tra_ctl(jn,js) 
    152142               ztab3d(:,:,:) = tab4d(:,:,:,jn) 
    153                zsum          = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir) & 
    154                   &                 *zmask(nictls:nictle,njctls:njctle,1:kdir) ) 
     143               zsum          = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir)   & 
     144                  &                * zmask(nictls:nictle,njctls:njctle,1:kdir) ) 
    155145               WRITE(j_id,FMT="(3x,a,' : ',D23.16)") cl(jn), zsum-zvctl 
    156146               tra_ctl(jn,js) = zsum 
    157             ENDDO 
     147            END DO 
    158148         ELSE 
    159149            DO jn = 1, jptra 
    160150               ztab3d(:,:,:) = tab4d(:,:,:,jn) 
    161                zsum          = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir) & 
    162                   &               * zmask(nictls:nictle,njctls:njctle,1:kdir) ) 
     151               zsum          = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir)   & 
     152                  &               *  zmask(nictls:nictle,njctls:njctle,1:kdir) ) 
    163153               WRITE(j_id,FMT="(3x,a,' : ',D23.16)") cl(jn), zsum 
    164154            END DO 
    165155         ENDIF 
    166           
    167  
    168       ENDDO 
    169  
     156         ! 
     157      END DO 
     158      ! 
    170159   END SUBROUTINE prt_ctl_trc 
    171160 
    172    SUBROUTINE prt_ctl_trc_info (clinfo) 
     161 
     162   SUBROUTINE prt_ctl_trc_info( clinfo ) 
    173163      !!---------------------------------------------------------------------- 
    174164      !!                     ***  ROUTINE prt_ctl_trc_info  *** 
    175165      !! 
    176166      !! ** Purpose : - print information without any computation 
    177       !! 
    178       !! ** Action  : - input arguments 
    179       !!                    clinfo : information to print 
    180       !! 
    181       !! History : 
    182       !!   9.0  !  05-07  (C. Talandier) original code 
    183       !!---------------------------------------------------------------------- 
    184       !! * Arguments 
    185       CHARACTER (len=*), INTENT(in) ::   clinfo 
    186  
    187       !! * Local declarations 
    188       INTEGER ::  js, sind, eind, j_id 
    189       !!---------------------------------------------------------------------- 
    190  
    191       IF( lk_mpp )   THEN 
    192          ! processor number 
     167      !!---------------------------------------------------------------------- 
     168      CHARACTER (len=*), INTENT(in) ::   clinfo      ! information to print 
     169      !!  
     170      INTEGER ::   js, sind, eind, j_id 
     171      !!---------------------------------------------------------------------- 
     172 
     173      IF( lk_mpp ) THEN      ! processor number 
    193174         sind = narea 
    194175         eind = narea 
    195       ELSE 
    196          ! total number of processors 
     176      ELSE                   ! total number of processors 
    197177         sind = 1 
    198178         eind = ijsplt 
    … …  
    202182      DO js = sind, eind 
    203183         j_id = numid_trc(js - narea + 1) 
    204          WRITE(j_id,*)clinfo 
    205       ENDDO 
    206  
    207  
     184         WRITE(j_id,*) clinfo 
     185      END DO 
     186      ! 
    208187   END SUBROUTINE prt_ctl_trc_info 
    209188 
     189 
    210190   SUBROUTINE prt_ctl_trc_init 
    211191      !!---------------------------------------------------------------------- 
    … …  
    213193      !! 
    214194      !! ** Purpose :   open ASCII files & compute indices 
    215       !! 
    216       !! History : 
    217       !!   9.0  !  05-07  (C. Talandier) original code 
    218       !!        !  05-10  (C. Ethe     ) adapted to passive tracer 
    219       !!---------------------------------------------------------------------- 
    220       !! * Local declarations 
    221       INTEGER ::   js, sind, eind, j_id 
     195      !!---------------------------------------------------------------------- 
     196      INTEGER            ::   js, sind, eind, j_id 
    222197      CHARACTER (len=31) :: clfile_out 
    223198      CHARACTER (len=27) :: clb_name 
    … …  
    225200      !!---------------------------------------------------------------------- 
    226201 
    227       ! Allocate arrays 
    228       ALLOCATE(nlditl (ijsplt)) 
    229       ALLOCATE(nldjtl (ijsplt)) 
    230       ALLOCATE(nleitl (ijsplt)) 
    231       ALLOCATE(nlejtl (ijsplt)) 
    232       ALLOCATE(nimpptl(ijsplt)) 
    233       ALLOCATE(njmpptl(ijsplt)) 
    234       ALLOCATE(nlcitl (ijsplt)) 
    235       ALLOCATE(nlcjtl (ijsplt)) 
    236       ALLOCATE(tra_ctl(jptra,ijsplt)) 
    237       ALLOCATE(ibonitl(ijsplt)) 
    238       ALLOCATE(ibonjtl(ijsplt)) 
    239  
    240       ! Initialization  
    241       tra_ctl (:,:)=0.e0 
     202      !                             ! Allocate arrays 
     203      ALLOCATE( nlditl (ijsplt) ) 
     204      ALLOCATE( nldjtl (ijsplt) ) 
     205      ALLOCATE( nleitl (ijsplt) ) 
     206      ALLOCATE( nlejtl (ijsplt) ) 
     207      ALLOCATE( nimpptl(ijsplt) ) 
     208      ALLOCATE( njmpptl(ijsplt) ) 
     209      ALLOCATE( nlcitl (ijsplt) ) 
     210      ALLOCATE( nlcjtl (ijsplt) ) 
     211      ALLOCATE( tra_ctl(jptra,ijsplt) ) 
     212      ALLOCATE( ibonitl(ijsplt) ) 
     213      ALLOCATE( ibonjtl(ijsplt) ) 
     214 
     215      tra_ctl(:,:) = 0.e0           ! Initialization to zero 
    242216 
    243217      IF( lk_mpp ) THEN 
    … …  
    264238         eind = ijsplt 
    265239         clb_name = "('mono.top.output_',I3.3)" 
    266          cl_run = 'MONO processor run ' 
     240         cl_run   = 'MONO processor run ' 
    267241         ! compute indices for each area as done in mpp_init subroutine 
    268242         CALL sub_dom 
    269243      ENDIF 
    270244 
    271       ALLOCATE(numid_trc(eind-sind+1)) 
     245      ALLOCATE( numid_trc(eind-sind+1) ) 
    272246 
    273247      DO js = sind, eind 
    … …  
    278252         WRITE(j_id,*) 
    279253         WRITE(j_id,*) '                 L O D Y C - I P S L' 
    280          WRITE(j_id,*) '                     O P A model' 
     254         WRITE(j_id,*) '                       N E M 0 ' 
    281255         WRITE(j_id,*) '            Ocean General Circulation Model' 
    282          WRITE(j_id,*) '               version OPA 9.0  (2005) ' 
     256         WRITE(j_id,*) '               version TOP 1.0  (2005) ' 
    283257         WRITE(j_id,*) 
    284258         WRITE(j_id,*) '                   PROC number: ', js 
    285259         WRITE(j_id,*) 
    286          WRITE(j_id,FMT="(19x,a20)")cl_run 
     260         WRITE(j_id,FMT="(19x,a20)") cl_run 
    287261 
    288262         ! Print the SUM control indices 
    … …  
    3242989003     FORMAT(a20,i4.4,a17,i4.4) 
    3252999004     FORMAT(a11,i4.4,a26,i4.4,a14) 
    326       ENDDO 
    327  
     300      END DO 
     301      ! 
    328302   END SUBROUTINE prt_ctl_trc_init 
    329303 
    … …  
    358332      !!                    nbondil    : mark for "east-west local boundary" 
    359333      !!                    nbondjl    : mark for "north-south local boundary" 
    360       !! 
    361       !! History : 
    362       !!        !  94-11  (M. Guyon)  Original code 
    363       !!        !  95-04  (J. Escobar, M. Imbard) 
    364       !!        !  98-02  (M. Guyon)  FETI method 
    365       !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    366       !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    367       !!---------------------------------------------------------------------- 
    368       !! * Local variables 
     334      !!---------------------------------------------------------------------- 
    369335      INTEGER ::   ji, jj, js               ! dummy loop indices 
    370       INTEGER ::   & 
    371          ii, ij,                         &  ! temporary integers 
    372          irestil, irestjl,               &  !    "          " 
    373          ijpi  , ijpj, nlcil,            &  ! temporary logical unit 
    374          nlcjl , nbondil, nbondjl,       & 
    375          nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    376  
    377       INTEGER, DIMENSION(:,:), ALLOCATABLE ::   & 
    378          iimpptl, ijmpptl, ilcitl, ilcjtl       ! temporary workspace 
     336      INTEGER ::   ii, ij                   ! temporary integers 
     337      INTEGER ::   irestil, irestjl         !    "          " 
     338      INTEGER ::   ijpi  , ijpj, nlcil      ! temporary logical unit 
     339      INTEGER ::   nlcjl , nbondil, nbondjl 
     340      INTEGER ::   nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    379341      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    380       !!---------------------------------------------------------------------- 
    381  
    382       !  1. Dimension arrays for subdomains 
    383       ! ----------------------------------- 
     342      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! temporary workspace 
     343      !!---------------------------------------------------------------------- 
     344 
     345      ! Dimension arrays for subdomains 
     346      ! ------------------------------- 
    384347      !  Computation of local domain sizes ilcitl() ilcjtl() 
    385348      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 
    … …  
    391354      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
    392355 
    393       ALLOCATE(ilcitl (isplt,jsplt)) 
    394       ALLOCATE(ilcjtl (isplt,jsplt)) 
     356      ALLOCATE( ilcitl (isplt,jsplt) ) 
     357      ALLOCATE( ilcjtl (isplt,jsplt) ) 
    395358 
    396359      nrecil  = 2 * jpreci 
    … …  
    429392      END DO 
    430393 
    431       !  2. Index arrays for subdomains 
    432       ! ------------------------------- 
    433  
    434       ALLOCATE(iimpptl(isplt,jsplt)) 
    435       ALLOCATE(ijmpptl(isplt,jsplt)) 
     394      ! Index arrays for subdomains 
     395      ! --------------------------- 
     396 
     397      ALLOCATE( iimpptl(isplt,jsplt) ) 
     398      ALLOCATE( ijmpptl(isplt,jsplt) ) 
    436399       
    437400      iimpptl(:,:) = 1 
    … …  
    454417      ENDIF 
    455418       
    456       ! 3. Subdomain description 
    457       ! ------------------------ 
     419      ! Subdomain description 
     420      ! --------------------- 
    458421 
    459422      DO js = 1, ijsplt 
    … …  
    492455      END DO 
    493456 
    494       DEALLOCATE(iimpptl) 
    495       DEALLOCATE(ijmpptl) 
    496       DEALLOCATE(ilcitl) 
    497       DEALLOCATE(ilcjtl) 
    498  
     457      DEALLOCATE( iimpptl ) 
     458      DEALLOCATE( ijmpptl ) 
     459      DEALLOCATE( ilcitl ) 
     460      DEALLOCATE( ilcjtl ) 
     461      ! 
    499462   END SUBROUTINE sub_dom 
    500463  
    501464#else 
    502465   !!---------------------------------------------------------------------- 
    503    !!   Dummy module :                      NO passive tracer 
     466   !!   Dummy module :                                    NO passive tracer 
    504467   !!---------------------------------------------------------------------- 
    505468#endif 
    506469     
    507470   !!====================================================================== 
    508  
    509471END MODULE prtctl_trc 

  • branches/dev_001_GM/NEMO/TOP_SRC/trc.F90

    r719 r763  
    44   !! Passive tracers   :  module for tracers defined 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   8.2  !  96-01  (M. Levy)  Original code 
    8    !!        !  99-07  (M. Levy)  for LOBSTER1 or NPZD model 
    9    !!        !  00-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    10    !!   9.0  !  04-03  (C. Ethe)  Free form and module 
     6   !! History :    -   !  1996-01  (M. Levy)  Original code 
     7   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model 
     8   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
     9   !!             1.0  !  2004-03  (C. Ethe)  Free form and module 
    1110   !!---------------------------------------------------------------------- 
    12    !!  TOP 1.0, LOCEAN-IPSL (2005)  
    13    !! $Header$  
    14    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     11   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     12   !! $Id:$  
     13   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1514   !!---------------------------------------------------------------------- 
    16 #if defined key_passivetrc 
     15# if defined key_passivetrc 
    1716   !!---------------------------------------------------------------------- 
    18    !!   'key_passivetrc'   :                               Passive tracer 
    19    !!--------------------------------------------------------------------- 
    20    !! * Modules used 
     17   !!   'key_passivetrc'   :                                Passive tracers 
     18   !!---------------------------------------------------------------------- 
    2119   USE par_oce 
    2220   USE par_trc 
     21    
    2322   IMPLICIT NONE 
    24  
    2523   PUBLIC 
    26  
    2724 
    2825   !! passive tracers names and units (read in namelist) 
    2926   !! -------------------------------------------------- 
    30    CHARACTER(len=12), PUBLIC, DIMENSION(jptra) :: & 
    31       ctrcnm  ,   &   !!: tracer name  
    32       ctrcun          !!: tracer unit 
    33  
    34    CHARACTER(len=80), PUBLIC, DIMENSION(jptra) :: & 
    35       ctrcnl          !!: tracer long name  
     27   CHARACTER(len=12), PUBLIC, DIMENSION(jptra) ::   ctrcnm     !: tracer name  
     28   CHARACTER(len=12), PUBLIC, DIMENSION(jptra) ::   ctrcun     !: tracer unit 
     29   CHARACTER(len=80), PUBLIC, DIMENSION(jptra) ::   ctrcnl     !: tracer long name  
    3630    
    3731    
    3832   !! parameters for the control of passive tracers 
    3933   !! -------------------------------------------------- 
    40    INTEGER, PUBLIC ::  & 
    41       numnat          !!: the number of the passive tracer NAMELIST 
    42     
    43    LOGICAL, PUBLIC, DIMENSION(jptra) ::   & 
    44       lutini          !!:  initialisation from FILE or not (NAMELIST) 
    45  
    46    INTEGER , PUBLIC, DIMENSION(jptra) :: & 
    47       nutini          !!: FORTRAN LOGICAL UNIT for initialisation file 
     34   INTEGER, PUBLIC                   ::   numnat   !: the number of the passive tracer NAMELIST 
     35   LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutini   !:  initialisation from FILE or not (NAMELIST) 
     36   INTEGER, PUBLIC, DIMENSION(jptra) ::   nutini   !: FORTRAN LOGICAL UNIT for initialisation file 
    4837 
    4938   !! passive tracers fields (before,now,after) 
    5039   !! -------------------------------------------------- 
    51    REAL(wp), PUBLIC, SAVE  ::  & 
    52       trai    ,   &   !!: initial total tracer 
    53       areatot         !!: total volume  
     40   REAL(wp), PUBLIC ::   trai       !: initial total tracer 
     41   REAL(wp), PUBLIC ::   areatot    !: total volume  
    5442 
    55    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: & 
    56       trn     ,   &   !!: traceur concentration for actual time step 
    57       tra     ,   &   !!: traceur concentration for next time step 
    58       trb             !!: traceur concentration for before time step 
     43   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trn   !: traceur concentration for actual time step 
     44   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   tra   !: traceur concentration for next time step 
     45   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trb   !: traceur concentration for before time step 
    5946 
    6047 
    6148   !! numerical parameter (NAMELIST) 
    6249   !! -------------------------------------------------- 
    63    REAL(wp), PUBLIC  ::  & 
    64       rsc     ,   &   !!: tuning coefficient for anti-diffusion 
    65       rtrn            !!: value for truncation 
     50   REAL(wp), PUBLIC ::   rsc    !: tuning coefficient for anti-diffusion 
     51   REAL(wp), PUBLIC ::   rtrn   !: value for truncation 
    6652 
    6753   !! namelist parameters 
    6854   !! -------------------------------------------------- 
    69    INTEGER , PUBLIC  ::  &  
    70       ncortrc ,   &   !!: number of corrective phases 
    71       ndttrc  ,   &   !!: frequency of step on passive tracers 
    72       nittrc000       !!: first time step of passive tracers model   
    73  
    74    LOGICAL, PUBLIC  ::  &  
    75       crosster        !!: logical if true computes crossterms 
     55   INTEGER , PUBLIC ::   ncortrc     !: number of corrective phases 
     56   INTEGER , PUBLIC ::   ndttrc      !: frequency of step on passive tracers 
     57   INTEGER , PUBLIC ::   nittrc000   !: first time step of passive tracers model   
     58   LOGICAL , PUBLIC ::   crosster    !: logical if true computes crossterms 
    7659 
    7760 
    7861   !! isopycnal scheme for passive tracers 
    79    !! --------------------------------------------------   
    80    REAL(wp), PUBLIC  ::  & 
    81       ahtrb0  ,   &   !!: background diffusivity coefficient for passive tracer (m2/s) 
    82       trcrat  ,   &   !!: ratio between passive and active tracer coeff for diffusion 
    83       ahtrc0  ,   &   !!: horizontal eddy diffusivity for passive tracers (m2/s) 
    84       aeivtr0         !!: eddy induced velocity coefficient (m2/s) 
     62   !! ------------------------------------   
     63   REAL(wp), PUBLIC ::   ahtrb0     !: background diffusivity coefficient for passive tracer (m2/s) 
     64   REAL(wp), PUBLIC ::   trcrat     !: ratio between passive and active tracer coeff for diffusion 
     65   REAL(wp), PUBLIC ::   ahtrc0     !: horizontal eddy diffusivity for passive tracers (m2/s) 
     66   REAL(wp), PUBLIC ::   aeivtr0    !: eddy induced velocity coefficient (m2/s) 
    8567    
    8668    
    8769   !! passive tracers restart (input and output) 
    88    !! --------------------------------------------------   
    89    LOGICAL, PUBLIC  ::  & 
    90       lrsttr          !!: boolean term for restart i/o for passive tracers (namelist) 
    91     
    92    INTEGER , PUBLIC  ::  & 
    93       nutwrs  ,   &   !!: output FILE for passive tracers restart 
    94       nutrst  ,   &   !!: logical unit for restart FILE for passive tracers 
    95       nrsttr          !!: control of the time step ( 0 or 1 ) for pass. tr. 
     70   !! ------------------------------------------   
     71   LOGICAL , PUBLIC ::   lrsttr     !: boolean term for restart i/o for passive tracers (namelist) 
     72   INTEGER , PUBLIC ::   nutwrs     !: output FILE for passive tracers restart 
     73   INTEGER , PUBLIC ::   nutrst     !: logical unit for restart FILE for passive tracers 
     74   INTEGER , PUBLIC ::   nrsttr     !: control of the time step ( 0 or 1 ) for pass. tr. 
    9675    
    9776    
    9877   !! interpolated gradient 
    9978   !!--------------------------------------------------   
    100    REAL (wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: & 
    101       gtru    ,   &   !!: horizontal gradient at u-points at bottom ocean level 
    102       gtrv            !!: horizontal gradient at v-points at bottom ocean level 
     79   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtru   !: horizontal gradient at u-points at bottom ocean level 
     80   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtrv   !: horizontal gradient at v-points at bottom ocean level 
    10381 
    10482    
    105 #if defined key_trcldf_eiv && defined key_diaeiv 
     83# if defined key_trcldf_eiv && defined key_diaeiv 
    10684   !! The three component of the eddy induced velocity 
    10785   !! -------------------------------------------------- 
    108    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: & 
    109       u_trc_eiv,  &   !!: u-eiv (m/s) 
    110       v_trc_eiv,  &   !!: v-eiv (m/s) 
    111       w_trc_eiv       !!: w-eiv (m/s) 
    112 #endif 
     86   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) ::   u_trc_eiv   !: u-eiv (m/s) 
     87   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) ::   v_trc_eiv   !: v-eiv (m/s) 
     88   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) ::   w_trc_eiv   !: w-eiv (m/s) 
     89# endif 
    11390    
    11491    
    11592   !! information for outputs 
    11693   !! -------------------------------------------------- 
    117    INTEGER , PUBLIC   ::  &  
    118       nwritetrc       !!: time step frequency for concentration outputs (namelist) 
     94   INTEGER , PUBLIC ::   nwritetrc   !: time step frequency for concentration outputs (namelist) 
    11995    
    120 #if defined key_trc_diaadd 
     96# if defined key_trc_diaadd 
    12197   !! additional 2D/3D outputs namelist 
    12298   !! -------------------------------------------------- 
    123    CHARACTER(len=8), PUBLIC, DIMENSION (jpdia2d) ::  &  
    124       ctrc2d  ,   &   !!: 2d output field name 
    125       ctrc2u          !!: 2d output field unit 
     99   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d   !: 2d output field name 
     100   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u   !: 2d output field unit    
     101   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d   !: 3d output field name 
     102   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u   !: 3d output field unit 
     103   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l   !: 2d output field long name 
     104   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l   !: 3d output field long name 
    126105    
    127    CHARACTER(len=8), PUBLIC, DIMENSION (jpdia3d) ::  &  
    128       ctrc3d ,    &   !!: 3d output field name 
    129       ctrc3u          !!: 3d output field unit 
    130     
    131    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::  &  
    132       ctrc2l          !!: 2d output field long name 
    133     
    134    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::  &  
    135       ctrc3l          !!: 3d output field long name 
    136     
    137    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpdia2d) ::  &   
    138       trc2d           !!:  additional 2d outputs   
    139     
    140    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::  &   
    141       trc3d           !!:  additional 3d outputs   
     106   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d   !:  additional 2d outputs   
     107   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d   !:  additional 3d outputs   
    142108    
    143109    
    144110   !! netcdf files and index common 
    145111   !! -------------------------------------------------- 
    146    INTEGER , PUBLIC :: & 
    147       nwriteadd     !!: frequency of additional arrays outputs(namelist) 
    148 #endif 
     112   INTEGER , PUBLIC ::   nwriteadd     !: frequency of additional arrays outputs(namelist) 
     113# endif 
    149114    
    150 #if defined key_trc_diatrd 
     115# if defined key_trc_diatrd 
    151116    
    152117   !!  non conservative trends (biological, ...) 
    153118   !! -------------------------------------------------- 
    154    LOGICAL, PUBLIC, DIMENSION (jptra)  ::  &   
    155       luttrd          !!: large trends diagnostic to write or not (namelist) 
     119   LOGICAL, PUBLIC, DIMENSION (jptra) ::   luttrd   !: large trends diagnostic to write or not (namelist) 
    156120    
    157    !!  dynamical trends 
    158    !! trtrd()   : trends of the tracer equations 
    159    !!           1 : X advection 
    160    !!           2 : Y advection 
    161    !!           3 : Z advection 
    162    !!           4 : X diffusion 
    163    !!           5 : Y diffusion 
    164    !!           6 : Z diffusion 
    165    !!           7 : X gent velocity 
    166    !!           8 : Y gent velocity 
    167    !!           9 : Z gent velocity 
     121   !!  Advection-diffusion trends 
    168122   !! -------------------------------------------------- 
     123   REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE ::   trtrd   !: trends of the tracer equations 
    169124    
    170     
    171    REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: & 
    172       trtrd           !!: trends of the tracer equations 
    173     
    174    INTEGER, PUBLIC, DIMENSION(jptra), SAVE :: ikeep ! indice of tracer for which dyn trends are stored 
    175    INTEGER, PUBLIC, SAVE                   :: nkeep ! number of tracers for which dyn trends are stored  
    176                                                     ! (used to allocate trtrd buffer) 
     125   INTEGER, PUBLIC, DIMENSION(jptra) :: ikeep ! indice of tracer for which dyn trends are stored 
     126   INTEGER, PUBLIC                   :: nkeep ! number of tracers for which dyn trends are stored  
     127   !                                          ! (used to allocate trtrd buffer) 
    177128 
    178129   !! netcdf files and index common 
    179130   !! -------------------------------------------------- 
    180    INTEGER , PUBLIC :: & 
    181       nwritetrd       !!: frequency of additional arrays outputs(namelist) 
     131   INTEGER , PUBLIC ::   nwritetrd   !: frequency of additional arrays outputs(namelist) 
    182132    
    183 #endif  
     133# endif  
    184134    
    185135   !! passive tracers data read and at given time_step 
    186136   !! -------------------------------------------------- 
    187 #if defined key_dtatrc 
    188     
    189    INTEGER , PUBLIC, DIMENSION(jptra) :: & 
    190       numtr          !!: logical unit for passive tracers data 
    191     
    192 #endif 
     137# if defined key_dtatrc 
     138   INTEGER , PUBLIC, DIMENSION(jptra) ::   numtr   !: logical unit for passive tracers data 
     139# endif 
    193140 
    194141  !!  1D configuration 
    195142  !! -------------------------------------------------- 
    196 #if defined key_cfg_1d 
     143# if defined key_cfg_1d 
    197144      LOGICAL, PARAMETER ::   lk_trccfg_1d   = .TRUE.   !: 1D pass. tracer configuration flag 
    198 #else    
     145# else    
    199146      LOGICAL, PARAMETER ::   lk_trccfg_1d   = .FALSE.  !: 1D pass. tracer configuration flag 
     147# endif 
     148 
     149#else 
     150   !!---------------------------------------------------------------------- 
     151   !!  Empty module :                                     No passive tracer 
     152   !!---------------------------------------------------------------------- 
    200153#endif 
    201154 
    202  
    203 #else 
    204155   !!====================================================================== 
    205    !!  Empty module : No passive tracer  
    206    !!====================================================================== 
    207 #endif 
    208  
    209156END MODULE trc 

  • branches/dev_001_GM/NEMO/TOP_SRC/trcctl.F90

    r719 r763  
    11MODULE trcctl 
    2    !!========================================================================== 
    3    !! 
    4    !!                       *** MODULE trcctl *** 
    5    !! 
    6    !! Only for passive tracer 
    7    !! control the cpp options for the run and IF files are availables 
    8    !! control also consistancy between options and namelist values 
    9    !!  O.Aumont and A.El Moussaoui 03/05 F90  
    10    !!========================================================================= 
    11    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    12    !! $Header$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     2   !!====================================================================== 
     3   !!                         ***  MODULE trcctl  *** 
     4   !! TOP :   control the cpp options, files and namelist values of a run 
     5   !!====================================================================== 
     6   !! History :   1.0  !  2005-03 (O. Aumont, A. El Moussaoui) original code 
    147   !!---------------------------------------------------------------------- 
    158#if defined key_passivetrc 
    169   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    18    !! ============== 
     10   !!   'key_passivetrc'                                    Passive tracers 
     11   !!---------------------------------------------------------------------- 
     12   !!   trc_ctl    : control the cpp options, files and namelist values 
     13   !!---------------------------------------------------------------------- 
    1914   USE oce_trc 
    2015   USE trc 
    … …  
    2520   PRIVATE 
    2621 
    27    !! * Accessibility 
    28    PUBLIC trc_ctl 
     22   PUBLIC trc_ctl      ! called by ??? 
     23 
     24   !!---------------------------------------------------------------------- 
     25   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     26   !! $Header:$  
     27   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     28   !!---------------------------------------------------------------------- 
    2929 
    3030CONTAINS 
    3131 
    3232   SUBROUTINE trc_ctl 
    33       !!=========================================================================================== 
     33      !!---------------------------------------------------------------------- 
     34      !!                     ***  ROUTINE trc_ctl  *** 
    3435      !! 
    35       !! 
    36       !!                       ROUTINE trcctl 
    37       !!                     ****************** 
    38       !! 
    39       !!      we use IF/ENDIF inside #IF defined option-cpp 
    40       !!      FILE name must not exceed 21 characters 
    41       !!       
    42       !!=========================================================================================== 
    43        
     36      !! ** Purpose :   control the cpp options, namelist and files  
     37      !!              we use IF/ENDIF inside #IF defined option-cpp 
     38      !!              FILE name must not exceed 21 characters 
    4439      !!---------------------------------------------------------------------- 
    45       !! local declarations 
    46       !! ================== 
    47       INTEGER  :: istop, jn 
    48        
    49       !!--------------------------------------------------------------------- 
    50       !!  OPA.9    03/2005   
    51       !!--------------------------------------------------------------------- 
     40      INTEGER ::   istop, jn 
     41      !!---------------------------------------------------------------------- 
    5242 
    53       ! 0. Parameter 
    54       ! ------------ 
    55       istop = 0 
     43      IF(lwp) WRITE(numout,*) 
     44      IF(lwp) WRITE(numout,*) ' trc_ctl :   passive tracer option' 
     45      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    5646 
    57       ! 1. restart for passive tracer (input) 
    58       ! ----------------------------- 
     47      istop = 0      ! initialise to zero 
    5948 
    60       IF(lwp) WRITE(numout,*) ' ' 
    61       IF(lwp) WRITE(numout,*) ' *** PASSIVE TRACER MODEL OPTIONS' 
    62       IF(lwp) WRITE(numout,*) ' *** CONTROL' 
    63       IF(lwp) WRITE(numout,*) ' ' 
    64  
    65       IF(lwp) WRITE(numout,*) ' ' 
    66       IF(lwp) WRITE(numout,*) ' *** restart option for passive tracer' 
    67       IF(lwp) WRITE(numout,*) ' ' 
    68  
    69       IF(lrsttr) THEN 
    70          IF(lwp) WRITE(numout,*) ' READ a restart FILE for passive tracer' 
     49      ! restart for passive tracer (input) 
     50      IF( lrsttr ) THEN 
     51         IF(lwp) WRITE(numout,*) '       READ a restart FILE for passive tracer' 
    7152         IF(lwp) WRITE(numout,*) ' ' 
    7253      ELSE 
    73          IF(lwp) WRITE(numout,*) ' no restart FILE' 
    74          IF(lwp) WRITE(numout,*) ' ' 
    75  
    76          ! 2. OPEN FILES for initial tracer value 
    77          ! -------------------------------------- 
    78          DO jn=1,jptra 
    79  
    80             ! OPEN input FILE only IF lutini(jn) is true 
    81             ! ------------------------------------------ 
    82             IF (lutini(jn)) THEN   
    83  
    84                ! prepare input FILE name a 
    85                ! -------------------------                         
     54         IF(lwp) WRITE(numout,*) '       no restart FILE' 
     55         IF(lwp) WRITE(numout,*) 
     56         DO jn = 1, jptra 
     57            IF( lutini(jn) ) THEN      ! OPEN input FILE only IF lutini(jn) is true 
    8658               IF(lwp) WRITE(numout,*)  & 
    87                   ' READ an initial FILE  for passive tracer number :',jn        & 
    88                   ,' traceur : ',ctrcnm(jn)  
    89                IF(lwp) WRITE(numout,*) ' ' 
     59                  '       READ an initial FILE  for passive tracer number :', jn, ' traceur : ', ctrcnm(jn)  
    9060            END IF 
    9161         END DO 
    9262      ENDIF 
    9363 
    94       ! 3. Don't USE non penetrative convective mixing option 
    95       !     it's not implemented for passive tracer 
    96       ! ----------------------------------------------------- 
    97  
    98       IF( ln_zdfnpc) THEN 
     64      ! Don't USE non penetrative convective mixing option 
     65      ! it's not implemented for passive tracer 
     66      IF( ln_zdfnpc ) THEN 
    9967         IF(lwp) WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    10068         IF(lwp) WRITE (numout,*) ' =======   ============= ' 
    … …  
    10573      ENDIF 
    10674 
    107       ! 4. transport scheme option 
    108       ! -------------------------- 
    109  
    110       IF(lwp) WRITE(numout,*) '  ' 
     75      ! transport scheme option 
    11176      CALL trc_trp_ctl 
    11277 
    113  
    114       ! 5. SMS model 
    115       ! --------------------------------------------- 
    116  
     78      ! SMS model 
    11779      IF(lwp) WRITE(numout,*) '  ' 
    118       IF(lwp) WRITE(numout,*) ' *** Source/Sink model option' 
     80      IF(lwp) WRITE(numout,*) '       Source/Sink model option' 
    11981      IF(lwp) WRITE(numout,*) '  ' 
    12082 
    121  
    122 #if defined key_trc_lobster1 
     83# if defined key_trc_lobster1 
    12384#   include "trcctl.lobster1.h90" 
    124 #elif defined key_trc_pisces 
     85# elif defined key_trc_pisces 
    12586#   include "trcctl.pisces.h90" 
    126 #elif defined key_cfc 
     87# elif defined key_cfc 
    12788#   include "trcctl.cfc.h90" 
    128 #else 
    129  
    130       IF(lwp) WRITE (numout,*) ' No Source/Sink model ' 
    131       IF(lwp) WRITE (numout,*) ' ' 
     89# else 
     90      IF(lwp) WRITE (numout,*) '       No Source/Sink ' 
     91      IF(lwp) WRITE (numout,*) 
    13292#endif 
    13393 
    13494      ! E r r o r  control 
    13595      ! ------------------ 
    136  
    137       IF ( istop > 0  ) THEN 
     96      IF( istop > 0  ) THEN 
    13897         IF(lwp)WRITE(numout,*) 
    13998         IF(lwp)WRITE(numout,*) istop,' E R R O R found : we stop' 
    140          IF(lwp)WRITE(numout,*) '**************************' 
     99         IF(lwp)WRITE(numout,*) '  **************************' 
    141100         IF(lwp)WRITE(numout,*) 
    142101         STOP 'trcctl' 
    143102      ENDIF 
    144  
     103      ! 
    145104   END SUBROUTINE trc_ctl 
    146105 
    147106#else 
    148    !!====================================================================== 
    149    !!  Empty module : No passive tracer 
    150    !!====================================================================== 
     107   !!---------------------------------------------------------------------- 
     108   !!  Empty module :                                     No passive tracer 
     109   !!---------------------------------------------------------------------- 
    151110CONTAINS 
    152    SUBROUTINE trc_ctl 
    153  
     111   SUBROUTINE trc_ctl                      ! Dummy routine 
    154112   END SUBROUTINE trc_ctl 
    155     
    156113#endif 
    157114 
     115   !!====================================================================== 
    158116END MODULE trcctl 

  • branches/dev_001_GM/NEMO/TOP_SRC/trcdia.F90

    r719 r763  
    11MODULE trcdia 
    2    !!========================================================================== 
    3    !! 
     2   !!====================================================================== 
    43   !!                       *** MODULE trcdia *** 
    5    !! Output  for tracer concentration   
    6    !! O.Aumont and A.El Moussaoui 03/05 F90  
    7    !!========================================================================== 
    8    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    9    !! $Header$  
    10    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     4   !! TOP :   Output of passive tracers 
     5   !!====================================================================== 
     6   !! History :   1.0  !  2005-03 (O. Aumont, A. El Moussaoui) original code 
    117   !!---------------------------------------------------------------------- 
    128#if defined key_passivetrc 
    139   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    15   
     10   !!   'key_passivetrc'                                    Passive tracers 
     11   !!---------------------------------------------------------------------- 
     12   !!   trc_dia    :  output passive tracer fields 
     13   !!---------------------------------------------------------------------- 
    1614   USE trcdit 
    1715 
    … …  
    1917   PRIVATE 
    2018 
    21    !! * Accessibility 
    22    PUBLIC trc_dia 
     19   PUBLIC trc_dia      ! called by ??? 
    2320 
    24    !! * Module variables 
     21   !!---------------------------------------------------------------------- 
     22   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     23   !! $Header:$  
     24   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     25   !!---------------------------------------------------------------------- 
    2526 
    2627CONTAINS 
    2728 
    28    SUBROUTINE trc_dia(kt,kindic)   
    29       !!=========================================================================================== 
     29   SUBROUTINE trc_dia( kt, kindic )   
     30      !!--------------------------------------------------------------------- 
     31      !!                     ***  ROUTINE trc_dia  *** 
    3032      !! 
    31       !!                       ROUTINE trcdii_wr 
    32       !!=========================================================================================== 
     33      !! ** Purpose :   output passive tracers fields  
     34      !!--------------------------------------------------------------------- 
     35      INTEGER, INTENT( in ) :: kt, kindic 
     36      !!--------------------------------------------------------------------- 
     37       
     38      CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration 
    3339 
    34       INTEGER, INTENT( in ) :: kt, kindic 
     40# if defined key_trc_diatrd 
     41      CALL trcdid_wr( kt, kindic )      ! outputs for dynamical trends 
     42# endif 
    3543 
    36       ! outputs for tracer concentration 
    37       ! --------------------------------  
     44# if defined key_trc_diaadd 
     45      CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays 
     46# endif 
    3847 
    39       CALL trcdit_wr(kt,kindic) 
    40  
    41 #if defined key_trc_diatrd 
    42  
    43       ! outputs for dynamical trends 
    44       ! ---------------------------- 
    45  
    46       CALL trcdid_wr(kt,kindic) 
    47  
    48 #endif 
    49 #if defined key_trc_diaadd 
    50  
    51       ! outputs for additional arrays 
    52       ! ----------------------------- 
    53  
    54       CALL trcdii_wr(kt,kindic) 
    55  
    56 #endif 
    57 #if defined key_trc_diabio 
    58  
    59       ! outputs for biological trends 
    60       ! ----------------------------- 
    61  
    62       CALL trcdib_wr(kt,kindic) 
    63  
    64 #endif 
    65  
     48# if defined key_trc_diabio 
     49      CALL trcdib_wr( kt, kindic )      ! outputs for biological trends 
     50# endif 
     51      ! 
    6652   END SUBROUTINE trc_dia 
    6753 
    6854#else 
    69    !!====================================================================== 
    70    !!  Empty module : No passive tracer 
    71    !!====================================================================== 
     55   !!---------------------------------------------------------------------- 
     56   !!  Dummy module :                                    No passive tracer 
     57   !!---------------------------------------------------------------------- 
    7258CONTAINS 
    73    SUBROUTINE trc_dia 
    74        
     59   SUBROUTINE trc_dia                      ! Empty routine    
    7560   END SUBROUTINE trc_dia    
    7661#endif 
    7762 
     63   !!====================================================================== 
    7864END MODULE trcdia 

  • branches/dev_001_GM/NEMO/TOP_SRC/trcdit.F90

    r724 r763  
    11MODULE trcdit 
     2   !!====================================================================== 
     3   !!                       *** MODULE trcdit *** 
     4   !! TOP :   Output of passive tracers 
     5   !! O.Aumont and A.El Moussaoui 03/05 F90  
     6   !!====================================================================== 
     7   !! History :    -   !  1995-01 (M. Levy)  Original code 
     8   !!              -   !  1998-01 (C. Levy) NETCDF format using ioipsl interface 
     9   !!              -   !  1999-01 (M.A. Foujols) adapted for passive tracer 
     10   !!              -   !  1999-09 (M.A. Foujols) split into three parts 
     11   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
    212   !!---------------------------------------------------------------------- 
    3    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    4    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/trcdit.F90,v 1.9 2007/10/12 09:22:19 opalod Exp $  
    5    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     13#if defined key_passivetrc 
    614   !!---------------------------------------------------------------------- 
    7    !! * Modules used 
    8    !! ============== 
     15   !!   'key_passivetrc'                                    Passive tracers 
     16   !!---------------------------------------------------------------------- 
     17   !! trcdit_wr   : 
     18   !! trcdid_wr   : 
     19   !! trcdii_wr   : 
     20   !! trcdib_wr   :  
     21   !!---------------------------------------------------------------------- 
    922   USE oce_trc 
    1023   USE trc 
    … …  
    1225   USE in_out_manager  ! I/O manager 
    1326   USE lib_mpp 
     27   USE ioipsl 
    1428 
    1529   IMPLICIT NONE 
    1630   PRIVATE 
    1731 
    18    !! * Accessibility 
    19    PUBLIC trcdit_wr 
    20    PUBLIC trcdid_wr 
    21    PUBLIC trcdii_wr 
    22    PUBLIC trcdib_wr 
    23  
    24    !! * Module variables 
    25    INTEGER            ::  & 
    26       nit5     ,  &   !!: id for tracer output file 
    27       ndepit5  ,  &   !!: id for depth mesh 
    28       nhorit5  ,  &   !!: id for horizontal mesh 
    29       ndimt50  ,  &   !!: number of ocean points in index array 
    30       ndimt51         !!: number of ocean points in index array 
    31    REAL(wp) :: zjulian 
    32    INTEGER , DIMENSION (jpij*jpk) ::  ndext50 !!: integer arrays for ocean 3D index 
    33    INTEGER , DIMENSION (jpij)     ::  ndext51 !!: integer arrays for ocean surface index 
    34 #    if defined key_passivetrc && defined key_trc_diaadd 
    35    INTEGER            :: & 
    36       nitd     ,  &   !!: id for additional array output file 
    37       ndepitd  ,  &   !!: id for depth mesh 
    38       nhoritd         !!: id for horizontal mesh 
    39 #    endif 
    40 #    if defined key_passivetrc && defined key_trc_diatrd 
    41    INTEGER , DIMENSION (jptra)  :: & 
    42       nit6    ,   &   !!: id for additional array output file 
    43       ndepit6 ,   &   !!: id for depth mesh 
    44       nhorit6         !!: id for horizontal mesh 
    45 #    endif 
    46 #    if defined key_passivetrc && defined key_trc_diabio 
    47    INTEGER            :: & 
    48       nitb     ,   &  !!:  id for additional array output FILE 
    49       ndepitb  ,   &  !!:  id for depth mesh 
    50       nhoritb         !!:  id for horizontal mesh 
    51  
    52 #    endif 
    53  
     32   PUBLIC trcdit_wr      ! caller in trcdia.F90 
     33   PUBLIC trcdid_wr      ! caller in trcdia.F90 
     34   PUBLIC trcdii_wr      ! caller in trcdia.F90 
     35   PUBLIC trcdib_wr      ! caller in trcdia.F90 
     36 
     37   INTEGER  ::   nit5      !: id for tracer output file 
     38   INTEGER  ::   ndepit5   !: id for depth mesh 
     39   INTEGER  ::   nhorit5   !: id for horizontal mesh 
     40   INTEGER  ::   ndimt50   !: number of ocean points in index array 
     41   INTEGER  ::   ndimt51   !: number of ocean points in index array 
     42   REAL(wp) ::   zjulian   !: ????   not DOCTOR ! 
     43   INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index 
     44   INTEGER , DIMENSION (jpij)     ::   ndext51   !: integer arrays for ocean surface index 
     45# if defined key_trc_diaadd 
     46   INTEGER  ::   nitd      !: id for additional array output file 
     47   INTEGER  ::   ndepitd   !: id for depth mesh 
     48   INTEGER  ::   nhoritd   !: id for horizontal mesh 
     49# endif 
     50# if defined key_trc_diatrd 
     51   INTEGER , DIMENSION (jptra) ::   nit6      !: id for additional array output file 
     52   INTEGER , DIMENSION (jptra) ::   ndepit6   !: id for depth mesh 
     53   INTEGER , DIMENSION (jptra) ::   nhorit6   !: id for horizontal mesh 
     54# endif 
     55# if defined key_trc_diabio 
     56   INTEGER  ::   ndepitb   !:  id for depth mesh 
     57   INTEGER  ::   nhoritb   !:  id for horizontal mesh 
     58# endif 
    5459 
    5560   !! * Substitutions 
    5661#  include "passivetrc_substitute.h90" 
     62   !!---------------------------------------------------------------------- 
     63   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     64   !! $Header:$  
     65   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     66   !!---------------------------------------------------------------------- 
    5767 
    5868CONTAINS 
    5969 
    60 #    if defined key_passivetrc 
    61  
    62       SUBROUTINE trcdit_wr(kt,kindic) 
    63    !!=========================================================================================== 
    64    !! 
    65    !!                       ROUTINE trcdit_wr 
    66    !!=========================================================================================== 
    67    !! 
    68    !! Purpose : 
    69    !!--------- 
    70    !!          Standard output of passive tracer : concentration fields 
    71    !! 
    72    !! 
    73    !! Method : 
    74    !! ------- 
    75    !! 
    76    !!        At the beginning of the first time step (nit000), define all 
    77    !!        the NETCDF files and fields for concentration of passive tracer 
    78    !! 
    79    !!        At each time step call histdef to compute the mean if necessary 
    80    !!        Each nwritetrc time step, output the instantaneous or mean fields 
    81    !! 
    82    !!        IF kindic <0, output of fields before the model interruption. 
    83    !!        IF kindic =0, time step loop 
    84    !!        IF kindic >0, output of fields before the time step loop 
    85    !! 
    86    !! Input : 
    87    !! ----- 
    88    !!   argument 
    89    !!           kt              : time step 
    90    !!           kindic          : indicator of abnormal termination 
    91    !! 
    92    !! EXTERNAL : 
    93    !! -------- 
    94    !! prihre, hist..., dianam 
    95    !! 
    96    !! History: 
    97    !! -------- 
    98    !!   original  : 95-01  passive tracers  (M. Levy) 
    99    !!   additions : 98-01 (C. Levy) NETCDF format using ioipsl interface 
    100    !!   additions : 99-01 (M.A. Foujols) adapted for passive tracer 
    101    !!   additions : 99-09 (M.A. Foujols) split into three parts 
    102    !!   05-03 (O. Aumont and A. El Moussaoui) F90 
    103    !!==================================================================================================! 
    104  
    105       !! Modules used 
    106       USE ioipsl 
    107  
    108  
    109       !! * Arguments 
    110       INTEGER, INTENT( in ) ::   kt,kindic         ! ocean time-step 
    111  
    112       !! * Local declarations 
    113       INTEGER :: jn 
    114       LOGICAL :: ll_print = .FALSE. 
    115  
     70      SUBROUTINE trcdit_wr( kt, kindic ) 
     71      !!---------------------------------------------------------------------- 
     72      !!                     ***  ROUTINE trcdit_wr  *** 
     73      !! 
     74      !! ** Purpose :   Standard output of passive tracer : concentration fields 
     75      !! 
     76      !! ** Method  :   At the beginning of the first time step (nit000), define all 
     77      !!             the NETCDF files and fields for concentration of passive tracer 
     78      !! 
     79      !!        At each time step call histdef to compute the mean if necessary 
     80      !!        Each nwritetrc time step, output the instantaneous or mean fields 
     81      !! 
     82      !!        IF kindic <0, output of fields before the model interruption. 
     83      !!        IF kindic =0, time step loop 
     84      !!        IF kindic >0, output of fields before the time step loop 
     85      !!---------------------------------------------------------------------- 
     86      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
     87      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
     88      !! 
     89      INTEGER ::   jn 
     90      LOGICAL ::   ll_print = .FALSE. 
    11691      CHARACTER (len=40) :: clhstnam, clop 
    11792      CHARACTER (len=20) :: cltra, cltrau 
    11893      CHARACTER (len=80) :: cltral 
    119  
    12094      REAL(wp) :: zsto, zout, zdt 
    12195      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it 
    122 ! 
    123 ! 0. Initialisation 
    124 ! ----------------- 
    125  
    126 ! local variable for debugging 
    127       ll_print = .FALSE. 
     96      !!---------------------------------------------------------------------- 
     97 
     98      ! Initialisation 
     99      ! -------------- 
     100 
     101      ! local variable for debugging 
     102      ll_print = .FALSE.                  ! change it to true for more control print 
    128103      ll_print = ll_print .AND. lwp 
    129104 
    130 ! Define frequency of output and means 
    131  
     105      ! Define frequency of output and means 
    132106      zdt = rdt 
    133 #        if defined key_diainstant 
    134       zsto=nwritetrc*rdt 
    135       clop='inst(only(x))' 
    136 #        else 
    137       zsto=zdt 
    138       clop='ave(only(x))' 
    139 #        endif 
    140       zout=nwritetrc*zdt 
     107# if defined key_diainstant 
     108      zsto = nwritetrc * rdt 
     109      clop = 'inst(only(x))' 
     110# else 
     111      zsto = zdt 
     112      clop = 'ave(only(x))' 
     113# endif 
     114      zout = nwritetrc * zdt 
    141115 
    142116      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    148122      it = kt - nittrc000 + 1 
    149123 
    150 ! 1. Define NETCDF files and fields at beginning of first time step 
    151 ! ----------------------------------------------------------------- 
     124      ! Define NETCDF files and fields at beginning of first time step 
     125      ! -------------------------------------------------------------- 
    152126 
    153127      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 
    154       IF(kt == nittrc000) THEN 
    155  
    156 ! Compute julian date from starting date of the run 
    157  
    158          CALL ymds2ju(nyear,nmonth,nday,0.0,zjulian) 
     128       
     129      IF( kt == nittrc000 ) THEN 
     130 
     131         ! Compute julian date from starting date of the run 
     132         CALL ymds2ju( nyear, nmonth, nday, 0.0, zjulian ) 
    159133         IF(lwp)WRITE(numout,*)' '   
    160          IF(lwp)WRITE(numout,*)' Date 0 used :',nittrc000     & 
    161        &     ,' YEAR ',nyear,' MONTH ',nmonth,' DAY ',nday   & 
    162        &     ,'Julian day : ',zjulian     
    163          IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  & 
    164                                  ' limit storage in depth = ', ipk 
     134         IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         & 
     135            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   & 
     136            &                 ,'Julian day : ', zjulian     
     137         IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  & 
     138            &                    ' limit storage in depth = ', ipk 
    165139 
    166140 
    167141! Define the NETCDF files for passive tracer concentration 
    168142 
    169          CALL dia_nam(clhstnam,nwritetrc,'ptrc_T') 
    170  
     143         CALL dia_nam( clhstnam, nwritetrc, 'ptrc_T' ) 
    171144         IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam 
    172145! Horizontal grid : glamt and gphit 
    173   
    174          CALL histbeg(clhstnam, jpi, glamt, jpj, gphit,     & 
    175          &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
    176          &    0, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
     146         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     & 
     147            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
     148            &          0, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
    177149! Vertical grid for tracer : gdept 
    178          CALL histvert(nit5, 'deptht', 'Vertical T levels', & 
    179          &    'm', ipk, gdept_0, ndepit5) 
     150         CALL histvert( nit5, 'deptht', 'Vertical T levels', & 
     151            &            'm', ipk, gdept_0, ndepit5) 
    180152 
    181153! Index of ocean points in 3D and 2D (surface) 
    182          CALL wheneq(jpi*jpj*ipk,tmask,1,1.,ndext50,ndimt50) 
    183          CALL wheneq(jpi*jpj,tmask,1,1.,ndext51,ndimt51) 
     154         CALL wheneq( jpi*jpj*ipk,tmask,1,1.,ndext50,ndimt50 ) 
     155         CALL wheneq( jpi*jpj,tmask,1,1.,ndext51,ndimt51 ) 
    184156 
    185157! Declare all the output fields as NETCDF variables 
    186158 
    187159! tracer concentrations 
    188  
    189          DO jn=1,jptra 
    190            cltra=ctrcnm(jn)    ! short title for tracer 
    191            cltral=ctrcnl(jn)   ! long title for tracer 
    192            cltrau=ctrcun(jn)   ! UNIT for tracer 
    193            CALL histdef(nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  & 
    194          &          ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout)  
     160         DO jn = 1, jptra 
     161           cltra  = ctrcnm(jn)   ! short title for tracer 
     162           cltral = ctrcnl(jn)   ! long title for tracer 
     163           cltrau = ctrcun(jn)   ! UNIT for tracer 
     164           CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  & 
     165         &               ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout)  
    195166         END DO            
    196167 
    197 ! CLOSE netcdf Files 
    198            
    199          CALL histend(nit5) 
    200  
     168         ! end netcdf files header 
     169         CALL histend( nit5 ) 
    201170         IF(lwp) WRITE(numout,*) 
    202171         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr' 
    203          IF(ll_print) CALL FLUSH(numout ) 
    204  
    205       ENDIF 
    206  
    207 ! 2. Start writing data 
    208 ! --------------------- 
    209  
    210 ! tracer concentrations 
     172         IF( ll_print )   CALL FLUSH(numout ) 
     173 
     174      ENDIF 
     175 
     176      ! Start writing the tracer concentrations 
     177      ! --------------------------------------- 
    211178 
    212179      IF( lwp .AND. MOD( kt, nwritetrc ) == 0 ) THEN 
    213180         WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step' 
    214          WRITE(numout,*) '~~~~~~ ' 
    215       ENDIF 
    216  
    217       DO jn=1,jptra 
    218          cltra=ctrcnm(jn) ! short title for tracer 
    219          CALL histwrite(nit5, cltra, it, trn(:,:,:,jn), ndimt50,   & 
    220       &          ndext50) 
     181         WRITE(numout,*) '~~~~~~~~~ ' 
     182      ENDIF 
     183 
     184      DO jn = 1, jptra 
     185         cltra = ctrcnm(jn)      ! short title for tracer 
     186         CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 
    221187      END DO  
    222188 
    223 ! synchronise FILE 
    224  
    225       IF( MOD( kt, nwritetrc ) == 0 .OR. kindic < 0 ) THEN 
    226               CALL histsync(nit5) 
    227       ENDIF 
    228  
    229 ! 3. Closing all files 
    230 ! -------------------- 
    231       IF( kt == nitend .OR. kindic < 0 ) THEN 
    232           CALL histclo(nit5) 
    233       ENDIF 
    234  
    235 END SUBROUTINE trcdit_wr 
    236  
    237 #    else 
    238  
    239 ! no passive tracers 
    240  
    241 SUBROUTINE trcdit_wr(kt,kindic) 
    242      !!! no passive tracers 
    243      INTEGER, INTENT ( in ) :: kt, kindic 
    244      WRITE(*,*) 'trcdit_wr: You should not have seen this print! error?', kt, kindic 
    245 END SUBROUTINE trcdit_wr 
    246  
    247 #    endif 
    248  
    249 #    if defined key_passivetrc && defined key_trc_diatrd 
    250  
    251       SUBROUTINE trcdid_wr(kt,kindic) 
    252  !!=========================================================================================== 
    253    !! 
    254    !!                       ROUTINE trcdid_wr 
    255    !!=========================================================================================== 
    256    !! 
    257    !! Purpose : 
    258    !!--------- 
    259    !!          output of opa: passive tracer dynamical trends 
    260    !! 
    261    !! 
    262    !! Method : 
    263    !! ------- 
    264    !! 
    265    !!        At the beginning of the first time step (nit000), define all 
    266    !!        the NETCDF files and fields for dynamical trends of tracers 
    267    !! 
    268    !!        At each time step call histdef to compute the mean if necessary 
    269    !!        Each nwritetrd time step, output the instantaneous or mean fields 
    270    !! 
    271    !!        IF kindic <0, output of fields before the model interruption. 
    272    !!        IF kindic =0, time step loop 
    273    !!        IF kindic >0, output of fields before the time step loop 
    274    !! 
    275    !! Input : 
    276    !! ----- 
    277    !!   argument 
    278    !!           kt              : time step 
    279    !!           kindic          : indicator of abnormal termination 
    280    !! 
    281    !! Output : 
    282    !! ------ 
    283    !!   file 
    284    !!           "clhstnam" files : one for concentration 
    285    !! 
    286    !! History: 
    287    !! -------- 
    288    !!   original  : 95-01  passive tracers  (M. Levy) 
    289    !!   additions : 98-01 (C. Levy) NETCDF format using ioipsl interface 
    290    !!   additions : 99-01 (M.A. Foujols) adapted for passive tracer 
    291    !!   additions : 99-09 (M.A. Foujols) split into three parts 
    292    !!   additions : 01-06 (Mehdi B, Elodie K): suppress initialization 
    293    !!                                          of nit6,nhorit6,ndepit6 
    294    !!   05-03 (O. Aumont and A. El Moussaoui) F90 
    295    !!==================================================================================================! 
    296  
    297       !! Modules used 
    298       USE ioipsl 
    299  
    300       !! * Arguments 
    301       INTEGER, INTENT( in ) ::   kt,kindic         ! ocean time-step 
    302  
    303       INTEGER :: jn, jl 
    304       LOGICAL :: ll_print = .FALSE. 
    305  
    306       CHARACTER (len=40) :: clhstnam, clop 
    307       CHARACTER (len=20) :: cltra, cltrau 
    308       CHARACTER (len=80) :: cltral 
    309       CHARACTER (len=10) :: csuff 
    310  
    311       REAL(wp) :: zsto, zout, zdt 
    312       INTEGER :: iimi, iima, ijmi, ijma, ipk, it 
    313  
    314 ! 
    315 ! 0. Initialisation 
    316 ! ----------------- 
    317  
    318 ! local variable for debugging 
     189      ! synchronise file 
     190      IF( MOD( kt, nwritetrc ) == 0 .OR. kindic < 0 )   CALL histsync( nit5 ) 
     191 
     192 
     193      ! close the file  
     194      ! -------------- 
     195      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nit5 ) 
     196      ! 
     197   END SUBROUTINE trcdit_wr 
     198 
     199 
     200# if defined key_trc_diatrd 
     201 
     202   SUBROUTINE trcdid_wr( kt, kindic ) 
     203      !!---------------------------------------------------------------------- 
     204      !!                     ***  ROUTINE trcdid_wr  *** 
     205      !! 
     206      !! ** Purpose :   output of passive tracer : advection-diffusion trends 
     207      !! 
     208      !! ** Method  :   At the beginning of the first time step (nit000), define all 
     209      !!             the NETCDF files and fields for concentration of passive tracer 
     210      !! 
     211      !!        At each time step call histdef to compute the mean if necessary 
     212      !!        Each nwritetrc time step, output the instantaneous or mean fields 
     213      !! 
     214      !!        IF kindic <0, output of fields before the model interruption. 
     215      !!        IF kindic =0, time step loop 
     216      !!        IF kindic >0, output of fields before the time step loop 
     217      !!---------------------------------------------------------------------- 
     218      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
     219      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
     220      !! 
     221      LOGICAL ::   ll_print = .FALSE. 
     222      CHARACTER (len=40) ::   clhstnam, clop 
     223      CHARACTER (len=20) ::   cltra, cltrau 
     224      CHARACTER (len=80) ::   cltral 
     225      CHARACTER (len=10) ::   csuff 
     226      INTEGER  ::   jn, jl 
     227      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it 
     228      REAL(wp) ::   zsto, zout, zdt 
     229      !!---------------------------------------------------------------------- 
     230 
     231      ! 0. Initialisation 
     232      ! ----------------- 
     233 
     234      ! local variable for debugging 
    319235      ll_print = .FALSE. 
    320236      ll_print = ll_print .AND. lwp 
    321 ! 
    322 ! Define frequency of output and means 
    323 ! 
     237      ! 
     238      ! Define frequency of output and means 
    324239      zdt = rdt 
    325 #        if defined key_diainstant 
    326       zsto=nwritetrd*rdt 
    327       clop='inst(only(x))' 
    328 #        else 
    329       zsto=zdt 
    330       clop='ave(only(x))' 
    331 #        endif 
    332       zout=nwritetrd*zdt 
     240#  if defined key_diainstant 
     241      zsto = nwritetrd * rdt 
     242      clop = 'inst(only(x))' 
     243#  else 
     244      zsto = zdt 
     245      clop = 'ave(only(x))' 
     246#  endif 
     247      zout = nwritetrd * zdt 
    333248 
    334249      ! Define indices of the horizontal output zoom and vertical limit storage 
    … …  
    340255      it = kt - nittrc000 + 1 
    341256 
    342 ! Define the NETCDF files (one per tracer) 
    343 ! 
    344       IF(ll_print)WRITE(numout,*)'trcdid kt=',kt,' kindic ',kindic 
    345       IF(kt == nittrc000) THEN 
    346  
    347           DO jn=1,jptra 
    348  
    349             IF (luttrd(jn)) THEN 
    350  
    351 ! Define the file for dynamical trends - one per each tracer IF required 
    352  
    353          IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  & 
    354                                  ' limit storage in depth = ', ipk 
    355                 csuff='DY_'//ctrcnm(jn) 
    356                 CALL dia_nam(clhstnam,nwritetrd,csuff) 
    357                 IF(lwp)WRITE(numout,*)     & 
    358                 &      " Name of NETCDF file for dynamical trends",   & 
    359                 &      " of tracer number : ",clhstnam 
    360  
    361                 CALL histbeg(clhstnam, jpi, glamt, jpj, gphit,   & 
    362                 &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    363                 &    0, zjulian, rdt, nhorit6(jn),               & 
    364                 &    nit6(jn) , domain_id=nidom) 
    365  
    366 ! Vertical grid for tracer trend - one per each tracer IF needed 
    367                 CALL histvert(nit6(jn), 'deptht', 'Vertical T levels',  & 
    368                 &    'm', ipk, gdept_0, ndepit6(jn))  
    369  
    370  
    371             END IF 
     257      ! Define the NETCDF files (one per tracer) 
     258      IF( ll_print ) WRITE(numout,*) 'trcdid kt=', kt, ' kindic ', kindic 
     259       
     260       
     261      IF( kt == nittrc000 ) THEN 
     262 
     263         DO jn = 1, jptra 
     264            ! 
     265            IF( luttrd(jn) ) THEN      ! Define the file for dynamical trends - one per each tracer IF required 
     266 
     267               IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  & 
     268                   &                   ' limit storage in depth = ', ipk 
     269               csuff='DY_'//ctrcnm(jn) 
     270               CALL dia_nam( clhstnam, nwritetrd, csuff ) 
     271               IF(lwp)WRITE(numout,*)   " Name of NETCDF file for dynamical trends",   & 
     272                  &                     " of tracer number : ",clhstnam 
     273 
     274               CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,       & 
     275                  &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,   & 
     276                  &          0, zjulian, rdt, nhorit6(jn),           & 
     277                  &          nit6(jn) , domain_id=nidom ) 
     278 
     279               ! Vertical grid for tracer trend - one per each tracer IF needed 
     280               CALL histvert( nit6(jn), 'deptht', 'Vertical T levels',   & 
     281                  &           'm', ipk, gdept_0, ndepit6(jn) )  
     282             END IF 
    372283          END DO 
    373284 
    374 ! Declare all the output fields as NETCDF variables 
    375  
    376  
    377 ! trends for tracer concentrations 
    378           DO jn=1,jptra 
    379             IF (luttrd(jn)) THEN 
    380                 DO jl=1,jpdiatrc 
    381                   IF (jl.eq.1) THEN 
    382 ! short and long title for x advection for tracer 
     285          ! Declare all the output fields as NETCDF variables 
     286 
     287          ! trends for tracer concentrations 
     288          DO jn = 1, jptra 
     289            IF( luttrd(jn) ) THEN 
     290                DO jl = 1, jpdiatrc 
     291                  IF( jl == 1 ) THEN 
     292                      ! short and long title for x advection for tracer 
    383293                      WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 
    384294                      WRITE (cltral,'("X advective trend for ",58a)')  & 
    385                       &      ctrcnl(jn)(1:58) 
    386                   END IF 
    387                   IF (jl.eq.2) THEN 
    388 ! short and long title for y advection for tracer 
     295                         &      ctrcnl(jn)(1:58) 
     296                  END IF 
     297                  IF( jl == 2 ) THEN 
     298                      ! short and long title for y advection for tracer 
    389299                      WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 
    390300                      WRITE (cltral,'("Y advective trend for ",58a)')  & 
    391                       &      ctrcnl(jn)(1:58) 
    392                   END IF 
    393                   IF (jl.eq.3) THEN 
    394 ! short and long title for Z advection for tracer 
     301                         &      ctrcnl(jn)(1:58) 
     302                  END IF 
     303                  IF( jl == 3 ) THEN 
     304                      ! short and long title for Z advection for tracer 
    395305                      WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 
    396306                      WRITE (cltral,'("Z advective trend for ",58a)')  & 
    397                       &      ctrcnl(jn)(1:58) 
    398                   END IF 
    399                   IF (jl.eq.4) THEN 
    400 ! short and long title for X diffusion for tracer 
     307                         &      ctrcnl(jn)(1:58) 
     308                  END IF 
     309                  IF( jl == 4 ) THEN 
     310                      ! short and long title for X diffusion for tracer 
    401311                      WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 
    402312                      WRITE (cltral,'("X diffusion trend for ",58a)')  & 
    403                       &      ctrcnl(jn)(1:58) 
    404                   END IF 
    405                   IF (jl.eq.5) THEN 
    406 ! short and long title for Y diffusion for tracer 
     313                         &      ctrcnl(jn)(1:58) 
     314                  END IF 
     315                  IF( jl == 5 ) THEN 
     316                      ! short and long title for Y diffusion for tracer 
    407317                      WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 
    408318                      WRITE (cltral,'("Y diffusion trend for ",58a)')  & 
    409                       &      ctrcnl(jn)(1:58) 
    410                   END IF 
    411                   IF (jl.eq.6) THEN 
    412 ! short and long title for Z diffusion for tracer 
     319                         &      ctrcnl(jn)(1:58) 
     320                  END IF 
     321                  IF( jl == 6 ) THEN 
     322                      ! short and long title for Z diffusion for tracer 
    413323                      WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 
    414324                      WRITE (cltral,'("Z diffusion trend for ",58a)')  & 
    415                       &      ctrcnl(jn)(1:58) 
     325                         &      ctrcnl(jn)(1:58) 
    416326                  END IF 
    417327# if defined key_trc_ldfeiv 
    418                   IF (jl.eq.7) THEN 
    419 ! short and long title for x gent velocity for tracer 
     328                  IF( jl == 7 ) THEN 
     329                      ! short and long title for x gent velocity for tracer 
    420330                      WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 
    421331                      WRITE (cltral,'("X gent velocity trend for ",53a)')  & 
    422                       &      ctrcnl(jn)(1:53) 
    423                   END IF 
    424                   IF (jl.eq.8) THEN 
    425 ! short and long title for y gent velocity for tracer 
     332                         &      ctrcnl(jn)(1:53) 
     333                  END IF 
     334                  IF( jl == 8 ) THEN 
     335                      ! short and long title for y gent velocity for tracer 
    426336                      WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 
    427337                      WRITE (cltral,'("Y gent velocity trend for ",53a)')  & 
    428                       &      ctrcnl(jn)(1:53) 
    429                   END IF 
    430                   IF (jl.eq.9) THEN 
    431 ! short and long title for Z gent velocity for tracer 
     338                         &      ctrcnl(jn)(1:53) 
     339                  END IF 
     340                  IF( jl == 9 ) THEN 
     341                      ! short and long title for Z gent velocity for tracer 
    432342                      WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 
    433343                      WRITE (cltral,'("Z gent velocity trend for ",53a)')  & 
    434                       &      ctrcnl(jn)(1:53) 
     344                         &      ctrcnl(jn)(1:53) 
    435345                  END IF 
    436346# endif 
    437347# if defined key_trcdmp 
    438                   IF (jl.eq.jpdiatrc-1) THEN 
    439 ! last trends for tracer damping : short and long title 
     348                  IF( jl == jpdiatrc - 1 ) THEN 
     349                      ! last trends for tracer damping : short and long title 
    440350                      WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 
    441351                      WRITE (cltral,'("Tracer damping trend for ",55a)')  & 
    442                       &      ctrcnl(jn)(1:55) 
    443                   END IF 
    444 # endif 
    445                   IF (jl.eq.jpdiatrc) THEN 
    446 ! last trends for tracer damping : short and long title 
     352                         &      ctrcnl(jn)(1:55) 
     353                  END IF 
     354# endif 
     355                  IF( jl == jpdiatrc ) THEN 
     356                      ! last trends for tracer damping : short and long title 
    447357                      WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 
    448358                      WRITE (cltral,'("Surface boundary flux ",58a)')  & 
    … …  
    450360                  END IF 
    451361 
    452                   call flush(numout) 
    453                   cltrau=ctrcun(jn) ! UNIT for tracer /trends 
    454                   CALL histdef(nit6(jn), cltra, cltral, cltrau, jpi,jpj,  & 
    455                   &   nhorit6(jn), ipk, 1, ipk,  ndepit6(jn), 32, clop ,  & 
    456                   &   zsto,zout) 
    457                 END DO 
     362                  CALL FLUSH( numout ) 
     363                  cltrau = ctrcun(jn)      ! UNIT for tracer /trends 
     364                  CALL histdef( nit6(jn), cltra, cltral, cltrau, jpi,jpj,  & 
     365                     &          nhorit6(jn), ipk, 1, ipk,  ndepit6(jn), 32, clop ,  & 
     366                     &          zsto,zout ) 
     367               END DO 
    458368            END IF 
    459           END DO 
    460  
    461 ! CLOSE netcdf Files 
    462  
    463           DO jn=1,jptra 
    464              IF (luttrd(jn)) CALL histend(nit6(jn)) 
     369         END DO 
     370 
     371         ! CLOSE netcdf Files 
     372          DO jn = 1, jptra 
     373             IF( luttrd(jn) )   CALL histend( nit6(jn) ) 
    465374          END DO 
    466375 
    … …  
    468377         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdid' 
    469378         IF(ll_print) CALL FLUSH(numout ) 
    470  
    471       ENDIF 
    472  
    473 ! SOME diagnostics to DO first time 
    474  
    475 ! 2. Start writing data 
    476 ! --------------------- 
    477  
    478 ! trends for tracer concentrations 
     379         ! 
     380      ENDIF 
     381 
     382      ! SOME diagnostics to DO first time 
     383 
     384      ! Start writing data 
     385      ! --------------------- 
     386 
     387      ! trends for tracer concentrations 
    479388 
    480389      IF( lwp .AND. MOD( kt, nwritetrd ) == 0 ) THEN 
    … …  
    483392      ENDIF 
    484393 
    485           DO jn=1,jptra 
    486             IF (luttrd(jn)) THEN 
    487                 DO jl=1,jpdiatrc 
    488                   IF (jl.eq.1) THEN 
    489 ! short title for x advection for tracer 
    490                       WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 
    491                   END IF 
    492                   IF (jl.eq.2)  THEN 
    493 ! short title for y advection for tracer 
    494                       WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 
    495                   END IF 
    496                   IF (jl.eq.3)  THEN 
    497 ! short title for z advection for tracer 
    498                       WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 
    499                   END IF 
    500                   IF (jl.eq.4)  THEN 
    501 ! short title for x diffusion for tracer 
    502                       WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 
    503                   END IF 
    504                   IF (jl.eq.5)  THEN 
    505 ! short title for y diffusion for tracer 
    506                       WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 
    507                   END IF 
    508                   IF (jl.eq.6)  THEN 
    509 ! short title for z diffusion for tracer 
    510                       WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 
    511                   END IF 
     394      DO jn = 1, jptra 
     395         IF( luttrd(jn) ) THEN 
     396            DO jl = 1, jpdiatrc 
     397               ! short titles  
     398               IF( jl == 1)   WRITE (cltra,'("XAD_",16a)') ctrcnm(jn)      ! x advection for tracer 
     399               IF( jl == 2)   WRITE (cltra,'("YAD_",16a)') ctrcnm(jn)      ! z advection for tracer 
     400               IF( jl == 3)   WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn)      ! z advection for tracer 
     401               IF( jl == 4)   WRITE (cltra,'("XDF_",16a)') ctrcnm(jn)      ! x diffusion for tracer 
     402               IF( jl == 5)   WRITE (cltra,'("YDF_",16a)') ctrcnm(jn)      ! y diffusion for tracer 
     403               IF( jl == 6)   WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn)      ! z diffusion for tracer 
    512404# if defined key_trcldf_eiv 
    513                   IF (jl.eq.7) THEN 
    514 ! short for x gent velocity for tracer 
    515                       WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 
    516                   END IF 
    517                   IF (jl.eq.8)  THEN 
    518 ! short for y gent velocity for tracer 
    519                       WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 
    520                   END IF 
    521                   IF (jl.eq.9)  THEN 
    522 ! short title for Z gent velocity for tracer 
    523                       WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 
    524                   END IF 
     405               IF( jl == 7)   WRITE (cltra,'("XGV_",16a)') ctrcnm(jn)      ! x gent velocity for tracer 
     406               IF( jl == 8)   WRITE (cltra,'("YGV_",16a)') ctrcnm(jn)      ! y gent velocity for tracer 
     407               IF( jl == 9)   WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn)      ! z gent velocity for tracer 
    525408# endif 
    526409# if defined key_trcdmp 
    527                   IF (jl.eq.jpdiatrc-1) THEN 
    528 ! short for x gent velocity for tracer 
    529                       WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 
    530                   END IF 
    531 # endif 
    532                   IF (jl.eq.jpdiatrc) THEN 
    533 ! short for surface boundary conditions for tracer 
    534                       WRITE (cltra,'("SBC_",a)') ctrcnm(jn) 
    535                   END IF 
    536  
    537                   CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikeep(jn),jl)  & 
    538                   &    ,ndimt50, ndext50) 
    539                 END DO 
    540             END IF 
    541           END DO 
    542  
    543 ! synchronise FILE 
    544  
     410               IF( jl == jpdiatrc - 1 )   WRITE (cltra,'("TDM_",16a)') ctrcnm(jn)      ! damping 
     411# endif 
     412               IF( jl == jpdiatrc )   WRITE (cltra,'("SBC_",a)') ctrcnm(jn)      ! surface boundary conditions 
     413               ! 
     414               CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikeep(jn),jl)   & 
     415                  &          ,ndimt50, ndext50) 
     416            END DO 
     417         END IF 
     418      END DO 
     419 
     420      ! synchronise FILE 
    545421      IF( MOD( kt, nwritetrd ) == 0 .OR. kindic < 0 ) THEN 
    546           DO jn=1,jptra 
    547              IF (luttrd(jn)) CALL histsync(nit6(jn)) 
    548           END DO 
    549       ENDIF 
    550  
    551 ! 3. Closing all files 
    552 ! -------------------- 
    553  
     422         DO jn = 1, jptra 
     423            IF (luttrd(jn))   CALL histsync( nit6(jn) ) 
     424         END DO 
     425      ENDIF 
     426 
     427      ! Closing all files 
     428      ! ----------------- 
    554429      IF( kt == nitend .OR. kindic < 0 ) THEN 
    555           DO jn=1,jptra 
    556              IF (luttrd(jn)) CALL histclo(nit6(jn)) 
    557           END DO 
    558       ENDIF 
    559  
    560 END SUBROUTINE trcdid_wr 
    561  
    562 #    else 
    563  
    564 SUBROUTINE trcdid_wr(kt,kindic) 
    565      !!! no passive tracers 
    566      INTEGER, INTENT ( in ) :: kt, kindic 
    567      WRITE(*,*) 'trcdid_wr: You should not have seen this print! error?', kt, kindic 
    568 END SUBROUTINE trcdid_wr 
    569  
    570 #    endif 
     430         DO jn = 1, jptra 
     431            IF( luttrd(jn) )   CALL histclo( nit6(jn) ) 
     432         END DO 
     433      ENDIF 
     434      ! 
     435   END SUBROUTINE trcdid_wr 
     436 
     437# endif 
    571438 
    572439#    if defined key_passivetrc && defined key_trc_diaadd 
    573440 
    574       SUBROUTINE trcdii_wr(kt,kindic) 
    575    !!=========================================================================================== 
    576    !! 
    577    !!                       ROUTINE trcdii_wr 
    578    !!=========================================================================================== 
    579    !! 
    580    !! Purpose : 
    581    !!--------- 
    582    !!          output of passive tracer : additional 2D and 3D arrays 
    583    !! 
    584    !! 
    585    !! Method : 
    586    !! ------- 
    587    !! 
    588    !!        At the beginning of the first time step (nit000), define all 
    589    !!        the NETCDF files and fields for additional arrays 
    590    !! 
    591    !!        At each time step call histdef to compute the mean if necessary 
    592    !!        Each nwritetrc time step, output the instantaneous or mean fields 
    593    !! 
    594    !! 
    595    !!        IF kindic <0, output of fields before the model interruption. 
    596    !!        IF kindic =0, time step loop 
    597    !!        IF kindic >0, output of fields before the time step loop 
    598    !! 
    599    !! Input : 
    600    !! ----- 
    601    !!   argument 
    602    !!           kt              : time step 
    603    !!           kindic          : indicator of abnormal termination 
    604    !! 
    605    !! EXTERNAL : 
    606    !! -------- 
    607    !! prihre, hist..., dianam 
    608    !! 
    609    !! History: 
    610    !! -------- 
    611    !!   original  : 95-01  passive tracers  (M. Levy) 
    612    !!   additions : 98-01 (C. Levy) NETCDF format using ioipsl interface 
    613    !!   additions : 99-01 (M.A. Foujols) adapted for passive tracer 
    614    !!   additions : 99-09 (M.A. Foujols) split into three parts 
    615    !!   05-03 (O. Aumont and A. El Moussaoui) F90 
    616    !!==================================================================================================! 
    617  
    618       !! Modules used 
    619       USE ioipsl 
    620  
    621       !! * Arguments 
    622       INTEGER, INTENT( in ) ::   kt,kindic         ! ocean time-step 
    623  
    624       INTEGER :: jn 
    625       LOGICAL :: ll_print = .FALSE. 
    626  
    627       CHARACTER (len=40) :: clhstnam, clop 
    628       CHARACTER (len=20) :: cltra, cltrau 
    629       CHARACTER (len=80) :: cltral 
    630  
    631       REAL(wp) :: zsto, zout, zdt 
    632       INTEGER :: iimi, iima, ijmi, ijma, ipk, it 
    633  
    634 ! 
    635 ! 0. Initialisation 
    636 ! ----------------- 
    637  
    638 ! local variable for debugging 
     441   SUBROUTINE trcdii_wr( kt, kindic ) 
     442      !!---------------------------------------------------------------------- 
     443      !!                     ***  ROUTINE trcdii_wr  *** 
     444      !! 
     445      !! ** Purpose :   output of passive tracer : additional 2D and 3D arrays 
     446      !! 
     447      !! ** Method  :   At the beginning of the first time step (nit000), define all 
     448      !!             the NETCDF files and fields for concentration of passive tracer 
     449      !! 
     450      !!        At each time step call histdef to compute the mean if necessary 
     451      !!        Each nwritetrc time step, output the instantaneous or mean fields 
     452      !! 
     453      !!        IF kindic <0, output of fields before the model interruption. 
     454      !!        IF kindic =0, time step loop 
     455      !!        IF kindic >0, output of fields before the time step loop 
     456      !!---------------------------------------------------------------------- 
     457      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
     458      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
     459      !! 
     460      LOGICAL ::   ll_print = .FALSE. 
     461      CHARACTER (len=40) ::   clhstnam, clop 
     462      CHARACTER (len=20) ::   cltra, cltrau 
     463      CHARACTER (len=80) ::   cltral 
     464      INTEGER  ::   jn 
     465      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it 
     466      REAL(wp) ::   zsto, zout, zdt 
     467      !!---------------------------------------------------------------------- 
     468 
     469      ! Initialisation 
     470      ! -------------- 
     471 
     472      ! local variable for debugging 
    639473      ll_print = .FALSE. 
    640474      ll_print = ll_print .AND. lwp 
    641 ! 
    642 ! Define frequency of output and means 
    643 ! 
     475      ! 
     476      ! Define frequency of output and means 
    644477      zdt = rdt 
    645 #        if defined key_diainstant 
     478#  if defined key_diainstant 
    646479      zsto=nwriteadd*zdt 
    647480      clop='inst(only(x))' 
    648 #        else 
     481#  else 
    649482      zsto=zdt 
    650483      clop='ave(only(x))' 
    651 #        endif 
     484#  endif 
    652485      zout=nwriteadd*zdt 
    653486 
    … …  
    660493      it = kt - nittrc000 + 1 
    661494 
    662 ! 1. Define NETCDF files and fields at beginning of first time step 
    663 ! ----------------------------------------------------------------- 
    664  
    665       IF(ll_print)WRITE(numout,*)'trcdii_wr kt=',kt,' kindic ',kindic 
    666       IF(kt == nittrc000) THEN 
    667  
    668 ! Define the NETCDF files for additional arrays : 2D or 3D 
    669  
    670 ! Define the T grid file for tracer auxiliary files 
    671  
    672           CALL dia_nam(clhstnam,nwrite,'diad_T') 
    673           IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam 
    674  
    675 ! Define a netcdf FILE for 2d and 3d arrays 
    676  
    677           CALL histbeg(clhstnam, jpi, glamt, jpj, gphit,     & 
    678           &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    679           &    0, zjulian, zdt, nhoritd, nitd , domain_id=nidom) 
    680  
    681 ! Vertical grid for 2d and 3d arrays 
    682  
    683           CALL histvert(nitd, 'deptht', 'Vertical T levels', & 
    684           &    'm', ipk, gdept_0, ndepitd) 
    685  
    686  
    687 ! Declare all the output fields as NETCDF variables 
    688  
    689 ! more 3D horizontal arrays 
    690  
    691           DO jn=1,jpdia3d 
    692             cltra=ctrc3d(jn)    ! short title for 3D diagnostic 
    693             cltral=ctrc3l(jn)   ! long title for 3D diagnostic 
    694             cltrau=ctrc3u(jn)   ! UNIT for 3D diagnostic 
    695             CALL histdef(nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  & 
    696             &    ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout) 
    697           END DO 
    698  
    699  
    700 ! more 2D horizontal arrays 
    701  
    702           DO jn=1,jpdia2d 
     495      ! 1. Define NETCDF files and fields at beginning of first time step 
     496      ! ----------------------------------------------------------------- 
     497 
     498      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 
     499 
     500      IF( kt == nittrc000 ) THEN 
     501 
     502         ! Define the NETCDF files for additional arrays : 2D or 3D 
     503 
     504         ! Define the T grid file for tracer auxiliary files 
     505 
     506         CALL dia_nam( clhstnam, nwrite, 'diad_T' ) 
     507         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 
     508 
     509         ! Define a netcdf FILE for 2d and 3d arrays 
     510 
     511         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             & 
     512            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
     513            &          0, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
     514 
     515         ! Vertical grid for 2d and 3d arrays 
     516 
     517         CALL histvert( nitd, 'deptht', 'Vertical T levels',   & 
     518            &           'm', ipk, gdept_0, ndepitd) 
     519 
     520         ! Declare all the output fields as NETCDF variables 
     521 
     522         ! more 3D horizontal arrays 
     523         DO jn = 1, jpdia3d 
     524            cltra  = ctrc3d(jn)   ! short title for 3D diagnostic 
     525            cltral = ctrc3l(jn)   ! long title for 3D diagnostic 
     526            cltrau = ctrc3u(jn)   ! UNIT for 3D diagnostic 
     527            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,   & 
     528               &          ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout ) 
     529         END DO 
     530 
     531         ! more 2D horizontal arrays 
     532         DO jn = 1, jpdia2d 
    703533            cltra=ctrc2d(jn)    ! short title for 2D diagnostic 
    704534            cltral=ctrc2l(jn)   ! long title for 2D diagnostic 
    705535            cltrau=ctrc2u(jn)   ! UNIT for 2D diagnostic 
    706             CALL histdef(nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  & 
    707             &    1, 1, 1,  -99, 32, clop, zsto, zout) 
    708           END DO 
    709  
    710 ! TODO: more 2D vertical sections arrays : I or J indice fixed 
    711  
    712 ! CLOSE netcdf Files 
    713  
    714           CALL histend(nitd) 
     536            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  & 
     537               &          1, 1, 1,  -99, 32, clop, zsto, zout ) 
     538         END DO 
     539 
     540         ! TODO: more 2D vertical sections arrays : I or J indice fixed 
     541 
     542         ! CLOSE netcdf Files 
     543         CALL histend( nitd ) 
    715544 
    716545         IF(lwp) WRITE(numout,*) 
    717546         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdii_wr' 
    718          IF(ll_print) CALL FLUSH(numout ) 
    719  
    720       ENDIF 
    721  
    722 ! 2. Start writing data 
    723 ! --------------------- 
     547         IF( ll_print )  CALL FLUSH(numout ) 
     548         ! 
     549      ENDIF 
     550 
     551      ! 2. Start writing data 
     552      ! --------------------- 
    724553 
    725554      IF( lwp .AND. MOD( kt, nwriteadd ) == 0 ) THEN 
    … …  
    728557      ENDIF 
    729558 
    730 ! more 3D horizontal arrays 
    731  
    732           DO jn=1,jpdia3d 
    733             cltra=ctrc3d(jn) ! short title for 3D diagnostic 
    734             CALL histwrite(nitd, cltra, it, trc3d(:,:,:,jn), ndimt50  & 
    735             &   ,ndext50) 
    736           END DO 
    737  
    738 ! more 2D horizontal arrays 
    739  
    740           DO jn=1,jpdia2d 
    741             cltra=ctrc2d(jn) ! short title for 2D diagnostic 
    742             CALL histwrite(nitd, cltra, it, trc2d(:,:,jn), ndimt51    & 
     559      ! more 3D horizontal arrays 
     560      DO jn = 1, jpdia3d 
     561         cltra = ctrc3d(jn)   ! short title for 3D diagnostic 
     562         CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jn), ndimt50  & 
     563            &           ,ndext50) 
     564      END DO 
     565 
     566      ! more 2D horizontal arrays 
     567      DO jn = 1, jpdia2d 
     568         cltra = ctrc2d(jn)   ! short title for 2D diagnostic 
     569         CALL histwrite(nitd, cltra, it, trc2d(:,:,jn), ndimt51    & 
    743570            &   ,ndext51) 
    744           END DO 
    745  
    746 ! synchronise FILE 
    747  
    748       IF( MOD( kt, nwriteadd ) == 0 .OR. kindic < 0 ) THEN 
    749               CALL histsync(nitd) 
    750       ENDIF 
    751  
    752 ! 3. Closing all files 
    753 ! -------------------- 
    754  
    755       IF( kt == nitend .OR. kindic < 0 ) THEN 
    756           CALL histclo(nitd) 
    757       ENDIF 
    758  
     571      END DO 
     572 
     573      ! synchronise FILE 
     574      IF( MOD( kt, nwriteadd ) == 0 .OR. kindic < 0 )   CALL histsync( nitd ) 
     575 
     576      ! Closing all files 
     577      ! ----------------- 
     578      IF( kt == nitend .OR. kindic < 0 )   CALL histclo(nitd) 
     579      ! 
    759580END SUBROUTINE trcdii_wr 
    760581 
    761 #    else 
    762  
    763 SUBROUTINE trcdii_wr(kt,kindic) 
    764      !!! no passive tracers 
    765      INTEGER, INTENT ( in ) :: kt, kindic 
    766      WRITE(*,*) 'trcdii_wr: You should not have seen this print! error?', kt, kindic 
    767 END SUBROUTINE trcdii_wr 
    768  
    769 #    endif 
    770  
    771 #    if defined key_passivetrc && defined key_trc_diabio 
    772  
    773       SUBROUTINE trcdib_wr(kt,kindic) 
    774  !!=========================================================================================== 
    775    !! 
    776    !!                       ROUTINE trcdib_wr 
    777    !!=========================================================================================== 
    778    !! 
    779    !! Purpose : 
    780    !!--------- 
    781    !!          Specific output of opa: biological fields 
    782    !! 
    783    !! 
    784    !! Method : 
    785    !! ------- 
    786    !! 
    787    !!        At the beginning of the first time step (nit000), define all 
    788    !!        the NETCDF files and fields for biological fields 
    789    !! 
    790    !!        At each time step call histdef to compute the mean if necessary 
    791    !!        Each nwritetrd time step, output the instantaneous or mean fields 
    792    !! 
    793    !!        IF kindic <0, output of fields before the model interruption. 
    794    !!        IF kindic =0, time step loop 
    795    !!        IF kindic >0, output of fields before the time step loop 
    796    !! 
    797    !! Input : 
    798    !! ----- 
    799    !!   argument 
    800    !!           kt              : time step 
    801    !!           kindic          : indicator of abnormal termination 
    802    !! 
    803    !! Output : 
    804    !! ------ 
    805    !!   file 
    806    !!           "histname" files : at least one file for each grid 
    807    !! 
    808    !! History: 
    809    !! -------- 
    810    !!   original  : 95-01  passive tracers  (M. Levy) 
    811    !!   additions : 98-01 (C. Levy) NETCDF format using ioipsl interface 
    812    !!   additions : 99-01 (M.A. Foujols) adapted for passive tracer 
    813    !!   additions : 99-09 (M.A. Foujols) split into three parts 
    814    !!   additions : 01-06 (E Kestenare) assign a parameter to name 
    815    !!                                          individual tracers 
    816    !!   additions : 05-03 (O. Aumont and A El Moussaoui) F90 
    817    !!==================================================================================================! 
    818  
    819       !! Modules used 
    820       USE ioipsl 
     582# endif 
     583 
     584# if defined key_trc_diabio 
     585 
     586   SUBROUTINE trcdib_wr( kt, kindic ) 
     587      !!---------------------------------------------------------------------- 
     588      !!                     ***  ROUTINE trcdib_wr  *** 
     589      !! 
     590      !! ** Purpose :   output of passive tracer : biological fields 
     591      !! 
     592      !! ** Method  :   At the beginning of the first time step (nit000), define all 
     593      !!             the NETCDF files and fields for concentration of passive tracer 
     594      !! 
     595      !!        At each time step call histdef to compute the mean if necessary 
     596      !!        Each nwritetrc time step, output the instantaneous or mean fields 
     597      !! 
     598      !!        IF kindic <0, output of fields before the model interruption. 
     599      !!        IF kindic =0, time step loop 
     600      !!        IF kindic >0, output of fields before the time step loop 
     601      !!---------------------------------------------------------------------- 
    821602      USE sms 
    822  
    823       !! * Arguments 
    824       INTEGER, INTENT( in ) ::   kt,kindic         ! ocean time-step 
    825  
    826       INTEGER :: ji, jj, jk, jn 
    827       LOGICAL :: ll_print = .FALSE. 
    828  
    829       CHARACTER (len=40) :: clhstnam, clop 
    830       CHARACTER (len=20) :: cltra, cltrau 
    831       CHARACTER (len=80) :: cltral 
    832  
    833       REAL(wp) :: zsto, zout, zdt 
    834       INTEGER  :: iimi, iima, ijmi, ijma, ipk, it 
    835  
    836 ! 
    837 ! 0. Initialisation 
    838 ! ----------------- 
    839  
    840 ! local variable for debugging 
     603      !! 
     604      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
     605      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
     606      !! 
     607      LOGICAL ::   ll_print = .FALSE. 
     608      CHARACTER (len=40) ::   clhstnam, clop 
     609      CHARACTER (len=20) ::   cltra, cltrau 
     610      CHARACTER (len=80) ::   cltral 
     611      INTEGER  ::   ji, jj, jk, jn 
     612      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it 
     613      REAL(wp) ::   zsto, zout, zdt 
     614      !!---------------------------------------------------------------------- 
     615 
     616      ! Initialisation 
     617      ! -------------- 
     618 
     619      ! local variable for debugging 
    841620      ll_print = .FALSE. 
    842621      ll_print = ll_print .AND. lwp 
    843 ! 
    844 ! Define frequency of output and means 
    845 ! 
     622 
     623      ! Define frequency of output and means 
    846624      zdt = rdt 
    847625#        if defined key_diainstant 
    … …  
    862640      it = kt - nittrc000 + 1 
    863641 
    864 ! 1. Define NETCDF files and fields at beginning of first time step 
    865 ! ----------------------------------------------------------------- 
    866  
    867       IF(ll_print)WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 
    868       IF(kt == nittrc000) THEN 
    869  
    870 ! Define the NETCDF files for biological trends 
    871  
    872           CALL dia_nam(clhstnam,nwrite,'biolog') 
    873           IF(lwp)WRITE(numout,*)        & 
    874           &      " Name of NETCDF file for biological trends ",clhstnam 
    875 ! Horizontal grid : glamt and gphit 
    876           CALL histbeg(clhstnam, jpi, glamt, jpj, gphit,      & 
    877           &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
    878           &    0, zjulian, rdt, nhoritb, nitb , domain_id=nidom) 
    879 ! Vertical grid for biological trends 
    880           CALL histvert(nitb, 'deptht', 'Vertical T levels',  & 
    881           &    'm', ipk, gdept_0, ndepitb) 
    882  
    883 ! Declare all the output fields as NETCDF variables 
    884  
    885 ! biological trends 
    886  
    887           DO jn=1,jpdiabio 
    888             cltra=ctrbio(jn)    ! short title for biological diagnostic 
    889             cltral=ctrbil(jn)   ! long title for biological diagnostic 
    890             cltrau=ctrbiu(jn)   ! UNIT for biological diagnostic 
     642      ! Define NETCDF files and fields at beginning of first time step 
     643      ! -------------------------------------------------------------- 
     644 
     645      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 
     646 
     647      IF( kt == nittrc000 ) THEN 
     648 
     649         ! Define the NETCDF files for biological trends 
     650 
     651         CALL dia_nam(clhstnam,nwrite,'biolog') 
     652         IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam 
     653         ! Horizontal grid : glamt and gphit 
     654         CALL histbeg(clhstnam, jpi, glamt, jpj, gphit,      & 
     655            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
     656            &    0, zjulian, rdt, nhoritb, nitb , domain_id=nidom) 
     657         ! Vertical grid for biological trends 
     658         CALL histvert(nitb, 'deptht', 'Vertical T levels',  & 
     659            &    'm', ipk, gdept_0, ndepitb) 
     660 
     661         ! Declare all the output fields as NETCDF variables 
     662         ! biological trends 
     663         DO jn = 1, jpdiabio 
     664            cltra  = ctrbio(jn)   ! short title for biological diagnostic 
     665            cltral = ctrbil(jn)   ! long title for biological diagnostic 
     666            cltrau = ctrbiu(jn)   ! UNIT for biological diagnostic 
    891667            CALL histdef(nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,  & 
    892             &    ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout) 
    893           END DO 
    894  
    895 ! CLOSE netcdf Files 
    896  
     668               &         ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout) 
     669         END DO 
     670 
     671         ! CLOSE netcdf Files 
    897672          CALL histend(nitb) 
    898673 
    … …  
    900675         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdib_wr' 
    901676         IF(ll_print) CALL FLUSH(numout ) 
    902  
    903      ENDIF 
    904  
    905 ! 2. Start writing data 
    906 ! --------------------- 
    907  
    908 ! biological trends 
    909  
     677         ! 
     678      ENDIF 
     679 
     680      ! Start writing data 
     681      ! ------------------ 
     682 
     683      ! biological trends 
    910684      IF( lwp .AND. MOD( kt, nwritebio ) == 0 ) THEN 
    911685         WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step' 
    … …  
    913687      ENDIF 
    914688 
    915  
    916       DO jn=1,jpdiabio 
     689      DO jn = 1, jpdiabio 
    917690         cltra=ctrbio(jn)  ! short title for biological diagnostic 
    918691         CALL histwrite(nitb, cltra, it, trbio(:,:,:,jn), ndimt50,ndext50) 
    919692      END DO 
    920693 
    921 ! synchronise FILE 
    922  
    923       IF( MOD( kt, nwritebio ) == 0 .OR. kindic < 0 ) THEN 
    924               CALL histsync(nitb) 
    925       ENDIF 
    926  
    927 ! 3. Closing all files 
    928 ! -------------------- 
    929       IF( kt == nitend .OR. kindic < 0 ) THEN 
    930           CALL histclo(nitb) 
    931       ENDIF 
    932  
    933 END SUBROUTINE trcdib_wr 
    934  
    935 #    else 
    936  
    937 SUBROUTINE trcdib_wr(kt,kindic) 
    938      !!! no passive tracers 
    939      INTEGER, INTENT ( in ) :: kt, kindic 
    940      WRITE(*,*) 'trcdib_wr: You should not have seen this print! error?', kt, kindic 
    941 END SUBROUTINE trcdib_wr 
    942  
    943 #    endif 
    944  
     694      ! synchronise FILE 
     695      IF( MOD( kt, nwritebio ) == 0 .OR. kindic < 0 )   CALL histsync( nitb ) 
     696 
     697      ! Closing all files 
     698      ! ----------------- 
     699      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb ) 
     700      ! 
     701   END SUBROUTINE trcdib_wr 
     702 
     703#else 
     704   !!---------------------------------------------------------------------- 
     705   !!  Dummy module :                                     No passive tracer 
     706   !!---------------------------------------------------------------------- 
     707   SUBROUTINE trcdit_wr( kt, kindic )                      ! Dummy routine 
     708      INTEGER, INTENT ( in ) ::   kt, kindic 
     709      WRITE(*,*) 'trcdit_wr: You should not have seen this print! error?', kt, kindic 
     710   END SUBROUTINE trcdit_wr 
     711   SUBROUTINE trcdid_wr( kt, kindic )                      ! Dummy routine 
     712      INTEGER, INTENT ( in ) ::   kt, kindic 
     713      WRITE(*,*) 'trcdid_wr: You should not have seen this print! error?', kt, kindic 
     714   END SUBROUTINE trcdid_wr 
     715   SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine 
     716      INTEGER, INTENT ( in ) :: kt, kindic 
     717      WRITE(*,*) 'trcdii_wr: You should not have seen this print! error?', kt, kindic 
     718   END SUBROUTINE trcdii_wr 
     719   SUBROUTINE trcdib_wr( kt, kindic )                      ! Dummy routine 
     720      INTEGER, INTENT ( in ) ::   kt, kindic 
     721      WRITE(*,*) 'trcdib_wr: You should not have seen this print! error?', kt, kindic 
     722   END SUBROUTINE trcdib_wr 
     723#endif 
     724 
     725   !!====================================================================== 
    945726END MODULE trcdit 

  • branches/dev_001_GM/NEMO/TOP_SRC/trcdta.F90

    r719 r763  
    22   !!====================================================================== 
    33   !!                     ***  MODULE  trcdta  *** 
    4    !! Ocean data :  reads passive tracer data  
     4   !! TOP :  reads passive tracer data  
    55   !!===================================================================== 
    6    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    7    !! $Header$  
    8    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    9    !!---------------------------------------------------------------------- 
    10  
    11 #if  defined key_passivetrc && defined key_dtatrc 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_dtatrc'                           3D tracer data field 
     6   !! History :   1.0  !  2002-04  (O. Aumont)  original code 
     7   !!              -   !  2004-03  (C. Ethe)  module 
     8   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90 
     9   !!---------------------------------------------------------------------- 
     10#if  defined key_passivetrc  &&  defined key_dtatrc 
     11   !!---------------------------------------------------------------------- 
     12   !!   'key_passivetrc'  and  'key_dtatrc'          3D passive tracer data 
    1413   !!---------------------------------------------------------------------- 
    1514   !!   dta_trc      : read ocean passive tracer data 
    1615   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1816   USE oce_trc 
    1917   USE trc 
    2018   USE par_sms 
    2119   USE lib_print 
     20   USE iom 
    2221 
    2322   IMPLICIT NONE 
    2423   PRIVATE 
    2524 
    26    !! * Routine accessibility 
    27    PUBLIC dta_trc   ! called by trcdtr.F90 and trcdmp.F90 
    28  
    29    !! * Shared module variables 
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   &  !: 
    31       trdta             !: tracer data at given time-step 
    32  
    33    !! * Module variables 
    34    REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) ::   & 
    35       tracdta            ! tracer data at two consecutive times 
    36    INTEGER , DIMENSION(jptra) :: & 
    37       nlectr  ,   &    !!: switch for reading once 
    38       ntrc1   ,   &    !!: number of first month when reading 12 monthly value 
    39       ntrc2            !!: number of second month when reading 12 monthly value 
     25   PUBLIC dta_trc   ! called in trcdtr.F90 and trcdmp.F90 
     26 
     27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   trdta   !: tracer data at given time-step 
     28 
     29   REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) ::   tracdta            ! tracer data at two consecutive times 
     30   INTEGER , DIMENSION(jptra) ::   nlectr      !: switch for reading once 
     31   INTEGER , DIMENSION(jptra) ::   ntrc1       !: number of first month when reading 12 monthly value 
     32   INTEGER , DIMENSION(jptra) ::   ntrc2       !: number of second month when reading 12 monthly value 
    4033 
    4134   !! * Substitutions 
    4235#  include "passivetrc_substitute.h90" 
    43  
    44    !!---------------------------------------------------------------------- 
    45    !!   OPA 9.0 , LODYC-IPSL  (2003) 
     36   !!---------------------------------------------------------------------- 
     37   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     38   !! $Header:$  
     39   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4640   !!---------------------------------------------------------------------- 
    4741 
    … …  
    6458      !!      At each time step, a linear interpolation is applied between  
    6559      !!      two monthly values. 
     60      !!---------------------------------------------------------------------- 
     61      INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
    6662      !! 
    67       !! History : 
    68       !!   8.2  !  02-04  (O. Aumont)  Original code 
    69       !!   9.0  !  04-03  (C. Ethe)     
    70       !!   9.0  !  05-03  (O. Aumont and A. El Moussaoui) F90 
    71       !!---------------------------------------------------------------------- 
    72       !! * Modules used 
    73       USE iom 
    74  
    75       !! * Arguments 
    76       INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
    77  
    78       !! * Local declarations 
    79       INTEGER :: ji, jj, jn, jl  
    80       INTEGER, PARAMETER ::  & 
    81          jpmois  = 12        ! number of months 
    82  
    83       INTEGER ::   & 
    84          imois, iman, i15, ik  ! temporary integers  
    85       CHARACTER (len=39) :: clname(jptra) 
    86       REAL(wp) :: zxy, zl 
     63      CHARACTER (len=39) ::   clname(jptra) 
     64      INTEGER, PARAMETER ::   jpmois  = 12        ! number of months 
     65      INTEGER ::   ji, jj, jn, jl  
     66      INTEGER ::   imois, iman, i15, ik  ! temporary integers  
     67      REAL(wp) ::   zxy, zl 
    8768      !!---------------------------------------------------------------------- 
    8869 
    … …  
    11394               IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields' 
    11495               ! open file  
    115 #if defined key_trc_pisces 
     96# if defined key_trc_pisces 
    11697               clname(jn) = 'LEVITUS_'//ctrcnm(jn) 
    117 #else 
     98# else 
    11899               clname(jn) = ctrcnm(jn) 
    119 #endif 
     100# endif 
    120101               CALL iom_open ( clname(jn), numtr(jn) )               
    121102 
    122103            ENDIF 
    123104 
    124 #if defined key_trc_pisces 
     105# if defined key_trc_pisces 
    125106            ! Read montly file 
    126107            IF( ( kt == nittrc000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN 
    … …  
    162143                           IF( ik > 2 ) THEN 
    163144                              zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 
    164                               tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik,jn,jl) + zl * tracdta(ji,jj,ik-1,jn,jl) 
     145                              tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik  ,jn,jl)   & 
     146                                 &                    +     zl  * tracdta(ji,jj,ik-1,jn,jl) 
    165147                           ENDIF 
    166148                        END DO 
    … …  
    173155 
    174156            IF(lwp) THEN 
    175                WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn),   & 
    176                   ntrc2(jn) 
     157               WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), ntrc2(jn) 
    177158               WRITE(numout,*) 
    178                WRITE(numout,*) ' Levitus month = ', ntrc1(jn),   & 
    179                   '  level = 1' 
     159               WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = 1' 
    180160               CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1   & 
    181                   ,jpj, 20, 1., numout ) 
    182                WRITE(numout,*) ' Levitus month = ', ntrc1(jn),    & 
    183                   '  level = ',jpk/2 
     161                  &        ,jpj, 20, 1., numout ) 
     162               WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = ',jpk/2 
    184163               CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi,    & 
    185                   20, 1, jpj, 20, 1., numout ) 
    186                WRITE(numout,*) ' Levitus month = ',ntrc1(jn)     & 
    187                   ,'  level = ',jpkm1 
     164                  &         20, 1, jpj, 20, 1., numout ) 
     165               WRITE(numout,*) ' Levitus month = ',ntrc1(jn),'  level = ',jpkm1 
    188166               CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi,     & 
    189                   20, 1, jpj, 20, 1., numout ) 
     167                  &         20, 1, jpj, 20, 1., numout ) 
    190168            ENDIF 
    191169 
    192170            ! At every time step compute temperature data 
    193  
    194171            zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    195             trdta(:,:,:,jn)=  ( 1. - zxy ) * tracdta(:,:,:,jn,1)    & 
    196                +       zxy   * tracdta(:,:,:,jn,2)  
    197  
    198             IF( jn == jpno3) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 7.6E-6 
    199             IF( jn == jpdic) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6 
    200             IF( jn == jptal) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6 
    201             IF( jn == jpoxy) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 44.6E-6 
    202             IF( jn == jpsil) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6 
    203             IF( jn == jppo4) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.E-6 
     172            trdta(:,:,:,jn) =  ( 1. - zxy ) * tracdta(:,:,:,jn,1)    & 
     173               &              +       zxy   * tracdta(:,:,:,jn,2)  
     174 
     175            IF( jn == jpno3 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   7.6e-6 
     176            IF( jn == jpdic )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6 
     177            IF( jn == jptal )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6 
     178            IF( jn == jpoxy )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *  44.6e-6 
     179            IF( jn == jpsil )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6 
     180            IF( jn == jppo4 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.0e-6 
    204181 
    205182            ! Close the file 
    206183            ! -------------- 
    207184             
    208             IF( kt == nitend )   CALL iom_close ( numtr(jn) ) 
    209  
    210 #else 
     185            IF( kt == nitend )   CALL iom_close( numtr(jn) ) 
     186 
     187# else 
    211188            ! Read init file only 
    212189            IF( kt == nittrc000  ) THEN 
    … …  
    215192               CALL iom_close ( numtr(jn) ) 
    216193            ENDIF  
    217 #endif 
    218  
    219         ENDIF 
    220  
    221        END DO 
    222  
     194# endif 
     195 
     196         ENDIF 
     197 
     198      END DO 
     199      ! 
    223200   END SUBROUTINE dta_trc 
    224201 
    225202#else 
    226  
    227    !!---------------------------------------------------------------------- 
    228    !!   Default case                        NO 3D passive tracer data field 
     203   !!---------------------------------------------------------------------- 
     204   !!   Dummy module                              NO 3D passive tracer data 
    229205   !!---------------------------------------------------------------------- 
    230206CONTAINS 
    … …  
    232208      WRITE(*,*) 'dta_trc: You should not have seen this print! error?', kt 
    233209   END SUBROUTINE dta_trc 
    234  
    235210#endif 
    236211 
     212   !!====================================================================== 
    237213END MODULE trcdta 

  • branches/dev_001_GM/NEMO/TOP_SRC/trcdtr.F90

    r730 r763  
    11MODULE trcdtr 
    2    !!======================================================================================= 
    3    !! 
    4    !!                       *** MODULE trcdtr *** 
    5    !! 
    6    !!  Computes or READ initial DATA for passive tracer 
    7    !! 
    8    !!======================================================================================= 
    9    !!  TOP 1.0,  LOCEAN-IPSL (2005) 
    10    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/trcdtr.F90,v 1.8 2007/10/17 14:48:56 opalod Exp $ 
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    12    !!---------------------------------------------------------------------- 
    13       !!---------------------------------------------------------------------- 
    14       !! * Modules used 
    15       !! ============== 
    16       USE oce_trc 
    17       USE trc 
    18       USE sms 
    19       USE trcdta 
    20       USE lib_mpp 
    21  
    22       IMPLICIT NONE 
    23       PRIVATE 
    24   !! * Accessibility 
    25       PUBLIC trc_dtr 
     2   !!====================================================================== 
     3   !!                         ***  MODULE trcdtr  *** 
     4   !! TOP :   computes or READ initial DATA for passive tracer 
     5   !!====================================================================== 
     6   !! History :    -   !  1996-11  ()  original code 
     7   !!                  !  2000-12  (O. Aumont, E. Kestenare) add for POC in sediments 
     8   !!             1.0  !  2005-12  (O. Aumont, A. El Moussaoui) F90 
     9   !!---------------------------------------------------------------------- 
     10#if defined key_passivetrc 
     11   !!---------------------------------------------------------------------- 
     12   !!   'key_passivetrc'                                    Passive tracers 
     13   !!---------------------------------------------------------------------- 
     14   !!   trc_dtr    :  computes or READ initial DATA for passive tracer 
     15   !!---------------------------------------------------------------------- 
     16   USE oce_trc 
     17   USE trc 
     18   USE sms 
     19   USE trcdta 
     20   USE lib_mpp 
     21 
     22   IMPLICIT NONE 
     23   PRIVATE 
     24 
     25   PUBLIC trc_dtr      ! called in ??? 
     26 
     27   !!---------------------------------------------------------------------- 
     28   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     29   !! $Header:$  
     30   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     31   !!---------------------------------------------------------------------- 
    2632 
    2733CONTAINS 
    2834 
    29 #if defined key_passivetrc 
    30  
    31 SUBROUTINE trc_dtr 
    32 !!--------------------------------------------------------------------- 
    33 !! 
    34 !!                       ROUTINE trci_dtr 
    35 !!                     ****************** 
    36 !!  PURPOSE : 
    37 !!  --------- 
    38 !!     computes or READ initial DATA for passive tracer 
    39 !!   ----- 
    40 !!      COMMON 
    41 !!            /comdom/          : domain PARAMETER 
    42 !!            /comcoo/          : orthogonal curvilinear coordinates 
    43 !!                                and scale factors 
    44 !!            /comask/          : masks, bathymetry 
    45 !!   OUTPUT : 
    46 !!   ------ 
    47 !!      COMMON 
    48 !!            /cottrc/          : passive tracer field now and before 
    49 !! 
    50 !! 
    51 !!   History: 
    52 !!   -------- 
    53 !!      original  : 96-11 
    54 !!      additions : 99-9 
    55 !!                : 00-12 (O. Aumont, E. Kestenare) add for POC in sediments  
    56 !!                         add for POC in sediments   
    57 !!    03/05  O. Aumont and A. El Moussaoui  F90  
    58 !!---------------------------------------------------------------------- 
    59 !!---------------------------------------------------------------------- 
    60 !! local declarations 
    61 !! ==================  
     35   SUBROUTINE trc_dtr 
     36      !!--------------------------------------------------------------------- 
     37      !!                     ***  ROUTINE trc_dtr  *** 
     38      !! 
     39      !! ** Purpose :   computes or READ initial DATA for passive tracer 
     40      !! 
     41      !! ** Method  :  
     42      !!--------------------------------------------------------------------- 
    6243      INTEGER :: ji,jj,jk,jn  
    6344#if defined key_trc_pisces 
    64       REAL(wp) :: alka0,oxyg0,calc0,bioma0,    & 
    65                   silic1,po4,no3,caralk,bicarb,co3 
    66 #endif 
    67 !!--------------------------------------------------------------------- 
    68 !!  OPA.9  
    69 !!--------------------------------------------------------------------- 
    70 !! 0. initialisations 
    71 !! ------------------ 
    72  
    73       IF(lwp) WRITE(numout,*) ' ' 
    74       IF(lwp) WRITE(numout,*) ' *** trcdtr initialisation for ' 
    75       IF(lwp) WRITE(numout,*) '     passive tracers' 
    76       IF(lwp) WRITE(numout,*) ' ' 
    77  
     45      REAL(wp) ::   alka0, oxyg0, calc0, bioma0 
     46      REAL(wp) ::   silic1, po4, no3, caralk, bicarb, co3 
     47#endif 
     48      !!--------------------------------------------------------------------- 
     49 
     50      IF(lwp) WRITE(numout,*) 
     51      IF(lwp) WRITE(numout,*) 'trc_dtr : initialisation of the passive tracers' 
     52      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    7853 
    7954#if defined key_cfc 
    80       trn(:,:,:,:)=0.0 
     55      ! CFC initialisation 
     56      trn(:,:,:,:) = 0.e0 
     57       
    8158#elif defined key_trc_pisces 
    82  
    83       sco2   = 2.3e-3 
    84       alka0  = 2.39e-3 
    85       oxyg0  = 1.8e-4 
    86       po4    = 2.165e-6/po4r 
    87       bioma0 = 1.e-8 
    88       silic1 = 91.51e-6 
    89       calc0  = 1.e-6 
    90       no3    = 30.88E-6*7.6 
     59      ! PISCES initialisation 
     60      ! --------------------- 
     61      sco2   =  2.300e-3 
     62      alka0  =  2.390e-3 
     63      oxyg0  =  1.800e-4 
     64      po4    =  2.165e-6 / po4r 
     65      bioma0 =  1.000e-8 
     66      silic1 = 91.510e-6 
     67      calc0  =  1.000e-6 
     68      no3    = 30.880e-6 * 7.6 
    9169 
    9270      trn(:,:,:,jpdic) = sco2 
    … …  
    9977#if ! defined key_trc_kriest 
    10078      trn(:,:,:,jpgoc) = bioma0 
    101       trn(:,:,:,jpbfe) = bioma0*5E-6 
     79      trn(:,:,:,jpbfe) = bioma0 * 5.e-6 
    10280#else 
    103       trn(:,:,:,jpnum) = bioma0/(6.*xkr_massp) 
     81      trn(:,:,:,jpnum) = bioma0 / ( 6. *xkr_massp ) 
    10482#endif 
    10583      trn(:,:,:,jpsil) = silic1 
    106       trn(:,:,:,jpbsi) = bioma0*0.15 
    107       trn(:,:,:,jpdsi) = bioma0*5.E-6 
     84      trn(:,:,:,jpbsi) = bioma0 * 0.15 
     85      trn(:,:,:,jpdsi) = bioma0 * 5.e-6 
    10886      trn(:,:,:,jpphy) = bioma0 
    10987      trn(:,:,:,jpdia) = bioma0 
    … …  
    11189      trn(:,:,:,jpmes) = bioma0 
    11290      trn(:,:,:,jpfer) = 0.6E-9 
    113       trn(:,:,:,jpsfe) = bioma0*5.E-6 
    114       trn(:,:,:,jpdfe) = bioma0*5.E-6 
    115       trn(:,:,:,jpnfe) = bioma0*5.E-6 
    116       trn(:,:,:,jpnch) = bioma0*12./55. 
    117       trn(:,:,:,jpdch) = bioma0*12./55. 
     91      trn(:,:,:,jpsfe) = bioma0 * 5.e-6 
     92      trn(:,:,:,jpdfe) = bioma0 * 5.e-6 
     93      trn(:,:,:,jpnfe) = bioma0 * 5.e-6 
     94      trn(:,:,:,jpnch) = bioma0 * 12. / 55. 
     95      trn(:,:,:,jpdch) = bioma0 * 12. / 55. 
    11896      trn(:,:,:,jpno3) = no3 
    11997      trn(:,:,:,jpnh4) = bioma0 
    12098 
    121  
    122 !!  Initialization of chemical variables of the carbon cycle 
    123 !!  -------------------------------------------------------- 
    124  
    125       DO jk = 1,jpk 
    126         DO jj = 1,jpj 
    127           DO ji = 1,jpi 
    128               caralk = trn(ji,jj,jk,jptal)-         &  
    129                       borat(ji,jj,jk)/(1.+1.E-8/(rtrn+akb3(ji,jj,jk))) 
    130                co3 = (caralk-trn(ji,jj,jk,jpdic))*tmask(ji,jj,jk)   & 
    131                   &        +(1.-tmask(ji,jj,jk))*.5e-3 
    132               bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk) 
    133               hi(ji,jj,jk) = (ak23(ji,jj,jk)*bicarb/co3)             &   
    134                 *tmask(ji,jj,jk)+(1.-tmask(ji,jj,jk))*1.e-9 
    135           ENDDO 
    136         ENDDO 
    137       ENDDO 
    138  
    139  
    140 !!  initialize the half saturation constant for silicate 
    141 !!  ---------------------------------------------------- 
    142  
    143       xksi(:,:)=2.E-6 
     99      ! Initialization of chemical variables of the carbon cycle 
     100      ! -------------------------------------------------------- 
     101      DO jk = 1, jpk 
     102         DO jj = 1, jpj 
     103            DO ji = 1, jpi 
     104               caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     105               co3    = ( caralk - trn(ji,jj,jk,jpdic) ) *        tmask(ji,jj,jk)   & 
     106                  &   +                  0.5e-3          * ( 1. - tmask(ji,jj,jk) ) 
     107               bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk) 
     108               hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 ) *        tmask(ji,jj,jk)   &   
     109                  &         +            1.e-9                  * ( 1. - tmask(ji,jj,jk) ) 
     110          END DO 
     111        END DO 
     112      END DO 
     113 
     114      ! initialize the half saturation constant for silicate 
     115      ! ---------------------------------------------------- 
     116      xksi(:,:) = 2.e-6 
    144117 
    145118      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    … …  
    147120 
    148121#elif defined key_trc_lobster1 && ( defined key_eel_r6 || defined key_eel_r2 ) 
    149 ! analytical initialisation used in Levy et al. (2001) 
     122      ! LOBSTER initialisation for EEL 
     123      ! ---------------------- 
     124      ! here: analytical initialisation used in Levy et al. (2001) 
    150125       
    151       DO jk=1,7 
    152         trn(:,:,jk,jpdet)=0.016*tmask(:,:,jk) 
    153         trn(:,:,jk,jpzoo)=0.018*tmask(:,:,jk) 
    154         trn(:,:,jk,jpphy)=0.036*tmask(:,:,jk) 
    155         trn(:,:,jk,jpno3)=1.e-5*tmask(:,:,jk) 
    156         trn(:,:,jk,jpnh4)=0.0005*tmask(:,:,jk) 
    157         trn(:,:,jk,jpdom)=0.017*tmask(:,:,jk) 
    158       END DO 
    159  
    160       trn(:,:,8,jpdet)=0.020*tmask(:,:,1) 
    161       trn(:,:,8,jpzoo)=0.027*tmask(:,:,1) 
    162       trn(:,:,8,jpphy)=0.041*tmask(:,:,1) 
    163       trn(:,:,8,jpno3)=0.00022*tmask(:,:,1) 
    164       trn(:,:,8,jpnh4)=0.0033*tmask(:,:,1) 
    165       trn(:,:,8,jpdom)=0.021*tmask(:,:,1) 
    166  
    167       trn(:,:,9,jpdet)=0.0556*tmask(:,:,1) 
    168       trn(:,:,9,jpzoo)=0.123*tmask(:,:,1) 
    169       trn(:,:,9,jpphy)=0.122*tmask(:,:,1) 
    170       trn(:,:,9,jpno3)=0.028*tmask(:,:,1) 
    171       trn(:,:,9,jpnh4)=0.024*tmask(:,:,1) 
    172       trn(:,:,9,jpdom)=0.06*tmask(:,:,1) 
    173  
    174       trn(:,:,10,jpdet)=0.025*tmask(:,:,1) 
    175       trn(:,:,10,jpzoo)=0.016*tmask(:,:,1) 
    176       trn(:,:,10,jpphy)=0.029*tmask(:,:,1) 
    177       trn(:,:,10,jpno3)=2.462*tmask(:,:,1) 
    178       trn(:,:,10,jpnh4)=0.04*tmask(:,:,1) 
    179       trn(:,:,10,jpdom)=0.022*tmask(:,:,1) 
    180  
    181       trn(:,:,11,jpdet)=0.0057*tmask(:,:,1) 
    182       trn(:,:,11,jpzoo)=0.0005*tmask(:,:,1) 
    183       trn(:,:,11,jpphy)=0.0006*tmask(:,:,1) 
    184       trn(:,:,11,jpno3)=3.336*tmask(:,:,1) 
    185       trn(:,:,11,jpnh4)=0.005*tmask(:,:,1) 
    186       trn(:,:,11,jpdom)=0.004*tmask(:,:,1) 
    187  
    188       trn(:,:,12,jpdet)=0.002*tmask(:,:,1) 
    189       trn(:,:,12,jpzoo)=1.e-6*tmask(:,:,1) 
    190       trn(:,:,12,jpphy)=5.e-6*tmask(:,:,1) 
    191       trn(:,:,12,jpno3)=4.24*tmask(:,:,1) 
    192       trn(:,:,12,jpnh4)=0.001*tmask(:,:,1) 
    193       trn(:,:,12,jpdom)=3.e-5*tmask(:,:,1) 
     126      DO jk = 1, 7 
     127         trn(:,:,jk,jpdet) = 0.016 * tmask(:,:,jk) 
     128         trn(:,:,jk,jpzoo) = 0.018 * tmask(:,:,jk) 
     129         trn(:,:,jk,jpphy) = 0.036 * tmask(:,:,jk) 
     130         trn(:,:,jk,jpno3) = 1.e-5 * tmask(:,:,jk) 
     131         trn(:,:,jk,jpnh4) = 5.e-4 * tmask(:,:,jk) 
     132         trn(:,:,jk,jpdom) = 0.017 * tmask(:,:,jk) 
     133      END DO 
     134 
     135      trn(:,:, 8,jpdet) = 0.020   * tmask(:,:, 8) 
     136      trn(:,:, 8,jpzoo) = 0.027   * tmask(:,:, 8) 
     137      trn(:,:, 8,jpphy) = 0.041   * tmask(:,:, 8) 
     138      trn(:,:, 8,jpno3) = 0.00022 * tmask(:,:, 8) 
     139      trn(:,:, 8,jpnh4) = 0.0033  * tmask(:,:, 8) 
     140      trn(:,:, 8,jpdom) = 0.021   * tmask(:,:, 8) 
     141 
     142      trn(:,:, 9,jpdet) = 0.0556  * tmask(:,:, 9) 
     143      trn(:,:, 9,jpzoo) = 0.123   * tmask(:,:, 9) 
     144      trn(:,:, 9,jpphy) = 0.122   * tmask(:,:, 9) 
     145      trn(:,:, 9,jpno3) = 0.028   * tmask(:,:, 9) 
     146      trn(:,:, 9,jpnh4) = 0.024   * tmask(:,:, 9) 
     147      trn(:,:, 9,jpdom) = 0.06    * tmask(:,:, 9) 
     148 
     149      trn(:,:,10,jpdet) = 0.025   * tmask(:,:,10) 
     150      trn(:,:,10,jpzoo) = 0.016   * tmask(:,:,10) 
     151      trn(:,:,10,jpphy) = 0.029   * tmask(:,:,10) 
     152      trn(:,:,10,jpno3) = 2.462   * tmask(:,:,10) 
     153      trn(:,:,10,jpnh4) = 0.04    * tmask(:,:,10) 
     154      trn(:,:,10,jpdom) = 0.022   * tmask(:,:,10) 
     155 
     156      trn(:,:,11,jpdet) = 0.0057  * tmask(:,:,11) 
     157      trn(:,:,11,jpzoo) = 0.0005  * tmask(:,:,11) 
     158      trn(:,:,11,jpphy) = 0.0006  * tmask(:,:,11) 
     159      trn(:,:,11,jpno3) = 3.336   * tmask(:,:,11) 
     160      trn(:,:,11,jpnh4) = 0.005   * tmask(:,:,11) 
     161      trn(:,:,11,jpdom) = 0.004   * tmask(:,:,11) 
     162 
     163      trn(:,:,12,jpdet) = 0.002   * tmask(:,:,12) 
     164      trn(:,:,12,jpzoo) = 1.e-6   * tmask(:,:,12) 
     165      trn(:,:,12,jpphy) = 5.e-6   * tmask(:,:,12) 
     166      trn(:,:,12,jpno3) = 4.24    * tmask(:,:,12) 
     167      trn(:,:,12,jpnh4) = 0.001   * tmask(:,:,12) 
     168      trn(:,:,12,jpdom) = 3.e-5   * tmask(:,:,12) 
    194169 
    195170      DO jk=13,jpk 
    196         trn(:,:,jk,jpdet)=0.0 
    197         trn(:,:,jk,jpzoo)=0.0 
    198         trn(:,:,jk,jpphy)=0.0 
    199         trn(:,:,jk,jpnh4)=0.0 
    200         trn(:,:,jk,jpdom)=0.0 
    201       END DO 
    202  
    203       trn(:,:,13,jpno3)=5.31*tmask(:,:,13) 
    204       trn(:,:,14,jpno3)=6.73*tmask(:,:,14) 
    205       trn(:,:,15,jpno3)=8.32*tmask(:,:,15) 
    206       trn(:,:,16,jpno3)=10.13*tmask(:,:,16) 
    207       trn(:,:,17,jpno3)=11.95*tmask(:,:,17) 
    208       trn(:,:,18,jpno3)=13.57*tmask(:,:,18) 
    209       trn(:,:,19,jpno3)=15.08*tmask(:,:,19) 
    210       trn(:,:,20,jpno3)=16.41*tmask(:,:,20) 
    211       trn(:,:,21,jpno3)=17.47*tmask(:,:,21) 
    212       trn(:,:,22,jpno3)=18.29*tmask(:,:,22) 
    213       trn(:,:,23,jpno3)=18.88*tmask(:,:,23) 
    214       trn(:,:,24,jpno3)=19.30*tmask(:,:,24) 
    215       trn(:,:,25,jpno3)=19.68*tmask(:,:,25) 
    216       trn(:,:,26,jpno3)=19.91*tmask(:,:,26) 
    217       trn(:,:,27,jpno3)=19.99*tmask(:,:,27) 
    218       trn(:,:,28,jpno3)=20.01*tmask(:,:,28) 
    219       trn(:,:,29,jpno3)=20.01*tmask(:,:,29) 
    220       trn(:,:,30,jpno3)=20.01*tmask(:,:,30) 
     171        trn(:,:,jk,jpdet) = 0.e0 
     172        trn(:,:,jk,jpzoo) = 0.e0 
     173        trn(:,:,jk,jpphy) = 0.e0 
     174        trn(:,:,jk,jpnh4) = 0.e0 
     175        trn(:,:,jk,jpdom) = 0.e0 
     176      END DO 
     177 
     178      trn(:,:,13,jpno3) = 5.31  * tmask(:,:,13) 
     179      trn(:,:,14,jpno3) = 6.73  * tmask(:,:,14) 
     180      trn(:,:,15,jpno3) = 8.32  * tmask(:,:,15) 
     181      trn(:,:,16,jpno3) = 10.13 * tmask(:,:,16) 
     182      trn(:,:,17,jpno3) = 11.95 * tmask(:,:,17) 
     183      trn(:,:,18,jpno3) = 13.57 * tmask(:,:,18) 
     184      trn(:,:,19,jpno3) = 15.08 * tmask(:,:,19) 
     185      trn(:,:,20,jpno3) = 16.41 * tmask(:,:,20) 
     186      trn(:,:,21,jpno3) = 17.47 * tmask(:,:,21) 
     187      trn(:,:,22,jpno3) = 18.29 * tmask(:,:,22) 
     188      trn(:,:,23,jpno3) = 18.88 * tmask(:,:,23) 
     189      trn(:,:,24,jpno3) = 19.30 * tmask(:,:,24) 
     190      trn(:,:,25,jpno3) = 19.68 * tmask(:,:,25) 
     191      trn(:,:,26,jpno3) = 19.91 * tmask(:,:,26) 
     192      trn(:,:,27,jpno3) = 19.99 * tmask(:,:,27) 
     193      trn(:,:,28,jpno3) = 20.01 * tmask(:,:,28) 
     194      trn(:,:,29,jpno3) = 20.01 * tmask(:,:,29) 
     195      trn(:,:,30,jpno3) = 20.01 * tmask(:,:,30) 
    221196 
    222197#elif defined key_trc_lobster1 && defined key_gyre 
    223 ! init NO3=f(density) by asklod AS Kremeur 2005-07 
    224       trn(:,:,:,jpdet)=0.1*tmask(:,:,:) 
    225       trn(:,:,:,jpzoo)=0.1*tmask(:,:,:) 
    226       trn(:,:,:,jpnh4)=0.1*tmask(:,:,:) 
    227       trn(:,:,:,jpphy)=0.1*tmask(:,:,:) 
    228       trn(:,:,:,jpdom)=1.*tmask(:,:,:) 
    229       DO  jk=1,jpk 
    230          DO  jj=1,jpj 
    231             DO  ji=1,jpi 
    232                IF (rhd(ji,jj,jk).LE.24.5e-3) THEN 
    233                   trn(ji,jj,jk,jpno3)=2.*tmask(ji,jj,jk) 
     198      ! LOBSTER initialisation for GYRE 
     199      ! ---------------------- 
     200      ! here:  init NO3=f(density) by asklod AS Kremeur 2005-07 
     201      trn(:,:,:,jpdet) = 0.1 * tmask(:,:,:) 
     202      trn(:,:,:,jpzoo) = 0.1 * tmask(:,:,:) 
     203      trn(:,:,:,jpnh4) = 0.1 * tmask(:,:,:) 
     204      trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:) 
     205      trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:) 
     206      DO jk = 1, jpk 
     207         DO jj = 1, jpj 
     208            DO ji = 1, jpi 
     209               IF( rhd(ji,jj,jk) <= 24.5e-3 ) THEN 
     210                  trn(ji,jj,jk,jpno3) = 2. * tmask(ji,jj,jk) 
    234211               ELSE 
    235                   trn(ji,jj,jk,jpno3)=(15.55*(rhd(ji,jj,jk)*1000)-380.11)*tmask(ji,jj,jk) 
     212                  trn(ji,jj,jk,jpno3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk) 
    236213               ENDIF 
    237214            END DO 
    … …  
    240217 
    241218#else 
    242   
    243 !! general case 
    244       do jn = 1, jptra 
    245          trn(:,:,:,jn)=0.1*tmask(:,:,:) 
    246       enddo 
     219      ! Default case  
     220      ! ------------ 
     221      DO jn = 1, jptra 
     222         trn(:,:,:,jn) = 0.1 * tmask(:,:,:) 
     223      END DO 
    247224 
    248225#endif 
    249226 
    250227#if defined key_dtatrc 
    251 !!   Initialization of tracer from a file 
    252 !!   that may also be used for damping 
     228     ! Initialization of tracer from a file that may also be used for damping 
    253229      CALL dta_trc( nittrc000 ) 
    254       DO  jk = 1, jptra 
    255         IF( lutini(jk) ) THEN  
    256 !! initialisation from file 
    257            trn(:,:,:,jk) = trdta(:,:,:,jk)*tmask(:,:,:) 
    258         ENDIF 
    259       END DO 
    260 #endif 
    261  
    262 !! before field : 
    263 !! ------------- 
     230      DO jn = 1, jptra 
     231        IF( lutini(jn) )   trn(:,:,:,jk) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required 
     232      END DO 
     233#endif 
     234 
     235      ! before field : 
     236      ! ------------- 
    264237      trb(:,:,:,:) = trn(:,:,:,:) 
    265238 
    266239#if defined key_trc_lobster1 
    267 !!  initialize the POC in sediments 
    268  
    269       sedpocb(:,:) = 0. 
    270       sedpocn(:,:) = 0. 
    271       sedpoca(:,:) = 0. 
    272 #endif 
    273        
    274  END SUBROUTINE trc_dtr  
     240      !  initialize the POC in sediments 
     241      sedpocb(:,:) = 0.e0 
     242      sedpocn(:,:) = 0.e0 
     243      sedpoca(:,:) = 0.e0 
     244#endif 
     245      ! 
     246   END SUBROUTINE trc_dtr  
    275247 
    276248#else 
    277  
    278 SUBROUTINE  trc_dtr  
    279 !!====================== 
    280    !! no passive tracers 
    281 !!====================== 
    282 END SUBROUTINE  trc_dtr 
    283 #endif 
    284  
     249   !!---------------------------------------------------------------------- 
     250   !!  Dummy module :                                     No passive tracer 
     251   !!---------------------------------------------------------------------- 
     252CONTAINS 
     253   SUBROUTINE trc_dtr                      ! Empty routine    
     254   END SUBROUTINE trc_dtr 
     255#endif 
     256 
     257   !!====================================================================== 
    285258END MODULE trcdtr 

  • branches/dev_001_GM/NEMO/TOP_SRC/trcini.F90

    r719 r763  
    11MODULE trcini 
    2    !!========================================================================== 
    3    !!                       *** MODULE trcini ***   
    4    !! Ocean passive tracers:  Manage the passive tracer initialization  
    5    !!=========================================================================    
     2   !!====================================================================== 
     3   !!                         ***  MODULE trcini  *** 
     4   !! TOP :   Manage the passive tracer initialization 
     5   !!====================================================================== 
     6   !! History :    -   !  2000-04  (O. Aumont, M.A. Foujols)  original code 
     7   !!             1.0  !  2005-03  (O. Aumont, A. El Moussaoui) F90 
     8   !!              -   !  2005-10  (C. Ethe) Module 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_passivetrc 
    711   !!---------------------------------------------------------------------- 
    8    !!   trc_ini : Initialization for passive tracer 
     12   !!   'key_passivetrc'                                    Passive tracers 
    913   !!---------------------------------------------------------------------- 
     14   !!   trc_ini :   Initialization for passive tracer 
    1015   !!---------------------------------------------------------------------- 
    11    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    12    !! $Header$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    14    !!---------------------------------------------------------------------- 
    15    !! * Modules used 
    1616   USE oce_trc 
    1717   USE trc 
    … …  
    2323   PRIVATE 
    2424 
    25    !! * Accessibility 
    26    PUBLIC trc_ini 
     25   PUBLIC   trc_ini   ! called by ??? 
    2726 
    28 #if defined key_trc_lobster1 
     27# if defined key_trc_lobster1 
    2928   !!---------------------------------------------------------------------- 
    3029   !!   'key_trc_lobster1'                        LOBSTER1 biological model   
    … …  
    3231#  include "trcini.lobster1.h90" 
    3332 
    34 #elif defined key_trc_pisces 
     33# elif defined key_trc_pisces 
    3534   !!---------------------------------------------------------------------- 
    3635   !!   'key_trc_pisces'                            PISCES biological model                   
    … …  
    3837#  include "trcini.pisces.h90" 
    3938 
    40 #elif defined key_cfc 
     39# elif defined key_cfc 
    4140   !!---------------------------------------------------------------------- 
    4241   !!   'key_cfc  '                                          CFC model                   
    … …  
    4443#  include "trcini.cfc.h90" 
    4544 
    46 #else 
     45# else 
    4746   !!---------------------------------------------------------------------- 
    4847   !!   Default option                                
     48   !!---------------------------------------------------------------------- 
     49   !!---------------------------------------------------------------------- 
     50   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     51   !! $Header:$  
     52   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4953   !!---------------------------------------------------------------------- 
    5054 
    … …  
    5256 
    5357   SUBROUTINE trc_ini 
    54       !!--------------------------------------------------------------------- 
     58      !!------------------------------------------------------------------- 
    5559      !!                    ***  ROUTINE trc_ini  *** 
    5660      !!               
    57       !! ** Purpose : Initialization for passive tracer 
    58       !!              for restart or not 
    59       !! 
    60       !! History : 
    61       !!        !  00-04  O. Aumont, M.A. Foujols HAMOCC3 and P3ZD 
    62       !!   8.5  !  05-03  O.Aumont and A.El Moussaoui  F90 
    63       !!   9.0  !  05-10  C. Ethe  Modularity 
    64       !!---------------------------------------------------------------------- 
    65       !! * local declarations 
    66       INTEGER ::                   &  
    67          ji ,jj ,jk ,jn, jl        ! dummy loop indices   
    68       !!--------------------------------------------------------------------- 
     61      !! ** Purpose :   Initialization of all passive tracer to zero 
     62      !!              (default case) 
     63      !!------------------------------------------------------------------- 
     64      INTEGER ::   ji ,jj ,jk ,jn, jl        ! dummy loop indices   
     65      !!------------------------------------------------------------------- 
    6966 
     67      IF(lwp) WRITE(numout,*) 
     68      IF(lwp) WRITE(numout,*) 'trc_ini : initial set up of the passive tracers' 
     69      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    7070 
    71       !! 1. initialization of passives tracers field 
    72       !! ------------------------------------------- 
     71      ! initialization of passives tracers field 
     72      ! ---------------------------------------- 
    7373      DO jn = 1, jptra 
    74          trn(:,:,:,jn)=0.e0 
    75          tra(:,:,:,jn)=0.e0 
     74         trn(:,:,:,jn) = 0.e0 
     75         tra(:,:,:,jn) = 0.e0 
    7676      END DO 
    7777 
    78 #if defined key_trc_diaadd 
    79       !! initialization of output 2d and 3d arrays 
     78#  if defined key_trc_diaadd 
     79      ! initialization of output 2d and 3d arrays 
     80      DO jn = 1, jpdia2d 
     81         trc2d(:,:,jn) = 0.e0 
     82      END DO 
     83      DO jn = 1, jpdia3d 
     84         trc3d(:,:,:,jn) = 0.e0 
     85      END DO 
     86#  endif 
    8087 
    81       DO jn = 1, jpdia2d 
    82          trc2d(:,:,jn)=0.e0 
    83       END DO 
    84  
    85       DO jn = 1, jpdia3d 
    86          trc3d(:,:,:,jn)=0.e0 
    87       END DO 
    88 #endif 
    89  
    90 #if defined key_trc_diabio 
    91       !! initialization of biological trends 
    92       DO jn=1,jpdiabio 
     88#  if defined key_trc_diabio 
     89      ! initialization of biological trends 
     90      DO jn = 1, jpdiabio 
    9391         trbio(:,:,:,jn) = 0.e0 
    9492      END DO 
    95 #endif 
     93#  endif 
    9694 
    97 #if defined key_trc_diatrd 
    98       !! initialization of tracer trends 
     95#  if defined key_trc_diatrd 
     96      ! initialization of tracer trends 
    9997      DO jl = 1, jpdiatrc 
    10098         DO jn = 1, jptra 
    101             IF (luttrd(jn)) trtrd(:,:,:,ikeep(jn),jl) = 0.e0 
     99            IF( luttrd(jn) )  trtrd(:,:,:,ikeep(jn),jl) = 0.e0 
    102100         END DO 
    103101      END DO 
    104 #endif       
    105  
    106       IF( lwp ) THEN 
    107          WRITE(numout,*) ' ' 
    108          WRITE(numout,*) ' trcini: generic initialisation done ' 
    109          WRITE(numout,*) ' ' 
    110       ENDIF 
    111  
     102#  endif       
     103      ! 
    112104   END SUBROUTINE trc_ini 
    113105 
    114 #endif 
     106# endif 
    115107 
    116108#else 
    … …  
    120112CONTAINS 
    121113   SUBROUTINE trc_ini              ! Empty routine 
    122  
    123114   END SUBROUTINE trc_ini 
    124115#endif 

  • branches/dev_001_GM/NEMO/TOP_SRC/trclec.F90

    r719 r763  
    11MODULE trclec 
    2    !!========================================================================== 
    3    !! 
    4    !!                       *** MODULE trclec *** 
    5    !! Read and print options for the passive tracer run (namelist) 
    6    !! O.Aumont and A.El Moussaoui 03/05 F90 
    7    !!========================================================================= 
    8    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    9    !! $Header$  
    10    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     2   !!====================================================================== 
     3   !!                       ***  MODULE trclec  *** 
     4   !! TOP :   Read and print options for the passive tracer run (namelist) 
     5   !!====================================================================== 
     6   !! History :    -   !  1996-11  (M.A. Foujols, M. Levy)  original code 
     7   !!              -   !  1998-04  (M.A Foujols, L. Bopp) ahtrb0 for isopycnal mixing 
     8   !!              -   !  1999-10  (M.A. Foujols, M. Levy) separation of sms 
     9   !!              -   !  2000-07  (A. Estublier) add TVD and MUSCL : Tests on ndttrc 
     10   !!              -   !  2000-11  (M.A Foujols, E Kestenare) trcrat, ahtrc0 and aeivtr0 
     11   !!              -   !  2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes 
     12   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
    1113   !!---------------------------------------------------------------------- 
    1214#if defined key_passivetrc 
    13    !! * Modules used 
    14    !! ============== 
     15   !!---------------------------------------------------------------------- 
     16   !!   'key_passivetrc'                                    Passive tracers 
     17   !!---------------------------------------------------------------------- 
     18   !!   trc_lec    :  Read and print options for the passive tracer run (namelist) 
     19   !!---------------------------------------------------------------------- 
    1520   USE oce_trc 
    1621   USE trc 
    … …  
    2126   PRIVATE  
    2227 
    23    !! * Accessibility 
    24    PUBLIC trc_lec 
    25  
    26 #include "passivetrc_substitute.h90" 
     28   PUBLIC trc_lec      ! called in ??? 
     29 
     30   !! * Substitutions 
     31#  include "passivetrc_substitute.h90" 
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     34   !! $Header:$  
     35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
    2737 
    2838CONTAINS 
    … …  
    3040   SUBROUTINE trc_lec 
    3141      !!--------------------------------------------------------------------- 
    32       !!                       ROUTINE trclec 
    33       !!                     ****************** 
    34       !!  PURPOSE : 
    35       !!  --------- 
    36       !!     READ and PRINT options for the passive tracer run (namelist) 
     42      !!                     ***  ROUTINE trc_lec  *** 
    3743      !! 
    38       !!   History: 
    39       !!   -------- 
    40       !!      original  : 96-11 (M.A. Foujols, M. Levy) passive tracer 
    41       !!      modification : 98-04 (M.A Foujols, L. Bopp) ahtrb0 for isopycnal 
    42       !!                                                  diffusion 
    43       !!      modification : 99-10(M.A. Foujols, M. Levy) separation of sms 
    44       !!      additions : 00-05(A. Estublier) TVD Limiter Scheme : Tests  
    45       !!                                      on ndttrc 
    46       !!      additions : 00-06(A. Estublier) MUSCL Scheme : Tests  
    47       !!                                      on ndttrc 
    48       !!      additions : 00-07(A. Estublier) PPM Scheme : Tests on ndttrc 
    49       !!      modification : 00-11 (M.A Foujols, E Kestenare) trcrat, ahtrc0 and aeivtr0 
    50       !!      modification : 01-01 (E Kestenare) suppress ndttrc=1  
    51       !!                                         for Arakawa and TVD schemes 
    52       !!     O.Aumont and A.El Moussaoui 03/05 F90 
    53       !!---------------------------------------------------------------------- 
    54  
    55       !! local declarations 
    56       !! ================== 
    57  
     44      !! ** Purpose :   READ and PRINT options for the passive tracer run (namelist)  
     45      !! 
     46      !! ** Method  : - read namelist 
     47      !!--------------------------------------------------------------------- 
    5848      INTEGER ::  ji 
    5949      CHARACTER (len=32) :: clname 
    60  
     50      !! 
     51      NAMELIST/nattrc/ nwritetrc, lrsttr, nrsttr, ctrcnm, ctrcnl, ctrcun, lutini     ! general    
     52      NAMELIST/natnum/ rsc, rtrn, ncortrc, ndttrc, crosster 
     53#if defined key_trc_diatrd 
     54      NAMELIST/natrtd/ luttrd, nwritetrd                                             ! dynamical trends 
     55#endif 
     56#if defined key_trc_diaadd 
     57      NAMELIST/natadd/ ctrc3d, ctrc3l, ctrc2d, ctrc2l, ctrc3u, ctrc2u, nwriteadd     ! additional diagnostics 
     58#endif 
    6159      !!--------------------------------------------------------------------- 
    62       !!  OPA.90   03/2005  
    63       !!--------------------------------------------------------------------- 
    64  
    65       !! 0. initializations 
    66       !! ------------------ 
    67  
    68       namelist/nattrc/nwritetrc,lrsttr,nrsttr, ctrcnm,ctrcnl,ctrcun,lutini     !general    
    69  
    70       namelist/natnum/rsc,rtrn,ncortrc,ndttrc,crosster 
    71  
    72 #if defined key_trc_diatrd 
    73       namelist/natrtd/luttrd,nwritetrd                      ! dynamical trends 
    74 #endif 
    75  
    76 #if defined key_trc_diaadd 
    77       namelist/natadd/ctrc3d,ctrc3l,ctrc2d,ctrc2l, ctrc3u, ctrc2u,     & 
    78          nwriteadd                             !additional diagnostics 
    79 #endif 
    80  
    81       IF(lwp) THEN 
    82          WRITE(numout,*) ' ' 
    83          WRITE(numout,*) ' ROUTINE trclec' 
    84          WRITE(numout,*) ' **************' 
    85          WRITE(numout,*) ' ' 
    86          WRITE(numout,*) ' namelist for passive tracer' 
    87          WRITE(numout,*) ' ***************************' 
    88          WRITE(numout,*) ' ' 
    89       ENDIF 
    90  
    91       clname='namelist.passivetrc' 
     60 
     61      IF(lwp) WRITE(numout,*) 
     62      IF(lwp) WRITE(numout,*) 'trc_lec : read the passive tracer namelists' 
     63      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     64 
     65      clname = 'namelist.passivetrc' 
    9266      CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    9367         &         1, numout, .FALSE., 1 ) 
    9468 
    9569 
    96       !! 1., 2. & 3. initialization with namelist files 
    97       !! ---------------------------------------------- 
    98       !! 1.0 namelist nattrc : 
    99  
    100       nwritetrc = 10 
    101       lrsttr=.FALSE. 
    102       nrsttr = 0 
    103  
    104       DO ji=1,jptra 
    105          WRITE (ctrcnm(ji),'("TR_",I1)') ji 
    106          WRITE (ctrcnl(ji),'("TRACER NUMBER ",I1)') ji 
    107          ctrcun(ji)='mmole/m3' 
    108          lutini(ji)=.FALSE.  
    109       END DO 
    110  
    111  
    112       REWIND(numnat) 
    113       READ(numnat,nattrc) 
    114  
    115       IF(lwp) THEN 
    116          WRITE(numout,*) ' ' 
    117          WRITE(numout,*) 'nattrc' 
    118          WRITE(numout,*) ' ' 
    119          WRITE(numout,*)          & 
    120             ' frequency of outputs for passive tracers nwritetrc = '    & 
    121             ,nwritetrc   
    122          WRITE(numout,*) ' restart LOGICAL for passive tr. lrsttr = ',   & 
    123             &         lrsttr 
    124          WRITE(numout,*) ' control of time step for p. tr. nrsttr = ',   &  
    125             &         nrsttr 
    126          DO ji=1,jptra 
    127             WRITE(numout,*) ' tracer nb: ',ji,' name = ',ctrcnm(ji)       &  
    128                &           ,ctrcnl(ji)  
    129             WRITE(numout,*) ' in unit = ',ctrcun(ji) 
    130             WRITE(numout,*) ' initial value in FILE : ',lutini(ji)  
    131             WRITE(numout,*) ' ' 
    132          END DO 
    133          WRITE(numout,*) ' ' 
     70      ! Namelist nattrc (files) 
     71      ! ---------------------------------------------- 
     72      nwritetrc = 10                 ! default values 
     73      lrsttr    = .FALSE. 
     74      nrsttr    =  0 
     75      DO ji = 1, jptra 
     76         WRITE(ctrcnm(ji),'("TR_",I1)'           ) ji 
     77         WRITE(ctrcnl(ji),'("TRACER NUMBER ",I1)') ji 
     78         ctrcun(ji) = 'mmole/m3' 
     79         lutini(ji) = .FALSE.  
     80      END DO 
     81 
     82      REWIND( numnat )               ! read nattrc 
     83      READ  ( numnat, nattrc ) 
     84 
     85      IF(lwp) THEN                   ! control print 
     86         WRITE(numout,*) 
     87         WRITE(numout,*) ' Namelist : nattrc' 
     88         WRITE(numout,*) '    frequency of outputs for passive tracers nwritetrc = ', nwritetrc   
     89         WRITE(numout,*) '    restart LOGICAL for passive tr. lrsttr = ', lrsttr 
     90         WRITE(numout,*) '    control of time step for p. tr. nrsttr = ', nrsttr 
     91         DO ji = 1, jptra 
     92            WRITE(numout,*) '    tracer nb: ', ji, ' name = ', ctrcnm(ji), ctrcnl(ji), ' in unit = ',ctrcun(ji) 
     93            WRITE(numout,*) '    initial value in FILE : ',lutini(ji)  
     94         END DO 
    13495      ENDIF 
    13596 
    13697#if defined key_trc_diatrd 
    13798 
    138       !! 1.2 namelist nattrd : passive tracers dynamical trends 
    139  
    140       nwritetrd=10 
    141  
    142       !! default : no dynamical trend recording 
    143       !! -------------------------------------- 
    144       DO ji=1,jptra 
     99      ! Namelist natrtd (transport trends) 
     100      ! ---------------------------------------------- 
     101      nwritetrd = 10                 ! default values (no dynamical trend recording) 
     102      DO ji = 1, jptra 
    145103         luttrd(ji) = .FALSE. 
    146104      END DO 
    147105 
    148       REWIND(numnat) 
    149       READ(numnat,natrtd) 
     106      REWIND( numnat )               ! read natrtd 
     107      READ  ( numnat, natrtd ) 
    150108 
    151109      nkeep=0 
    152110      ikeep(:)=0 
    153       DO ji=1,jptra 
    154          IF (luttrd(ji)) THEN  
    155              nkeep=nkeep+1 
     111      DO ji = 1, jptra 
     112         IF( luttrd(ji) ) THEN  
     113             nkeep    = nkeep + 1 
    156114             ikeep(ji)=nkeep 
    157115         END IF  
    158116      END DO 
    159       IF (nkeep.GT.0) THEN   
    160         IF (.NOT. ALLOCATED(trtrd)) ALLOCATE(trtrd(jpi,jpj,jpk,nkeep,jpdiatrc))  
    161         trtrd(:,:,:,:,:)=0.0 
     117      IF( nkeep > 0 ) THEN   
     118        IF(.NOT. ALLOCATED( trtrd ) )   ALLOCATE( trtrd(jpi,jpj,jpk,nkeep,jpdiatrc) )  
     119        trtrd(:,:,:,:,:) = 0.e0 
    162120      ENDIF  
    163       IF(lwp) THEN 
    164          WRITE(numout,*) 'natrtd' 
    165          WRITE(numout,*) ' ' 
    166          WRITE(numout,*)                        & 
    167             ' frequency of outputs for dynamical trends nwritetrd = '   & 
    168             ,nwritetrd 
    169          DO ji=1,jptra 
    170             WRITE(numout,*)                      & 
    171                ' keep dynamical trends for tracer number :',ji          & 
    172                ,luttrd(ji), ikeep(ji) 
    173          END DO 
    174          WRITE(numout,*) 'total = ',nkeep,' tracers dyn trends saved' 
    175          WRITE(numout,*) 'size of trtrd = ',jpi*jpj*jpk*nkeep*jpdiatrc 
    176       ENDIF 
    177 #endif 
    178  
    179       !!1.3 namelist natadd : passive tracers diagnostics 
    180       !!------------------------------------------------- 
     121 
     122      IF(lwp) THEN                   ! control print 
     123         WRITE(numout,*) 
     124         WRITE(numout,*) ' Namelist : natrtd' 
     125         WRITE(numout,*) '    frequency of outputs for dynamical trends nwritetrd = ', nwritetrd 
     126         DO ji = 1, jptra 
     127            WRITE(numout,*) '    keep dynamical trends for tracer number :', ji, luttrd(ji), ikeep(ji) 
     128         END DO 
     129         WRITE(numout,*) '    total = ', nkeep, ' tracers dyn trends saved' 
     130         WRITE(numout,*) '    size of trtrd = ', jpi*jpj*jpk*nkeep*jpdiatrc 
     131      ENDIF 
     132#endif 
    181133 
    182134#if defined key_trc_diaadd 
    183135 
    184       nwriteadd = 10 
    185  
    186       !! default value for 3D output arrays : short and long name, units 
    187  
    188       DO ji=1,jpdia3d 
    189          WRITE (ctrc3d(ji),'("3D_",I1)') ji 
    190          WRITE (ctrc3l(ji),'("3D DIAGNOSTIC NUMBER ",I2)') ji 
    191          ctrc3u(ji)=' ' 
    192       END DO 
    193  
    194  
    195       !! default value for 2D output arrays : short and long name, units 
    196       !! --------------------------------------------------------------- 
    197       DO ji=1,jpdia2d 
    198          WRITE (ctrc2d(ji),'("2D_",I1)') ji 
    199          WRITE (ctrc2l(ji),'("2D DIAGNOSTIC NUMBER ",I2)') ji 
    200          ctrc2u(ji)=' ' 
    201       END DO 
    202  
    203       REWIND(numnat) 
    204       READ(numnat,natadd) 
    205  
    206       IF(lwp) THEN 
    207          WRITE(numout,*) ' natadd' 
    208          WRITE(numout,*) ' ' 
    209          WRITE(numout,*)                          & 
    210             ' frequency of outputs for additional arrays nwriteadd = '   & 
    211             ,nwriteadd 
    212          DO ji=1,jpdia3d 
    213             WRITE(numout,*)                     & 
    214                'name of 3d output field number :',ji,' : ',ctrc3d(ji)   
    215             WRITE(numout,*) ctrc3l(ji)   
    216             WRITE(numout,*) ' in unit = ',ctrc3u(ji) 
    217          END DO 
    218          WRITE(numout,*) ' ' 
    219          DO ji=1,jpdia2d 
    220             WRITE(numout,*)                    & 
    221                'name of 2d output field number :',ji,' : ',ctrc2d(ji)   
    222             WRITE(numout,*) ctrc2l(ji)   
    223             WRITE(numout,*) ' in unit = ',ctrc2u(ji) 
    224          END DO 
    225          WRITE(numout,*) ' ' 
    226       ENDIF 
    227 #endif 
    228  
    229       !! 1.1 namelist natnum : 
    230       !! --------------------- 
    231       rsc=1. 
    232       rtrn=1.e-15 
    233       ncortrc=1 
    234       ndttrc=4 
    235       crosster=.FALSE. 
    236  
    237       REWIND(numnat) 
    238       READ(numnat,natnum) 
    239  
    240 !!Chris  computes the first time step of tracer model 
     136      ! Namelist natrtd (transport trends) 
     137      ! ---------------------------------------------- 
     138      nwriteadd = 10                 ! default values  
     139      !                                 ! 3D output arrays 
     140      DO ji = 1, jpdia3d 
     141         WRITE(ctrc3d(ji),'("3D_",I1)') ji                      ! short name 
     142         WRITE(ctrc3l(ji),'("3D DIAGNOSTIC NUMBER ",I2)') ji    ! long name 
     143         ctrc3u(ji) = ' '                                       ! units  
     144      END DO 
     145      !                                 ! 2D output arrays 
     146      DO ji = 1, jpdia2d 
     147         WRITE(ctrc2d(ji),'("2D_",I1)') ji                      ! short name 
     148         WRITE(ctrc2l(ji),'("2D DIAGNOSTIC NUMBER ",I2)') ji    ! long name 
     149         ctrc2u(ji) = ' '                                       ! units 
     150      END DO 
     151 
     152      REWIND( numnat )               ! read natrtd 
     153      READ  ( numnat, natadd ) 
     154 
     155      IF(lwp) THEN                   ! control print 
     156         WRITE(numout,*) 
     157         WRITE(numout,*) ' Namelist : natadd' 
     158         WRITE(numout,*) '    frequency of outputs for additional arrays nwriteadd = ', nwriteadd 
     159         DO ji = 1, jpdia3d 
     160            WRITE(numout,*) '    3d output field No :',ji,' names ',ctrc3d(ji), ctrc3l(ji), ' in ', ctrc3u(ji) 
     161         END DO 
     162         DO ji = 1, jpdia2d 
     163            WRITE(numout,*) '    2d output field No :',ji,' names ',ctrc2d(ji), ctrc2l(ji), ' in ', ctrc2u(ji) 
     164         END DO 
     165      ENDIF 
     166#endif 
     167 
     168      !! Namelist natnum : 
     169      !! ----------------- 
     170      rsc      = 1.                 ! default values 
     171      rtrn     = 1.e-15 
     172      ncortrc  = 1 
     173      ndttrc   = 4 
     174      crosster = .FALSE. 
     175 
     176      REWIND( numnat )              ! read natnum 
     177      READ  ( numnat, natnum ) 
     178 
     179      !!Chris  computes the first time step of tracer model 
    241180      nittrc000 = nit000 + ndttrc - 1 
    242181 
    243       IF(lwp) THEN 
    244          WRITE(numout,*) ' ' 
    245          WRITE(numout,*) 'natnum' 
    246          WRITE(numout,*) ' ' 
    247          WRITE(numout,*) ' tuning coefficient              rsc     = ',    & 
    248             rsc 
    249          WRITE(numout,*) ' truncation value                rtrn    = ',    & 
    250             rtrn 
    251          WRITE(numout,*) ' number of corrective phase      ncortrc = ',    & 
    252             ncortrc 
    253          WRITE(numout,*) ' time step freq. for pass. trac. ndttrc  = ',    & 
    254             ndttrc 
    255          WRITE(numout,*) ' 1st time step for pass. trac. nittrc000 = ',    & 
    256             nittrc000 
    257          WRITE(numout,*) ' computes or not crossterms    crosster  = ',    & 
    258             crosster 
    259       ENDIF 
    260  
    261  
    262       !! namelist of transport 
    263       !! --------------------- 
     182      IF(lwp) THEN                  ! control print 
     183         WRITE(numout,*) 
     184         WRITE(numout,*) ' Namelist : natnum' 
     185         WRITE(numout,*) 
     186         WRITE(numout,*) ' tuning coefficient              rsc     = ', rsc 
     187         WRITE(numout,*) ' truncation value                rtrn    = ', rtrn 
     188         WRITE(numout,*) ' number of corrective phase      ncortrc = ', ncortrc 
     189         WRITE(numout,*) ' time step freq. for pass. trac. ndttrc  = ', ndttrc 
     190         WRITE(numout,*) ' 1st time step for pass. trac. nittrc000 = ', nittrc000 
     191         WRITE(numout,*) ' computes or not crossterms    crosster  = ', crosster 
     192      ENDIF 
     193 
     194      ! namelist of transport 
     195      ! --------------------- 
    264196      CALL trc_trp_lec 
    265197 
    266       !! namelist of SMS 
    267       !! ---------------       
     198      ! namelist of SMS 
     199      ! ---------------       
    268200      CALL trc_lsm 
    269  
     201      ! 
    270202   END SUBROUTINE trc_lec 
    271203 
    272204#else 
     205   !!---------------------------------------------------------------------- 
     206   !!  Dummy module :                                     No passive tracer 
     207   !!---------------------------------------------------------------------- 
     208CONTAINS 
     209   SUBROUTINE trc_lec                      ! Empty routine    
     210   END SUBROUTINE trc_lec 
     211#endif 
     212 
    273213   !!====================================================================== 
    274    !!  Empty module : No passive tracer 
    275    !!====================================================================== 
    276 CONTAINS 
    277  
    278    SUBROUTINE trc_lec 
    279  
    280    END SUBROUTINE trc_lec 
    281  
    282 #endif 
    283  
    284214END MODULE  trclec 

  • branches/dev_001_GM/NEMO/TOP_SRC/trclsm.F90

    r719 r763  
    11MODULE trclsm 
    2    !!=============================================================== 
    3    !! 
    4    !!                       *** MODULE trclsm **** 
    5    !! 
    6    !!  READS specific NAMELIST for sms terms 
    7    !! 
    8    !!================================================================= 
    9    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    10    !! $Header$  
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    12    !!----------------------------------------------------------------- 
     2   !!====================================================================== 
     3   !!                         ***  MODULE trclsm  *** 
     4   !! TOP :   reads specific namelist for passive tracer sms terms 
     5   !!====================================================================== 
     6   !! History :   1.0  !  2004-03 (C. Ethe) Original code 
     7   !!---------------------------------------------------------------------- 
     8   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     9   !! $Header:$  
     10   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     11   !!---------------------------------------------------------------------- 
    1312#if defined key_passivetrc 
    14    !!------------------------------------------------------------- 
    15    !! * Modules used 
    16    !! ============== 
     13   !!---------------------------------------------------------------------- 
     14   !!   'key_passivetrc'                                    Passive tracers 
     15   !!---------------------------------------------------------------------- 
     16   !!   trc_lsm   : eads specific namelist for sms terms 
     17   !!---------------------------------------------------------------------- 
    1718   USE oce_trc 
    1819   USE trc 
    1920   USE sms 
    2021 
    21  
    2222   IMPLICIT NONE                              
    2323   PRIVATE 
    2424 
    25    !! * Accessibility 
    26    PUBLIC trc_lsm 
    27  
     25   PUBLIC   trc_lsm      ! calles in ??? 
    2826 
    2927#if defined key_trc_lobster1 
    … …  
    4139#elif defined key_cfc 
    4240   !!---------------------------------------------------------------------- 
    43    !!   'key_cfc  '                                          CFC model                   
     41   !!   'key_cfc'                                                 CFC model                   
    4442   !!---------------------------------------------------------------------- 
    4543#  include "trclsm.cfc.h90" 
    4644 
    47    !!---------------------------------------------------------------------- 
    48    !!   Default option                                
    49    !!---------------------------------------------------------------------- 
    5045# endif 
    5146 
    5247#else 
    53  
     48   !!---------------------------------------------------------------------- 
     49   !!  Dummy module :                                     No passive tracer 
     50   !!---------------------------------------------------------------------- 
    5451CONTAINS 
    55  
    56    SUBROUTINE trc_lsm 
    57       !!================ 
    58       !! no passive tracers 
     52   SUBROUTINE trc_lsm                      ! Empty routine 
    5953   END  SUBROUTINE  trc_lsm 
    60  
    6154#endif   
    6255 
     56   !!====================================================================== 
    6357END MODULE trclsm   

  • branches/dev_001_GM/NEMO/TOP_SRC/trcrst.F90

    r730 r763  
    11MODULE trcrst 
    22   !!====================================================================== 
    3    !! 
    4    !!                       *** MODULE trcrst *** 
    5    !! 
    6    !!   Read the restart files for passive tracers 
    7    !! 
     3   !!                       ***  MODULE trcrst  *** 
     4   !! TOP :   create, write, read the restart files for passive tracers 
    85   !!====================================================================== 
    9    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    10    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/trcrst.F90,v 1.11 2007/10/17 14:48:56 opalod Exp $  
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    12    !!---------------------------------------------------------------------- 
    13 #if defined key_passivetrc    
    14    !!---------------------------------------------------------------------- 
    15    !! * Modules used 
    16    !! ============== 
     6   !! History :   1.0  !  2007-02 (C. Ethe) adaptation from the ocean 
     7   !!---------------------------------------------------------------------- 
     8#if defined key_passivetrc 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_passivetrc'                                    Passive tracers 
     11   !!---------------------------------------------------------------------- 
     12   !!   trc_rst_opn    : open  restart file 
     13   !!   trc_rst_read   : read  restart file 
     14   !!   trc_rst_wri    : write restart file 
     15   !!---------------------------------------------------------------------- 
    1716   USE oce_trc 
    1817   USE trc 
    … …  
    2524   PRIVATE 
    2625    
    27    !! * Accessibility 
    28    PUBLIC trc_rst_opn 
    29    PUBLIC trc_rst_read 
    30    PUBLIC trc_rst_wri 
    31     
    32    !! * Module variables 
     26   PUBLIC   trc_rst_opn       ! called by ??? 
     27   PUBLIC   trc_rst_read      ! called by ??? 
     28   PUBLIC   trc_rst_wri       ! called by ??? 
     29    
    3330   LOGICAL, PUBLIC ::   lrst_trc         !: logical to control the trc restart write  
    3431   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write) 
    3532 
    36  
    3733   !! * Substitutions 
    3834#  include "passivetrc_substitute.h90" 
     35   !!---------------------------------------------------------------------- 
     36   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     37   !! $Id:$  
     38   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    3940    
    4041CONTAINS 
    … …  
    5253      !!---------------------------------------------------------------------- 
    5354      ! 
    54  
    5555      IF( kt == nit000 )  THEN 
    5656         lrst_trc = .FALSE. 
    57 #if defined key_off_tra 
     57# if defined key_off_tra 
    5858         nitrst = nitend  ! in online version, already done in rst_opn routine defined in restart.F90 module 
    59 #endif 
     59# endif 
    6060      ENDIF 
    6161       
    … …  
    6363         ! beware if model runs less than 2*ndttrc time step 
    6464         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    65          IF( nitrst > 1.0e9 ) THEN    
    66             WRITE(clkt,*) nitrst 
    67          ELSE 
    68             WRITE(clkt,'(i8.8)') nitrst 
     65         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
     66         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
    6967         ENDIF 
    7068         ! create the file 
    … …  
    8078 
    8179   SUBROUTINE trc_rst_read  
    82       !!=========================================================================================== 
     80      !!---------------------------------------------------------------------- 
     81      !!                    ***  trc_rst_opn  *** 
    8382      !! 
    84       !!                       ROUTINE trc_rst_read 
    85       !!                       ******************* 
    86       !! 
    87       !!  PURPOSE : 
    88       !!  --------- 
    89       !!     READ files for restart for passive tracer 
    90       !! 
    91       !!   METHOD : 
    92       !!   ------- 
    93       !!      READ the previous fields on the FILE nutrst 
    94       !!      the first record indicates previous characterics 
    95       !!      after control with the present run, we READ : 
    96       !!      - prognostic variables on the second and more record 
    97       !! 
    98       !!   History: 
    99       !!   -------- 
    100       !!  original  : 96-11 
    101       !!  00-05 (A. Estublier) TVD Limiter Scheme key_trc_tvd  
    102       !!  00-12 (O. Aumont, E. Kestenare) read restart file for sediments  
    103       !!  01-05 (O. Aumont, E. Kestenare) read restart file for calcite and silicate sediments  
    104       !!  05-03 (O. Aumont and A. El Moussaoui) F90            
    105       !!------------------------------------------------------------------------ 
    106       INTEGER ::  ji, jj, jk, jn   
    107       INTEGER ::  iarak0     
    108       REAL(wp) :: zkt, zarak0 
    109       REAL(wp) :: caralk, bicarb, co3 
    110  
    111 #if defined key_trc_pisces  
    112 #   if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 
    113       REAL(wp) ::  ztrasum 
    114 #   endif 
    115 #endif 
    116  
    117       !!--------------------------------------------------------------------- 
    118       !!  OPA.9 03-2005   
    119       !!--------------------------------------------------------------------- 
    120       !! 0. initialisations 
    121       !!------------------ 
    122  
    123  
    124       IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN 
    125          iarak0 = 1 
    126       ELSE 
    127          iarak0 = 0 
    128       ENDIF 
    129  
    130  
    131       IF(lwp) WRITE(numout,*) ' ' 
    132       IF(lwp) WRITE(numout,*) ' *** trc_rst beginning of restart for' 
    133       IF(lwp) WRITE(numout,*) ' passive tracer' 
    134       IF(lwp) WRITE(numout,*) ' the present run :' 
    135       IF(lwp) WRITE(numout,*) '   with the time nit000 : ',nit000 
    136       IF(lwp) THEN 
    137          IF( iarak0 == 1 ) THEN 
    138             WRITE(numout,*) '   and before fields for Arakawa sheme ' 
    139          ENDIF 
    140          WRITE(numout,*) ' ' 
     83      !! ** purpose  :   read passive tracer fields in restart files 
     84      !!---------------------------------------------------------------------- 
     85      INTEGER  ::   ji, jj, jk, jn   
     86      INTEGER  ::   iarak0     
     87      REAL(wp) ::   zkt, zarak0 
     88      REAL(wp) ::   caralk, bicarb, co3 
     89      REAL(wp) ::   ztrasum 
     90      !!---------------------------------------------------------------------- 
     91 
     92      IF(lwp) WRITE(numout,*) 
     93      IF(lwp) WRITE(numout,*) 'trc_rst_read : read restart file of the passive tracers' 
     94      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     95 
     96      ztrasum = 0.e0 
     97      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   iarak0 = 1 
     98      ELSE                                           ;   iarak0 = 0 
     99      ENDIF 
     100 
     101      IF(lwp) WRITE(numout,*) 
     102      IF(lwp) WRITE(numout,*) ' the present run starts at the time step nit000 = ', nit000 
     103      IF(lwp .AND. iarak0 == 1 )   WRITE(numout,*) '   and needs previous fields for Arakawa sheme ??? ' 
    141104      ENDIF 
    142105 
    143106      ! Time domain : restart 
    144107      ! ------------------------- 
    145  
    146       IF(lwp) WRITE(numout,*) 
    147108      IF(lwp) WRITE(numout,*) 
    148109      IF(lwp) WRITE(numout,*) ' *** passive tracer restart option' 
    … …  
    168129      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zkt    ) 
    169130      IF(lwp) WRITE(numout,*) '   arakawa option      : ', NINT( zarak0 ) 
    170       IF(lwp) WRITE(numout,*) 
    171  
    172  
    173       !! control of date 
    174       !! ------------------- 
    175  
    176       IF( nittrc000 - NINT( zkt ) /= 1 .AND. nrsttr /= 0 )  & 
    177            & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 
    178            & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 
    179  
    180       !! Control of the scheme 
    181       !! ------------------------ 
    182  
    183       IF( iarak0 /= NINT( zarak0 ) ) & 
    184            & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 
    185            & ' it must be the same type for both restart and previous run', & 
    186            & ' centered or euler '  ) 
    187  
    188  
    189       !! ... READ prognostic variables and computes diagnostic variable 
    190       !! --------------------------------------------------------------- 
    191  
     131 
     132 
     133      IF( nittrc000 - NINT( zkt ) /= 1 .AND. nrsttr /= 0 )  &      ! control of date 
     134         &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 
     135         &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 
     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 
     142 
     143      ! READ prognostic variables and computes diagnostic variable 
    192144      DO jn = 1, jptra 
    193          CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn)   )  
     145         CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )  
     146         CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )  
    194147      END DO 
    195  
    196       DO jn = 1, jptra 
    197          CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn)   )  
    198       END DO 
    199  
    200 #if defined key_trc_lobster1 
     148# if defined key_trc_lobster1 
    201149      CALL iom_get( numrtr, jpdom_local, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )  
    202150      CALL iom_get( numrtr, jpdom_local, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )  
    203  
    204 #elif defined key_trc_pisces 
     151# elif defined key_trc_pisces 
    205152      CALL iom_get( numrtr, jpdom_local, 'Silicalim', xksi(:,:) )  
    206153      xksimax = xksi 
    207  
    208 #elif defined key_cfc 
     154# elif defined key_cfc 
    209155      DO jn = 1, jptra 
    210          CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn),qint(:,:,jn))  
     156         CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn), qint(:,:,jn) )  
     157         CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) )  
    211158      END DO 
    212       DO jn = 1, jptra 
    213          CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) ,qtr( :,:,jn))  
    214       END DO 
    215 #endif 
    216  
    217  
    218 #if defined key_trc_pisces  
    219  
    220 #if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )  
    221  
    222       ztrasum = 0. 
    223       DO jk = 1, jpk 
    224          DO jj = 1, jpj 
    225             DO ji = 1, jpi 
    226                ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
    227 #if defined key_off_degrad 
    228                   &              * facvol(ji,jj,jk)   & 
    229 #endif 
    230  
    231                   &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    232             END DO 
    233          END DO 
    234       END DO 
    235  
    236       IF( lk_mpp ) THEN  
    237          CALL mpp_sum( ztrasum )     ! sum over the global domain   
    238       END IF 
    239  
    240       WRITE(0,*) 'TALK moyen ', ztrasum/areatot*1E6 
    241       ztrasum = ztrasum/areatot*1E6 
    242       trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./ztrasum 
    243  
    244       ztrasum = 0. 
    245       DO jk = 1, jpk 
    246          DO jj = 1, jpj 
    247             DO ji = 1, jpi 
    248                ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
    249 #if defined key_off_degrad 
    250                   &              * facvol(ji,jj,jk)   & 
    251 #endif 
    252  
    253                   &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    254             END DO 
    255          END DO 
    256       END DO 
    257  
    258       IF( lk_mpp ) THEN  
    259          CALL mpp_sum( ztrasum )     ! sum over the global domain   
    260       END IF 
    261  
    262  
    263       WRITE(0,*) 'PO4 moyen ', ztrasum/areatot*1E6/122. 
    264       ztrasum = ztrasum/areatot*1E6/122. 
    265       trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/ztrasum 
    266  
    267       ztrasum = 0. 
    268       DO jk = 1, jpk 
    269          DO jj = 1, jpj 
    270             DO ji = 1, jpi 
    271                ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
    272 #if defined key_off_degrad 
    273                   &              * facvol(ji,jj,jk)   & 
    274 #endif 
    275  
    276                   &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    277             END DO 
    278          END DO 
    279       END DO 
    280  
    281       IF( lk_mpp ) THEN  
    282          CALL mpp_sum( ztrasum )     ! sum over the global domain   
    283       END IF 
    284  
    285  
    286       WRITE(0,*) 'NO3 moyen ', ztrasum/areatot*1E6/7.6 
    287       ztrasum = ztrasum/areatot*1E6/7.6 
    288       trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/ztrasum 
    289  
    290       ztrasum = 0. 
    291       DO jk = 1, jpk 
    292          DO jj = 1, jpj 
    293             DO ji = 1, jpi 
    294                ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj)   & 
    295 #if defined key_off_degrad 
    296                   &              * facvol(ji,jj,jk)   & 
    297 #endif 
    298  
    299                   &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    300             END DO 
    301          END DO 
    302       END DO 
    303  
    304       IF( lk_mpp ) THEN  
    305          CALL mpp_sum( ztrasum )     ! sum over the global domain   
    306       END IF 
    307  
    308       WRITE(0,*) 'SiO3 moyen ', ztrasum/areatot*1E6 
    309       ztrasum = ztrasum/areatot*1E6 
    310       trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/ztrasum)  
    311  
    312 #endif 
     159# endif 
     160 
     161# if defined key_trc_pisces  
     162      !                                                         ! --------------------------- ! 
     163      IF( cp_cfg == "orca" .AND. .NOT. lk_trccfg_1d ) THEN      ! ORCA condiguration (not 1D) ! 
     164         !                                                      ! --------------------------- ! 
     165         !                                                      ! set total alkalinity, phosphate, NO3 & silicate 
     166         !                          ! total alkalinity 
     167         ztrasum = 0.e0             ! ---------------- 
     168         DO jk = 1, jpk 
     169            DO jj = 1, jpj 
     170               DO ji = 1, jpi 
     171                  ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     172#  if defined key_off_degrad 
     173                     &              * facvol(ji,jj,jk)   & 
     174#  endif 
     175                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     176               END DO 
     177            END DO 
     178         END DO 
     179         IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     180 
     181         IF(lwp) WRITE(numout,*) 'TALK moyen ', ztrasum / areatot * 1.e6 
     182         ztrasum = ztrasum / areatot * 1.e6 
     183         trn(:,:,:,jptal) = trn(:,:,:,jptal) * 2391. / ztrasum 
     184 
     185         !                          ! phosphate 
     186         ztrasum = 0.e0             ! --------- 
     187         DO jk = 1, jpk 
     188            DO jj = 1, jpj 
     189               DO ji = 1, jpi 
     190                  ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     191#  if defined key_off_degrad 
     192                     &              * facvol(ji,jj,jk)   & 
     193#  endif 
     194                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     195               END DO 
     196            END DO 
     197         END DO 
     198         IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     199 
     200         IF(lwp) WRITE(numout,*) 'PO4 moyen ', ztrasum/areatot*1E6/122. 
     201         ztrasum = ztrasum / areatot * 1.e6 / 122. 
     202         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * 2.165 / ztrasum 
     203 
     204         !                          ! NO3 
     205         ztrasum = 0.e0             ! --- 
     206         DO jk = 1, jpk 
     207            DO jj = 1, jpj 
     208               DO ji = 1, jpi 
     209                  ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     210#  if defined key_off_degrad 
     211                     &              * facvol(ji,jj,jk)   & 
     212#  endif 
     213                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     214               END DO 
     215            END DO 
     216         END DO 
     217         IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     218 
     219         IF(lwp) WRITE(numout,*) 'NO3 moyen ', ztrasum / areatot*1.e6 / 7.6 
     220         ztrasum = ztrasum / areatot * 1.e6 / 7.6 
     221         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * 30.9 / ztrasum 
     222 
     223         !                          ! Silicate 
     224         ztrasum = 0.e0             ! -------- 
     225         DO jk = 1, jpk 
     226            DO jj = 1, jpj 
     227               DO ji = 1, jpi 
     228                  ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj)   & 
     229#  if defined key_off_degrad 
     230                     &              * facvol(ji,jj,jk)   & 
     231#  endif 
     232                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     233               END DO 
     234            END DO 
     235         END DO 
     236         IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     237 
     238         IF(lwp) WRITE(numout,*) 'SiO3 moyen ', ztrasum / areatot * 1.e6 
     239         ztrasum = ztrasum / areatot * 1.e6 
     240         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * 91.51 / ztrasum )  
     241         ! 
     242      ENDIF 
    313243 
    314244!#if defined key_trc_kriest 
    … …  
    319249!      trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 
    320250!#endif 
    321       !!  Initialization of chemical variables of the carbon cycle 
    322       !!  -------------------------------------------------------- 
    323       DO jk = 1,jpk 
    324          DO jj = 1,jpj 
     251      !!  Set hi (???) from  total alcalinity, borat (???), akb3 (???) and ak23 (???) 
     252      !!  --------------------------------------------------------------------- 
     253      DO jk = 1, jpk 
     254         DO jj = 1, jpj 
    325255            DO ji = 1,jpi 
    326                caralk = trn(ji,jj,jk,jptal)-       & 
    327                   &        borat(ji,jj,jk)/(1.+1.E-8/(rtrn+akb3(ji,jj,jk))) 
    328                co3 = (caralk-trn(ji,jj,jk,jpdic))*tmask(ji,jj,jk)   & 
    329                   &        +(1.-tmask(ji,jj,jk))*.5e-3 
    330                bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk) 
    331                hi(ji,jj,jk) = (ak23(ji,jj,jk)*bicarb/co3)     & 
    332                   &  *tmask(ji,jj,jk)+(1.-tmask(ji,jj,jk))*1.e-9 
    333             ENDDO 
    334          ENDDO 
    335       ENDDO 
    336 #endif 
     256               caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.e-8 / ( rtrn + akb3(ji,jj,jk) ) ) 
     257               co3    = ( caralk - trn(ji,jj,jk,jpdic) ) *       tmask(ji,jj,jk)   & 
     258                  &   +             0.5e-3               * ( 1.- tmask(ji,jj,jk) ) 
     259               bicarb = 2.* trn(ji,jj,jk,jpdic) - caralk 
     260               hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 )   *       tmask(ji,jj,jk) 
     261                  &         +             1.0e-9                  * ( 1.- tmask(ji,jj,jk) ) 
     262            END DO 
     263         END DO 
     264      END DO 
     265# endif 
    337266      trb(:,:,:,:) = trn(:,:,:,:) 
    338267 
    339268      CALL iom_close( numrtr ) 
    340  
    341  
     269      ! 
    342270   END SUBROUTINE trc_rst_read 
    343271 
    344    SUBROUTINE trc_rst_wri(kt) 
    345       !! ================================================================================== 
     272 
     273   SUBROUTINE trc_rst_wri( kt ) 
     274      !!---------------------------------------------------------------------- 
     275      !!                    ***  trc_rst_wri  *** 
    346276      !! 
    347       !!                       ROUTINE trc_rst_wri 
    348       !!                       ****************** 
     277      !! ** purpose  :   write passive tracer fields in restart files 
     278      !!---------------------------------------------------------------------- 
     279      INTEGER, INTENT( in ) ::    kt 
    349280      !! 
    350       !!  PURPOSE : 
    351       !!  --------- 
    352       !!     WRITE restart fields in nutwrs 
    353       !!   METHOD : 
    354       !!   ------- 
    355       !! 
    356       !!   nutwrs FILE: 
    357       !!   each nstock time step , SAVE fields which are necessary for 
    358       !!   passive tracer restart 
    359       !! 
    360       !! 
    361       !!   INPUT : 
    362       !!   ----- 
    363       !!      argument 
    364       !!              kt              : time step 
    365       !!      COMMON 
    366       !!            /cottrc/          : passive tracers fields (before,now 
    367       !!                                  ,after) 
    368       !! 
    369       !!   OUTPUT : 
    370       !!   ------ 
    371       !!      FILE 
    372       !!           nutwrs          : standard restart fields OUTPUT 
    373       !! 
    374       !!   WORKSPACE : 
    375       !!   --------- 
    376       !!      ji,jj,jk,jn 
    377       !! 
    378       !!   History: 
    379       !!   -------- 
    380       !!      original : 96-12 
    381       !!      addition : 99-12 (M.-A. Foujols) NetCDF FORMAT with ioipsl 
    382       !!      additions : 00-05 (A. Estublier) 
    383       !!                  TVD Limiter Scheme : key_trc_tvd 
    384       !!      additions : 01-01 (M.A Foujols, E. Kestenare) bug fix: restclo 
    385       !!      additions : 01-01 (O. Aumont, E. Kestenare) 
    386       !!                  write restart file for sediments 
    387       !!      additions : 01-05 (O. Aumont, E. Kestenare) 
    388       !!                  write restart file for calcite and silicate sediments 
    389       !!   05-03 (O. Aumont and A. El Moussaoui) F90 
    390       !!========================================================================================! 
    391  
    392       !! * Arguments 
    393       !! ----------- 
    394       INTEGER, INTENT( in ) :: kt 
    395  
    396       !! * local declarations 
    397       !! ==================== 
    398  
    399281      INTEGER  :: ji,jj,jk,jn 
    400282      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 
    401283      REAL(wp) :: zder 
    402  
    403  
    404       !! 1. OUTPUT of restart fields (nutwrs) 
    405       !! --------------------------- 
    406  
    407       IF( MOD(kt,nstock) == 0 .OR. kt == nitend ) THEN 
    408  
    409          !! 0. initialisations 
    410          !! ------------------ 
    411  
    412          IF(lwp) WRITE(numout,*) ' ' 
    413          IF(lwp) WRITE(numout,*) 'trc_wri : write the passive tracer restart file in NetCDF format ',   & 
    414             'at it= ',kt,' date= ',ndastp 
     284      !!---------------------------------------------------------------------- 
     285 
     286      IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN 
     287 
     288         ! 0. initialisations 
     289         ! ------------------ 
     290         IF(lwp) WRITE(numout,*) 
     291         IF(lwp) WRITE(numout,*) 'trc_wri : write the passive tracer restart file (NetCDF) ',   & 
     292            &                              'at it= ',kt,' date= ',ndastp 
    415293         IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
    416294 
    … …  
    427305         ! prognostic variables 
    428306         ! -------------------- 
    429  
    430          DO jn=1,jptra 
     307         DO jn = 1, jptra 
    431308            CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    432          ENDDO 
    433  
    434          DO jn=1,jptra 
    435309            CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    436310         END DO 
    … …  
    443317 
    444318#elif defined key_cfc 
    445          DO jn=1,jptra 
     319         DO jn = 1, jptra 
    446320            CALL iom_rstput( kt, nitrst, numrtw, 'qint'//ctrcnm(jn), qint(:,:,jn) ) 
    447          END DO 
    448          DO jn=1,jptra 
    449321            CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) ) 
    450322         END DO 
    451323#endif 
    452324 
    453          IF (lwp) WRITE(numout,*) '----TRACER STAT----' 
    454  
    455          zdiag_tot=0. 
    456          DO jn=1,jptra 
    457             zdiag_var=0. 
    458             zdiag_varmin=0. 
    459             zdiag_varmax=0. 
    460  
    461             DO ji=1, jpi 
    462                DO jj=1, jpj 
    463                   DO jk=1,jpk 
    464                      zdiag_var=zdiag_var+trn(ji,jj,jk,jn)*tmask(ji,jj,jk)*tmask_i(ji,jj)  & 
     325         IF(lwp) WRITE(numout,*) '----TRACER STAT----' 
     326 
     327         zdiag_tot = 0.e0 
     328         DO jn = 1, jptra 
     329            zdiag_var    = 0.e0 
     330            zdiag_varmin = 0.e0 
     331            zdiag_varmax = 0.e0 
     332            DO ji = 1, jpi 
     333               DO jj = 1, jpj 
     334                  DO jk = 1,jpk 
     335                     zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * tmask(ji,jj,jk) * tmask_i(ji,jj)   & 
    465336#if defined key_off_degrad 
    466337                        &   * facvol(ji,jj,jk)   & 
    467338#endif 
    468339                        &   * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    469  
    470340                  END DO 
    471341               END DO 
    472342            END DO 
    473343 
    474             zdiag_varmin=MINVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.))) 
    475             zdiag_varmax=MAXVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.))) 
     344            zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     345            zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    476346 
    477347            IF( lk_mpp ) THEN 
    478                CALL mpp_min(zdiag_varmin)      ! min over the global domain 
    479                CALL mpp_max(zdiag_varmax)      ! max over the global domain 
    480                CALL mpp_sum(zdiag_var)         ! sum over the global domain 
     348               CALL mpp_min( zdiag_varmin )      ! min over the global domain 
     349               CALL mpp_max( zdiag_varmax )      ! max over the global domain 
     350               CALL mpp_sum( zdiag_var    )      ! sum over the global domain 
    481351            END IF 
    482352 
    483             zdiag_tot=zdiag_tot+zdiag_var 
    484             zdiag_var=zdiag_var/areatot 
    485  
    486             IF (lwp) WRITE(numout,*) 'MEAN NO ',jn,ctrcnm(jn),' =',zdiag_var,'MIN= '  & 
    487                ,zdiag_varmin,'MAX= ',zdiag_varmax 
    488  
     353            zdiag_tot = zdiag_tot + zdiag_var 
     354            zdiag_var = zdiag_var / areatot 
     355 
     356            IF(lwp) WRITE(numout,*) 'MEAN NO ', jn, ctrcnm(jn), ' =', zdiag_var,   & 
     357               &                    'MIN= ', zdiag_varmin, 'MAX= ', zdiag_varmax 
    489358         END DO 
    490359 
    … …  
    495364 
    496365         CALL iom_close(numrtw) 
    497  
    498       ENDIF 
    499  
     366         ! 
     367      ENDIF 
     368      ! 
    500369   END SUBROUTINE trc_rst_wri 
    501370 
    502  
    503371#else 
    504    !!====================================================================== 
    505    !!  Empty module : No passive tracer 
    506    !!====================================================================== 
     372   !!---------------------------------------------------------------------- 
     373   !!  Dummy module :                                    No passive tracer 
     374   !!---------------------------------------------------------------------- 
    507375CONTAINS 
    508  
    509    SUBROUTINE trc_rst_read 
    510       !! no passive tracers 
     376   SUBROUTINE trc_rst_read                      ! Empty routines 
    511377   END SUBROUTINE trc_rst_read 
    512  
    513    SUBROUTINE trc_rst_wri(kt) 
    514       !! no passive tracers 
     378   SUBROUTINE trc_rst_wri( kt ) 
    515379      INTEGER, INTENT ( in ) :: kt 
    516380      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt 
    517    END SUBROUTINE trc_rst_wri 
    518     
     381   END SUBROUTINE trc_rst_wri    
    519382#endif 
    520     
     383 
     384   !!====================================================================== 
    521385END MODULE trcrst 

  • branches/dev_001_GM/NEMO/TOP_SRC/trcsms.F90

    r719 r763  
    11MODULE trcsms 
    2    !!=========================================================================================== 
    3    !! 
    4    !!                       *** MODULE trcsms *** 
    5    !! 
    6    !!  Time  loop of opa for passive tracer 
    7    !! 
    8    !!=========================================================================================== 
    9    !!  TOP 1.0,  LOCEAN-IPSL (2005)  
    10    !! $Header$  
    11    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     2   !!====================================================================== 
     3   !!                         ***  MODULE trcsms  *** 
     4   !! TOP :   Time loop of passive tracers sms 
     5   !!====================================================================== 
     6   !! History :   1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
    127   !!---------------------------------------------------------------------- 
    13 #if defined key_passivetrc    
    14    !! * Modules used 
    15    !! ============== 
     8#if defined key_passivetrc 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_passivetrc'                                    Passive tracers 
     11   !!---------------------------------------------------------------------- 
     12   !!   trc_sms    :  Time loop of passive tracers sms 
     13   !!---------------------------------------------------------------------- 
    1614   USE oce_trc 
    1715   USE trc 
    1816   USE trcfreons 
    19    USE prtctl_trc          ! Print control for debbuging 
     17   USE prtctl_trc           ! Print control for debbuging 
    2018 
    2119   IMPLICIT NONE 
    2220   PRIVATE 
    2321 
    24    !! * Accessibility 
    25    PUBLIC trc_sms 
     22   PUBLIC      trc_sms      ! called in ??? 
     23 
     24   !!---------------------------------------------------------------------- 
     25   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     26   !! $Header:$  
     27   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     28   !!---------------------------------------------------------------------- 
    2629 
    2730CONTAINS 
    2831 
    2932   SUBROUTINE trc_sms( kt ) 
    30       !!=========================================================================================== 
     33      !!--------------------------------------------------------------------- 
     34      !!                     ***  ROUTINE ini_trc  *** 
    3135      !! 
    32       !!                       ROUTINE trcsms 
    33       !!                     ***************** 
     36      !! ** Purpose :   Managment of the time loop of passive tracers sms  
    3437      !! 
    35       !!  PURPOSE : 
    36       !!  --------- 
    37       !!          time loop of opa for passive tracer 
     38      !! ** Method  : - ??? 
     39      !! ------------------------------------------------------------------------------------- 
     40      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    3841      !! 
    39       !!   METHOD : 
    40       !!   ------- 
    41       !!      compute the well/spring evolution 
    42       !! 
    43       !!   INPUT : 
    44       !!   ----- 
    45       !!      argument 
    46       !!              ktask           : task identificator 
    47       !!              kt              : time step 
    48       !!      COMMON 
    49       !!            all the COMMON defined in opa 
    50       !! 
    51       !! 
    52       !!   OUTPUT :        : no 
    53       !!   ------ 
    54       !! 
    55       !!   WORKSPACE : 
    56       !!   --------- 
    57       !! 
    58       !!   EXTERNAL : 
    59       !!   -------- 
    60       !!      trcbio, trcsed, trcopt for NPZD or LOBSTER1 models 
    61       !! 
    62       !!      h3cprg for HAMOC3 and P3ZD models 
    63       !! 
    64       !! 
    65       !!   History: 
    66       !!   -------- 
    67       !!      original  : 96-11 
    68       !!      additions : 99-07 (M. Levy) 
    69       !!                  04-00 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD 
    70       !!                  12-00 (O. Aumont, E. Kestenare) add trcexp for instantaneous export  
    71       !!   05-03 (O. Aumont and A. El Moussaoui) F90 
    72       !! ------------------------------------------------------------------------------------- 
     42      CHARACTER (len=25) :: charout 
     43      !!--------------------------------------------------------------------- 
    7344 
    74       !! * Arguments 
    75       !! ----------- 
    76       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    77  
    78       !! * Local variables 
    79       !! ----------------- 
    80  
    81       CHARACTER (len=25) :: charout 
    82  
    83       !! this ROUTINE is called only every ndttrc time step 
    84       !! -------------------------------------------------- 
    85  
    86       IF ( MOD(kt,ndttrc) /= 0) RETURN 
    87  
    88       !! this first routines are parallelized on vertical slab 
    89       !! ------------------------------------------------------ 
     45      IF ( MOD(kt,ndttrc) /= 0) RETURN      ! this ROUTINE is called only every ndttrc time step 
    9046 
    9147#if defined key_trc_lobster1 
    9248 
    93       !! tracers: optical model 
    94       !! ---------------------- 
     49      ! LOBSTER biological model 
     50      ! ------------------------ 
    9551 
    96       CALL trcopt( kt) 
     52      CALL trcopt( kt )      ! optical model 
    9753 
    9854      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    9955         WRITE(charout, FMT="('OPT')") 
    10056         CALL prt_ctl_trc_info(charout) 
    101          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     57         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm ) 
    10258      ENDIF 
    10359 
    104       !! tracers: biological model 
    105       !! ------------------------- 
    106  
    107       CALL trcbio( kt) 
     60      CALL trcbio( kt )      ! biological model 
    10861 
    10962      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    11366      ENDIF 
    11467 
    115       !! tracers: sedimentation model 
    116       !! ---------------------------- 
     68      CALL trcsed( kt )      ! sedimentation model 
    11769 
    118       CALL trcsed(kt) 
    11970      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    12071         WRITE(charout, FMT="('SED')") 
    … …  
    12374      ENDIF 
    12475  
    125       CALL trcexp(kt) 
     76      CALL trcexp( kt )      ! export 
    12677 
    12778      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    13384#elif defined key_trc_pisces 
    13485 
    135       !! p4zprg: main PROGRAM for PISCES  
    136       !! ------------------------------- 
    137       CALL p4zprg(kt) 
     86      ! PISCES biological model 
     87      ! ------------------------ 
    13888 
    139       !! SMS to DO 
     89      CALL p4zprg(kt)      ! main program of PISCES  
     90 
     91 
     92      !                    ! split in  SMS to be DONE here 
    14093 
    14194#elif defined key_cfc 
    14295 
    143       !! CFC's code taken from K. Rodgers 
     96      ! CFC chemical model (code taken from K. Rodgers) 
     97      ! ------------------ 
    14498 
    145       !! This part is still experimental 
    146       !! ------------------------------- 
    147  
    148       CALL trc_freons(kt) 
     99      CALL trc_freons( kt )      ! surface fluxes of CFC 
    149100 
    150101#endif 
    151  
    152  
    153  
     102      ! 
    154103   END SUBROUTINE trc_sms 
    155104 
    156105#else 
    157106   !!====================================================================== 
    158    !!  Empty module : No passive tracer 
     107   !!  Dummy module :                                    No passive tracer 
    159108   !!====================================================================== 
    160109CONTAINS 
    161  
    162    SUBROUTINE trc_sms( kt ) 
    163  
    164       ! no passive tracers 
     110   SUBROUTINE trc_sms( kt )                   ! Empty routine 
    165111      INTEGER, INTENT( in ) ::   kt 
    166112      WRITE(*,*) 'trc_sms: You should not have seen this print! error?', kt 
    167113   END SUBROUTINE trc_sms 
    168  
    169114#endif  
    170115 
    171  
     116   !!====================================================================== 
    172117END MODULE  trcsms 
Note: See TracChangeset for help on using the changeset viewer.