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

Changeset 2104


Ignore:
Timestamp:
2010-09-17T14:35:46+02:00 (14 years ago)
Author:
cetlod
Message:

update DEV_r2006_merge_TRA_TRC according to review

Location:
branches/DEV_r2006_merge_TRA_TRC/NEMO
Files:
99 edited

Legend:

Unmodified
Added
Removed

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/C1D_SRC/step_c1d.F90

    r1465 r2104  
    160160      ! N.B. ua, va arrays are used as workspace in this section 
    161161      !----------------------------------------------------------------------- 
    162                              ta(:,:,:) = 0.e0                ! set tracer trends to zero 
    163                              sa(:,:,:) = 0.e0 
     162                             tsa(:,:,:,:) = 0.e0                ! set tracer trends to zero 
    164163 
    165164                             CALL tra_sbc    ( kstp )        ! surface boundary condition 
    … …  
    167166      IF( lk_zdfkpp )        CALL tra_kpp    ( kstp )        ! KPP non-local tracer fluxes 
    168167                             CALL tra_zdf    ( kstp )        ! vertical mixing 
    169                              CALL tra_nxt( kstp )            ! tracer fields at next time step 
    170       IF( ln_zdfnpc      )   CALL tra_npc( kstp )            ! applied non penetrative convective adjustment on (t,s) 
    171                              CALL eos( tb, sb, rhd, rhop )   ! now (swap=before) in situ density for dynhpg module 
     168                             CALL tra_nxt    ( kstp )        ! tracer fields at next time step 
     169      IF( ln_zdfnpc      )   CALL tra_npc    ( kstp )        ! applied non penetrative convective adjustment on (t,s) 
     170                             CALL eos( tsb, rhd, rhop )   ! now (swap=before) in situ density for dynhpg module 
    172171 
    173172      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/NST_SRC/agrif_user.F90

    r2082 r2104  
    11#if defined key_agrif 
    22   !!---------------------------------------------------------------------- 
    3    !!   OPA 9.0 , LOCEAN-IPSL (2006) 
     3   !! NEMO/NST 3.3 , LOCEAN-IPSL (2010)  
    44   !! $Id$ 
    55   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    5555   END SUBROUTINE Agrif_InitWorkspace 
    5656 
    57 #if ! defined key_off_tra 
     57#if ! defined key_offline 
    5858 
    5959   SUBROUTINE Agrif_InitValues 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DIA/diaar5.F90

    r2082 r2104  
    44   !! AR5 diagnostics 
    55   !!====================================================================== 
    6    !! History : 3.2  !  2009-11  (S. Masson)  Original code 
     6   !! History :  3.2  !  2009-11  (S. Masson)  Original code 
     7   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    78   !!---------------------------------------------------------------------- 
    89#if defined key_diaar5 
    … …  
    1011   !!   'key_diaar5'  :                           activate ar5 diagnotics 
    1112   !!---------------------------------------------------------------------- 
    12    !!   exa_mpl       : liste of module subroutine (caution, never use the 
    13    !!   exa_mpl_init  : name of the module for a routine) 
    14    !!   exa_mpl_stp   : Please try to use 3 letter block for routine names 
     13   !!   dia_ar5       : AR5 diagnostics 
     14   !!   dia_ar5_init  : initialisation of AR5 diagnostics 
    1515   !!---------------------------------------------------------------------- 
    1616   USE oce            ! ocean dynamics and active tracers  
    … …  
    3737#  include "domzgr_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    40    !! $Id$  
     39   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     40   !! $Id$ 
    4141   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 
    … …  
    4848      !!                    ***  ROUTINE dia_ar5  *** 
    4949      !! 
    50       !! ** Purpose :   Brief description of the routine 
    51       !! 
    52       !! ** Method  :   description of the methodoloy used to achieve the 
    53       !!                objectives of the routine. Be as clear as possible! 
    54       !! 
    55       !! ** Action  : - first action (share memory array/varible modified 
    56       !!                in this routine 
    57       !!              - second action ..... 
    58       !!              - ..... 
    59       !! 
    60       !! References :   Author et al., Short_name_review, Year 
    61       !!                Give references if exist otherwise suppress these lines 
     50      !! ** Purpose :   compute and output some AR5 diagnostics 
     51      !! 
    6252      !!---------------------------------------------------------------------- 
    6353      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    … …  
    155145      !!                  ***  ROUTINE dia_ar5_init  *** 
    156146      !!                    
    157       !! ** Purpose :   initialization of .... 
    158       !! 
    159       !! ** Method  :   blah blah blah ... 
    160       !! 
    161       !! ** input   :   Namlist namexa 
    162       !! 
    163       !! ** Action  :   ...   
     147      !! ** Purpose :   initialization for AR5 diagnostic computation 
     148      !! 
    164149      !!---------------------------------------------------------------------- 
    165150      INTEGER  ::   inum 
    … …  
    206191   !!   Default option :                                         NO diaar5 
    207192   !!---------------------------------------------------------------------- 
    208  
    209193   LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE.   ! coupled flag 
    210  
    211194CONTAINS 
    212  
     195   SUBROUTINE dia_ar5_init    ! Dummy routine 
     196   END SUBROUTINE dia_ar5_init 
    213197   SUBROUTINE dia_ar5( kt )   ! Empty routine 
    214       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     198      INTEGER ::   kt 
    215199      WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt 
    216200   END SUBROUTINE dia_ar5 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DTA/dtasal.F90

    r1951 r2104  
    6969      !! * Local declarations 
    7070      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies 
    71       INTEGER ::   imois, iman, i15 , ik          ! temporary integers 
    72       INTEGER ::   ierror 
     71      INTEGER ::   ik, ierror                     ! temporary integers 
    7372#if defined key_tradmp 
    7473      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
    7574#endif 
    76       REAL(wp)::   zxy, zl 
     75      REAL(wp)::   zl 
    7776#if defined key_orca_lev10 
    7877      INTEGER ::   ikr, ikw, ikt, jjk  
    7978      REAL(wp)::   zfac 
    8079#endif 
    81       REAL(wp), DIMENSION(jpk) ::   zsaldta            ! auxiliary array for interpolation 
     80      REAL(wp), DIMENSION(jpk) :: zsaldta         ! auxiliary array for interpolation 
    8281      CHARACTER(len=100)       :: cn_dir          ! Root directory for location of ssr files 
    8382      TYPE(FLD_N)              :: sn_sal 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DTA/dtatem.F90

    r1951 r2104  
    7474      !! * Local declarations 
    7575      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies 
    76       INTEGER ::   imois, iman, i15 , ik          ! temporary integers 
    77       INTEGER ::   ierror 
     76      INTEGER ::   ik, ierror                     ! temporary integers 
    7877#if defined key_tradmp 
    7978      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
    8079#endif 
    81       REAL(wp)::   zxy, zl 
     80      REAL(wp)::   zl 
    8281#if defined key_orca_lev10 
    8382      INTEGER ::   ikr, ikw, ikt, jjk  

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynadv.F90

    r2027 r2104  
    44   !! Ocean active tracers:  advection scheme control 
    55   !!============================================================================== 
    6    !! History :  9.0  !  06-11  (G. Madec)  Original code 
     6   !! History :  1.0  !  2006-11  (G. Madec)  Original code 
     7   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    78   !!---------------------------------------------------------------------- 
    89 
    910   !!---------------------------------------------------------------------- 
    1011   !!   dyn_adv      : compute the momentum advection trend  
    11    !!   dyn_adv_ctl : control the different options of advection scheme 
     12   !!   dyn_adv_init : control the different options of advection scheme 
    1213   !!---------------------------------------------------------------------- 
    1314   USE dom_oce         ! ocean space and time domain 
    … …  
    2526   PUBLIC dyn_adv_init  ! routine called by opa module 
    2627  
    27    LOGICAL, PUBLIC ::   ln_dynadv_vec  = .TRUE.    ! vector form flag 
    28    LOGICAL, PUBLIC ::   ln_dynadv_cen2 = .FALSE.   ! flux form - 2nd order centered scheme flag 
    29    LOGICAL, PUBLIC ::   ln_dynadv_ubs  = .FALSE.   ! flux form - 3rd order UBS scheme flag 
     28   LOGICAL, PUBLIC ::   ln_dynadv_vec  = .TRUE.    !: vector form flag 
     29   LOGICAL, PUBLIC ::   ln_dynadv_cen2 = .FALSE.   !: flux form - 2nd order centered scheme flag 
     30   LOGICAL, PUBLIC ::   ln_dynadv_ubs  = .FALSE.   !: flux form - 3rd order UBS scheme flag 
    3031    
    3132   INTEGER ::   nadv   ! choice of the formulation and scheme for the advection 
    … …  
    3536#  include "vectopt_loop_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    37    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
    38    !! $Id$  
     38   !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010)  
     39   !! $Id$ 
    3940   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4041   !!---------------------------------------------------------------------- 
    … …  
    8485      !!---------------------------------------------------------------------- 
    8586      INTEGER ::   ioptio 
    86  
     87      !! 
    8788      NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs 
    8889      !!---------------------------------------------------------------------- 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2027 r2104  
    44   !! Ocean dynamics:  hydrostatic pressure gradient trend 
    55   !!====================================================================== 
    6    !! History :  1.0  !  87-09  (P. Andrich, M.-A. Foujols)  hpg_zco: Original code 
    7    !!            5.0  !  91-11  (G. Madec) 
    8    !!            7.0  !  96-01  (G. Madec)  hpg_sco: Original code for s-coordinates 
    9    !!            8.0  !  97-05  (G. Madec)  split dynber into dynkeg and dynhpg 
    10    !!            8.5  !  02-07  (G. Madec)  F90: Free form and module 
    11    !!            8.5  !  02-08  (A. Bozec)  hpg_zps: Original code 
    12    !!            9.0  !  05-10  (A. Beckmann, B.W. An)  various s-coordinate options 
     6   !! History :  OPA  !  1987-09  (P. Andrich, M.-A. Foujols)  hpg_zco: Original code 
     7   !!            5.0  !  1991-11  (G. Madec) 
     8   !!            7.0  !  1996-01  (G. Madec)  hpg_sco: Original code for s-coordinates 
     9   !!            8.0  !  1997-05  (G. Madec)  split dynber into dynkeg and dynhpg 
     10   !!            8.5  !  2002-07  (G. Madec)  F90: Free form and module 
     11   !!            8.5  !  2002-08  (A. Bozec)  hpg_zps: Original code 
     12   !!   NEMO     1.0  !  2005-10  (A. Beckmann, B.W. An)  various s-coordinate options 
    1313   !!                           Original code for hpg_ctl, hpg_hel hpg_wdj, hpg_djc, hpg_rot  
    14    !!            9.0  !  05-11  (G. Madec) style & small optimisation 
     14   !!             -   !  2005-11  (G. Madec) style & small optimisation 
     15   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    1516   !!---------------------------------------------------------------------- 
    1617 
    … …  
    1819   !!   dyn_hpg      : update the momentum trend with the now horizontal 
    1920   !!                  gradient of the hydrostatic pressure 
    20    !!       hpg_init : initialisation and control of options 
     21   !!   dyn_hpg_init : initialisation and control of options 
    2122   !!       hpg_zco  : z-coordinate scheme 
    2223   !!       hpg_zps  : z-coordinate plus partial steps (interpolation) 
    … …  
    4041 
    4142   PUBLIC   dyn_hpg        ! routine called by step module 
    42    PUBLIC       hpg_init   ! routine called by opa module 
     43   PUBLIC   dyn_hpg_init   ! routine called by opa module 
    4344 
    4445   !                                              !!* Namelist namdyn_hpg : hydrostatic pressure gradient  
    … …  
    6061#  include "vectopt_loop_substitute.h90" 
    6162   !!---------------------------------------------------------------------- 
    62    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    63    !! $Id$  
     63   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     64   !! $Id$ 
    6465   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6566   !!---------------------------------------------------------------------- 
    … …  
    109110 
    110111 
    111    SUBROUTINE hpg_init 
    112       !!---------------------------------------------------------------------- 
    113       !!                 ***  ROUTINE hpg_init  *** 
     112   SUBROUTINE dyn_hpg_init 
     113      !!---------------------------------------------------------------------- 
     114      !!                 ***  ROUTINE dyn_hpg_init  *** 
    114115      !! 
    115116      !! ** Purpose :   initializations for the hydrostatic pressure gradient 
    … …  
    121122      INTEGER ::   ioptio = 0      ! temporary integer 
    122123      !! 
    123 !     NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   & 
    124 !        &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   & 
    125 !        &                 ln_dynhpg_imp, nn_dynhpg_rst 
    126       !!---------------------------------------------------------------------- 
    127  
    128 !     REWIND ( numnam )               ! Namelist namdyn_hpg : already read in opa.F90 module 
    129 !     READ   ( numnam, namdyn_hpg ) 
    130  
    131       IF(lwp) THEN                    ! Control print 
     124      NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   & 
     125         &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   & 
     126         &                 ln_dynhpg_imp, nn_dynhpg_rst 
     127      !!---------------------------------------------------------------------- 
     128      ! 
     129      REWIND( numnam )               ! Read Namelist namdyn_hpg 
     130      READ  ( numnam, namdyn_hpg ) 
     131      ! 
     132      IF(lwp) THEN                   ! Control print 
    132133         WRITE(numout,*) 
    133          WRITE(numout,*) 'dyn_hpg : hydrostatic pressure gradient' 
    134          WRITE(numout,*) '~~~~~~~' 
     134         WRITE(numout,*) 'dyn_hpg_init : hydrostatic pressure gradient initialisation' 
     135         WRITE(numout,*) '~~~~~~~~~~~~' 
    135136         WRITE(numout,*) '   Namelist namdyn_hpg : choice of hpg scheme' 
    136137         WRITE(numout,*) '      z-coord. - full steps                             ln_hpg_zco    = ', ln_hpg_zco 
    … …  
    145146         WRITE(numout,*) '      add in restart dynhpg semi-implicit variable      nn_dynhpg_rst = ', nn_dynhpg_rst 
    146147      ENDIF 
    147  
    148       IF( .NOT. ln_dynhpg_imp )   nn_dynhpg_rst = 0      ! force no adding dynhpg implicit variables in restart 
    149  
    150       IF( lk_vvl .AND. .NOT. ln_hpg_sco )   THEN 
    151          CALL ctl_stop( 'hpg_ctl : variable volume key_vvl compatible only with the standard jacobian formulation hpg_sco') 
    152       ENDIF 
    153  
     148      ! 
     149      IF( .NOT. ln_dynhpg_imp )   nn_dynhpg_rst = 0      ! force no additional dynhpg implicit variables in restart file 
     150      ! 
     151      IF( lk_vvl .AND. .NOT. ln_hpg_sco )   & 
     152         &   CALL ctl_stop( 'dyn_hpg_init : variable volume key_vvl require the standard jacobian formulation hpg_sco') 
     153      ! 
    154154      !                               ! Set nhpg from ln_hpg_... flags 
    155155      IF( ln_hpg_zco )   nhpg = 0 
    … …  
    160160      IF( ln_hpg_djc )   nhpg = 5 
    161161      IF( ln_hpg_rot )   nhpg = 6 
    162  
     162      ! 
    163163      !                               ! Consitency check 
    164164      ioptio = 0  
    … …  
    171171      IF( ln_hpg_rot )   ioptio = ioptio + 1 
    172172      IF ( ioptio /= 1 )   CALL ctl_stop( ' NO or several hydrostatic pressure gradient options used' ) 
    173  
    174       ! 
    175    END SUBROUTINE hpg_init 
     173      ! 
     174   END SUBROUTINE dyn_hpg_init 
    176175 
    177176 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynldf.F90

    r2027 r2104  
    88 
    99   !!---------------------------------------------------------------------- 
    10    !!   dyn_ldf     : update the dynamics trend with the lateral diffusion 
    11    !!   dyn_ldf_ctl : initialization, namelist read, and parameters control 
     10   !!   dyn_ldf      : update the dynamics trend with the lateral diffusion 
     11   !!   dyn_ldf_init : initialization, namelist read, and parameters control 
    1212   !!---------------------------------------------------------------------- 
    1313   USE oce            ! ocean dynamics and tracers 
    … …  
    3131 
    3232   PUBLIC   dyn_ldf       ! called by step module  
    33    PUBLIC   dyn_ldf_init  ! called by opa module  
     33   PUBLIC   dyn_ldf_init  ! called by opa  module  
    3434 
    3535   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals) 
    … …  
    3838#  include "domzgr_substitute.h90" 
    3939#  include "vectopt_loop_substitute.h90" 
    40    !!--------------------------------------------------------------------------------- 
    41    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     40   !!---------------------------------------------------------------------- 
     41   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    4242   !! $Id$ 
    4343   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynvor.F90

    r2027 r2104  
    1414   !!            2.0  !  2006-11  (G. Madec)  flux form advection: add metric term 
    1515   !!            3.2  !  2009-04  (R. Benshila)  vvl: correction of een scheme 
     16   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    1617   !!---------------------------------------------------------------------- 
    1718 
    1819   !!---------------------------------------------------------------------- 
    19    !!   dyn_vor     : Update the momentum trend with the vorticity trend 
    20    !!       vor_ens : enstrophy conserving scheme       (ln_dynvor_ens=T) 
    21    !!       vor_ene : energy conserving scheme          (ln_dynvor_ene=T) 
    22    !!       vor_mix : mixed enstrophy/energy conserving (ln_dynvor_mix=T) 
    23    !!       vor_een : energy and enstrophy conserving   (ln_dynvor_een=T) 
    24    !!       vor_ctl : set and control of the different vorticity option 
     20   !!   dyn_vor      : Update the momentum trend with the vorticity trend 
     21   !!       vor_ens  : enstrophy conserving scheme       (ln_dynvor_ens=T) 
     22   !!       vor_ene  : energy conserving scheme          (ln_dynvor_ene=T) 
     23   !!       vor_mix  : mixed enstrophy/energy conserving (ln_dynvor_mix=T) 
     24   !!       vor_een  : energy and enstrophy conserving   (ln_dynvor_een=T) 
     25   !!   dyn_vor_init : set and control of the different vorticity option 
    2526   !!---------------------------------------------------------------------- 
    2627   USE oce            ! ocean dynamics and tracers 
    … …  
    3738 
    3839   PUBLIC   dyn_vor        ! routine called by step.F90 
    39    PUBLIC       vor_init   ! routine called by opa.F90 
     40   PUBLIC   dyn_vor_init   ! routine called by opa.F90 
    4041 
    4142   !                                             !!* Namelist namdyn_vor: vorticity term 
    … …  
    5455#  include "vectopt_loop_substitute.h90" 
    5556   !!---------------------------------------------------------------------- 
    56    !! NEMO/OPA 3,2 , LOCEAN-IPSL (2009)  
     57   !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010)  
    5758   !! $Id$ 
    5859   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    636637 
    637638 
    638    SUBROUTINE vor_init 
     639   SUBROUTINE dyn_vor_init 
    639640      !!--------------------------------------------------------------------- 
    640       !!                  ***  ROUTINE vor_init  *** 
     641      !!                  ***  ROUTINE dyn_vor_init  *** 
    641642      !! 
    642643      !! ** Purpose :   Control the consistency between cpp options for 
    … …  
    652653      IF(lwp) THEN                    ! Namelist print 
    653654         WRITE(numout,*) 
    654          WRITE(numout,*) 'dyn:vor_init : vorticity term : read namelist and control the consistency' 
    655          WRITE(numout,*) '~~~~~~~~~~~' 
     655         WRITE(numout,*) 'dyn_vor_init : vorticity term : read namelist and control the consistency' 
     656         WRITE(numout,*) '~~~~~~~~~~~~' 
    656657         WRITE(numout,*) '        Namelist namdyn_vor : oice of the vorticity term scheme' 
    657658         WRITE(numout,*) '           energy    conserving scheme                ln_dynvor_ene = ', ln_dynvor_ene 
    … …  
    699700      ENDIF 
    700701      ! 
    701    END SUBROUTINE vor_init 
     702   END SUBROUTINE dyn_vor_init 
    702703 
    703704   !!============================================================================== 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynzdf.F90

    r2027 r2104  
    44   !! Ocean dynamics :  vertical component of the momentum mixing trend 
    55   !!============================================================================== 
    6    !! History :  9.0  !  05-11  (G. Madec)  Original code 
     6   !! History :  1.0  !  2005-11  (G. Madec)  Original code 
     7   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    78   !!---------------------------------------------------------------------- 
    89 
    910   !!---------------------------------------------------------------------- 
    1011   !!   dyn_zdf      : Update the momentum trend with the vertical diffusion 
    11    !!       zdf_ctl : initializations of the vertical diffusion scheme 
     12   !!   dyn_zdf_init : initializations of the vertical diffusion scheme 
    1213   !!---------------------------------------------------------------------- 
    1314   USE oce             ! ocean dynamics and tracers variables 
    … …  
    3031   PUBLIC   dyn_zdf_init  !  routine called by opa.F90 
    3132 
    32    INTEGER  ::   nzdf = 0              ! type vertical diffusion algorithm used  
    33       !                                ! defined from ln_zdf...  namlist logicals) 
    34  
    35    REAL(wp) ::   r2dt                  ! time-step, = 2 rdttra 
    36       !                                ! except at nit000 (=rdttra) if neuler=0 
     33   INTEGER  ::   nzdf = 0   ! type vertical diffusion algorithm used, defined from ln_zdf... namlist logicals 
     34   REAL(wp) ::   r2dt       ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
    3735 
    3836   !! * Substitutions 
    … …  
    4139#  include "vectopt_loop_substitute.h90" 
    4240   !!---------------------------------------------------------------------- 
    43    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     41   !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010)  
    4442   !! $Id$ 
    4543   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    6058 
    6159      !                                          ! set time step 
    62       IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt      ! = rdtra (restarting with Euler time stepping) 
    63       ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt      ! = 2 rdttra (leapfrog) 
     60      IF( neuler == 0 .AND. kt == nit000     ) THEN   ;   r2dt =      rdt   ! = rdtra (restart with Euler time stepping) 
     61      ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdttra (leapfrog) 
    6462      ENDIF 
    6563 
    … …  
    7169      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    7270      ! 
    73       CASE ( 0 )   ;   CALL dyn_zdf_exp    ( kt, r2dt )      ! explicit scheme 
    74       CASE ( 1 )   ;   CALL dyn_zdf_imp    ( kt, r2dt )      ! implicit scheme 
     71      CASE ( 0 )   ;   CALL dyn_zdf_exp( kt, r2dt )      ! explicit scheme 
     72      CASE ( 1 )   ;   CALL dyn_zdf_imp( kt, r2dt )      ! implicit scheme 
    7573      ! 
    7674      CASE ( -1 )                                      ! esopa: test all possibility with control print 
    77                        CALL dyn_zdf_exp    ( kt, r2dt ) 
     75                       CALL dyn_zdf_exp( kt, r2dt ) 
    7876                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               & 
    7977            &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    80                        CALL dyn_zdf_imp    ( kt, r2dt ) 
     78                       CALL dyn_zdf_imp( kt, r2dt ) 
    8179                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               & 
    8280            &                        tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    … …  
    108106      USE zdfkpp 
    109107      !!---------------------------------------------------------------------- 
    110  
     108      ! 
    111109      ! Choice from ln_zdfexp read in namelist in zdfini 
    112110      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme 
    113111      ELSE                   ;   nzdf = 1           ! use implicit scheme 
    114112      ENDIF 
    115  
     113      ! 
    116114      ! Force implicit schemes 
    117115      IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfkpp )   nzdf = 1   ! TKE or KPP physics 
    118116      IF( ln_dynldf_iso                               )   nzdf = 1   ! iso-neutral lateral physics 
    119117      IF( ln_dynldf_hor .AND. ln_sco                  )   nzdf = 1   ! horizontal lateral physics in s-coordinate 
    120  
     118      ! 
    121119      IF( lk_esopa )    nzdf = -1                   ! Esopa key: All schemes used 
    122  
     120      ! 
    123121      IF(lwp) THEN                                  ! Print the choice 
    124122         WRITE(numout,*) 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/FLO/floats.F90

    r2027 r2104  
    107107      WRITE(*,*) 'flo_stp: You should not have seen this print! error?', kt 
    108108   END SUBROUTINE flo_stp 
     109   SUBROUTINE flo_init          ! Empty routine 
     110   END SUBROUTINE flo_init 
    109111#endif 
    110112 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/IOM/restart.F90

    r2082 r2104  
    44   !! Ocean restart :  write the ocean restart file 
    55   !!====================================================================== 
    6    !! History :        !  99-11  (M. Imbard)  Original code 
    7    !!             8.5  !  02-08  (G. Madec)  F90: Free form 
    8    !!             9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    9    !!             9.0  !  06-07  (S. Masson)  use IOM for restart 
     6   !! History :  OPA  !  1999-11  (M. Imbard)  Original code 
     7   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form 
     8   !!            2.0  !  2006-07  (S. Masson)  use IOM for restart 
     9   !!            3.3  !  2010-10  (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 
    1010   !!---------------------------------------------------------------------- 
    1111 
    … …  
    2626   USE zdfmxl          ! mixed layer depth 
    2727   USE trdmld_oce      ! ocean active mixed layer tracers trends variables 
    28 #if defined key_zdfkpp 
    29    USE traswap 
    30 #endif 
     28   USE traswp          ! swap from 4D T-S to 3D T & S and vice versa 
     29 
    3130   IMPLICIT NONE 
    3231   PRIVATE 
    … …  
    3635   PUBLIC   rst_read   ! routine called by opa  module 
    3736 
    38    LOGICAL, PUBLIC ::   lrst_oce =  .FALSE.       !: logical to control the oce restart write  
    39    INTEGER, PUBLIC ::   numror, numrow            !: logical unit for cean restart (read and write) 
     37   LOGICAL, PUBLIC ::   lrst_oce =  .FALSE.   !: logical to control the oce restart write  
     38   INTEGER, PUBLIC ::   numror, numrow        !: logical unit for cean restart (read and write) 
    4039 
    4140   !! * Substitutions 
    4241#  include "vectopt_loop_substitute.h90" 
    4342   !!---------------------------------------------------------------------- 
    44    !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     43   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    4544   !! $Id$ 
    4645   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    109108      !! 
    110109      !! ** Method  :   Write in numrow when kt == nitrst in NetCDF 
    111       !!      file, save fields which are necessary for restart 
     110      !!              file, save fields which are necessary for restart 
    112111      !!---------------------------------------------------------------------- 
    113112      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
    … …  
    135134      CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop    ) 
    136135#if defined key_zdfkpp 
    137       CALL iom_rstput( kt, nitrst, numrow, 'rhd'  , rhd   ) 
     136      CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd     ) 
    138137#endif 
    139138 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/LDF/ldfslp.F90

    r2027 r2104  
    616616      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1) 
    617617   END SUBROUTINE ldf_slp 
     618   SUBROUTINE ldf_slp_init       ! Dummy routine 
     619   END SUBROUTINE ldf_slp_init 
    618620#endif 
    619621 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/eosbn2.F90

    r2083 r2104  
    1616   !!             -   ! 2003-08  (G. Madec)  F90, free form 
    1717   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function 
     18   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    1819   !!---------------------------------------------------------------------- 
    1920 
    … …  
    6162#  include "vectopt_loop_substitute.h90" 
    6263   !!---------------------------------------------------------------------- 
    63    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     64   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    6465   !! $Id$ 
    6566   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv.F90

    r2082 r2104  
    55   !!============================================================================== 
    66   !! History :  2.0  !  2005-11  (G. Madec)  Original code 
    7    !!            3.0  !  2008-01  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
     7   !!            3.3  !  2010-09  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    88   !!---------------------------------------------------------------------- 
    99 
    … …  
    5050   !!---------------------------------------------------------------------- 
    5151   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    52    !! $Id$  
     52   !! $Id$ 
    5353   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5454   !!---------------------------------------------------------------------- 
    … …  
    6767      !! 
    6868      INTEGER ::   jk   ! dummy loop index 
    69       REAL(wp), DIMENSION(jpi,jpj,jpk)   ::  zun, zvn, zwn   ! effective transport 
     69      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::  zun, zvn, zwn   ! 3D workspace: effective transport 
    7070      !!---------------------------------------------------------------------- 
    7171      !                                          ! set time step 
    … …  
    135135      !!---------------------------------------------------------------------- 
    136136      INTEGER ::   ioptio 
    137  
     137      !! 
    138138      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,    & 
    139139         &                 ln_traadv_muscl, ln_traadv_muscl2, & 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2082 r2104  
    1515 
    1616   !!---------------------------------------------------------------------- 
    17    !!   tra_adv_cen2 : update the tracer trend with the horizontal and 
    18    !!                  vertical advection trends using a seconder order 
    19    !!   ups_orca_set : allow mixed upstream/centered scheme in specific 
    20    !!                  area (set for orca 2 and 4 only) 
     17   !!   tra_adv_cen2 : update the tracer trend with the advection trends using a 2nd order centered scheme 
     18   !!   ups_orca_set : allow mixed upstream/centered scheme in specific area (set for orca 2 and 4 only) 
    2119   !!---------------------------------------------------------------------- 
    2220   USE oce, ONLY: tsn  ! now ocean temperature and salinity 
    … …  
    115113      USE oce         , zwy => va   ! use va as workspace 
    116114      !! 
    117       INTEGER         , INTENT(in   )                              ::   kt              ! ocean time-step index 
    118       CHARACTER(len=3), INTENT(in   )                              ::   cdtype          ! =TRA or TRC (tracer indicator) 
    119       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components 
    120       INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers 
    121       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt) ::   ptb, ptn        ! before and now tracer fields 
    122       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
     115      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     116      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     117      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     118      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     119      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     120      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    123121      !! 
    124122      INTEGER  ::   ji, jj, jk, jn                   ! dummy loop indices 
    … …  
    136134 
    137135 
    138       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     136      IF( kt == nit000 )  THEN 
    139137         IF(lwp) WRITE(numout,*) 
    140138         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype 
    141          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~   Vector optimization case' 
     139         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 
    142140         IF(lwp) WRITE(numout,*) 
    143141         ! 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r2082 r2104  
    44   !! Ocean tracers:  advection trend - eddy induced velocity 
    55   !!====================================================================== 
    6    !! History :  9.0  !  05-11 (G. Madec)  Original code, from traldf and zdf _iso 
    7    !!            3.3  !  10-05 (C. Ethe, G. Madec)  merge TRC-TRA  
     6   !! History :  1.0  !  2005-11 (G. Madec)  Original code, from traldf and zdf _iso 
     7   !!            3.3  !  2010-05 (C. Ethe, G. Madec)  merge TRC-TRA  
    88   !!---------------------------------------------------------------------- 
    99#if defined key_traldf_eiv   ||   defined key_esopa 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_traldf_eiv'                  rotation of the lateral mixing tensor 
    12    !!---------------------------------------------------------------------- 
    1312   !!---------------------------------------------------------------------- 
    1413   !!   tra_ldf_iso : update the tracer trend with the horizontal component 
    … …  
    4039#  include "vectopt_loop_substitute.h90" 
    4140   !!---------------------------------------------------------------------- 
    42    !!  OPA 9.0 , LOCEAN-IPSL (2006)  
    43    !! $Id$  
     41   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     42   !! $Id$ 
    4443   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4544   !!---------------------------------------------------------------------- 
    … …  
    6564      !! ** Action  : - add to p.n the eiv component 
    6665      !!---------------------------------------------------------------------- 
    67       INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    68       CHARACTER(len=3), INTENT(in)                    ::   cdtype          ! =TRA or TRC (tracer indicator) 
    69       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pun    ! in : 3 ocean velocity components  
    70       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pvn    ! out: 3 ocean velocity components 
    71       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pwn    ! increased by the eiv 
     66      INTEGER                         , INTENT(in   ) ::   kt       ! ocean time-step index 
     67      CHARACTER(len=3)                , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     68      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun      ! in : 3 ocean velocity components  
     69      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean velocity components 
     70      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv 
    7271      !! 
    7372      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    74       REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! temporary scalar 
    75       REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !    "         " 
    76       REAL(wp), DIMENSION(jpi,jpj) ::   zu_eiv, zv_eiv, zw_eiv     !    "         " 
     73      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars 
     74      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      - 
     75      REAL(wp), DIMENSION(jpi,jpj) ::   zu_eiv, zv_eiv, zw_eiv     ! 2D workspace 
    7776# if defined key_diaeiv  
    78       REAL(wp) ::   zztmp                      !    "         " 
    79       REAL(wp), DIMENSION(jpi,jpj) ::   z2d    !    "         " 
     77      REAL(wp) ::   zztmp                      ! local scalar 
     78      REAL(wp), DIMENSION(jpi,jpj) ::   z2d    ! 2D workspace 
    8079# endif   
    8180      !!---------------------------------------------------------------------- 
    8281 
    83       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     82      IF( kt == nit000 )  THEN 
    8483         IF(lwp) WRITE(numout,*) 
    8584         IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :' 
    … …  
    9594 
    9695      zu_eiv(:,:) = 0.e0   ;   zv_eiv(:,:) = 0.e0   ;    zw_eiv(:,:) = 0.e0   
     96       
    9797                                                    ! ================= 
    9898      DO jk = 1, jpkm1                              !  Horizontal slab 
    … …  
    188188CONTAINS 
    189189   SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype )              ! Empty routine 
    190       INTEGER , INTENT(in   )           ::   kt     ! ocean time-step index 
    191       CHARACTER(len=3), INTENT(in)      ::   cdtype          ! =TRA or TRC (tracer indicator) 
     190      INTEGER  ::   kt     
     191      CHARACTER(len=3) ::   cdtype 
    192192      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn 
    193       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt 
    194       WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', cdtype 
     193      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype 
    195194      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 
    196195   END SUBROUTINE tra_adv_eiv 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r2083 r2104  
    6565      USE oce         , zwy => va   ! use va as workspace 
    6666      !! 
    67       INTEGER         , INTENT(in   )                              ::   kt              ! ocean time-step index 
    68       CHARACTER(len=3), INTENT(in   )                              ::   cdtype          ! =TRA or TRC (tracer indicator) 
    69       INTEGER         , INTENT(in   )                              ::   kjpt            ! number of tracers 
    70       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)              ::   p2dt            ! vertical profile of tracer time-step 
    71       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)      ::   pun, pvn, pwn   ! 3 ocean velocity components 
    72       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb           ! before and now tracer fields 
    73       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
     67      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     68      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     69      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     70      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     72      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field 
     73      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    7474      !! 
    7575      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    76       REAL(wp) ::   zu, z0u, zzwx 
    77       REAL(wp) ::   zv, z0v, zzwy 
    78       REAL(wp) ::   zw, z0w 
     76      REAL(wp) ::   zu, z0u, zzwx    ! local scalar 
     77      REAL(wp) ::   zv, z0v, zzwy    !   -      - 
     78      REAL(wp) ::   zw, z0w          !   -      - 
    7979      REAL(wp) ::   ztra, zbtr, zdt, zalpha 
    8080      REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy   ! 3D workspace 
    8181      !!---------------------------------------------------------------------- 
    8282 
    83       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     83      IF( kt == nit000 )  THEN 
    8484         WRITE(numout,*) 
    8585         WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r2083 r2104  
    2828   PRIVATE 
    2929 
    30    !! * Accessibility 
    31    PUBLIC tra_adv_muscl2        ! routine called by step.F90 
     30   PUBLIC   tra_adv_muscl2        ! routine called by step.F90 
    3231 
    3332   LOGICAL  :: l_trd       ! flag to compute trends 
    … …  
    6160      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 
    6261      !!---------------------------------------------------------------------- 
    63       !!* Module used 
    6462      USE oce         , zwx => ua   ! use ua as workspace 
    6563      USE oce         , zwy => va   ! use va as workspace 
    66       !!* Arguments 
    67       INTEGER         , INTENT(in   )                              ::   kt              ! ocean time-step index 
    68       CHARACTER(len=3), INTENT(in   )                              ::   cdtype          ! =TRA or TRC (tracer indicator) 
    69       INTEGER         , INTENT(in   )                              ::   kjpt            ! number of tracers 
    70       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)              ::   p2dt            ! vertical profile of tracer time-step 
    71       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)      ::   pun, pvn, pwn   ! 3 ocean velocity components 
    72       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb, ptn        ! before and now tracer fields 
    73       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
    74       !!* Local declarations 
     64      !! 
     65      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     66      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     67      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     68      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
     69      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     70      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before & now tracer fields 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     72      !! 
    7573      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    76       REAL(wp) ::   zu, z0u, zzwx 
    77       REAL(wp) ::   zv, z0v, zzwy 
    78       REAL(wp) ::   zw, z0w 
     74      REAL(wp) ::   zu, z0u, zzwx    ! local scalar 
     75      REAL(wp) ::   zv, z0v, zzwy    !   -      - 
     76      REAL(wp) ::   zw, z0w          !   -      - 
    7977      REAL(wp) ::   ztra, zbtr, zdt, zalpha 
    8078      REAL(wp), DIMENSION (jpi,jpj,jpk) ::  zslpx, zslpy   ! 3D workspace 
    8179      !!---------------------------------------------------------------------- 
    8280 
    83       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     81      IF( kt == nit000 )  THEN 
    8482         WRITE(numout,*) 
    8583         WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype 
    … …  
    9088      ENDIF 
    9189 
    92       ! 
     90      !                                                          ! =========== 
    9391      DO jn = 1, kjpt                                            ! tracer loop 
    9492         !                                                       ! =========== 
    … …  
    181179            END DO 
    182180         END DO 
    183  
    184          !                                                    ! lateral boundary conditions on zwx, zwy   (changed sign) 
    185          CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. ) 
     181         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary condition (changed sign) 
     182 
    186183         ! Tracer flux divergence at t-point added to the general trend 
    187184         DO jk = 1, jpkm1 
    … …  
    278275            END DO 
    279276         END DO 
    280  
    281          ! Compute & add the vertical advective trend 
    282          DO jk = 1, jpkm1 
     277         ! 
     278         DO jk = 1, jpkm1        ! Compute & add the vertical advective trend 
    283279            DO jj = 2, jpjm1       
    284280               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    291287            END DO 
    292288         END DO 
    293  
    294          ! Save the vertical advective trends for diagnostic 
    295          ! ------------------------------------------------- 
    296          !                                 ! trend diagnostics (contribution of upstream fluxes) 
     289         !                       ! trend diagnostics (contribution of upstream fluxes) 
    297290         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) ) 
    298291         ! 
    299       ENDDO 
     292      END DO 
    300293      ! 
    301294   END SUBROUTINE tra_adv_muscl2 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r2083 r2104  
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   tra_adv_qck      : update the tracer trend with the horizontal advection 
    12    !!                      trends using a 3rd order finite difference scheme 
    13    !!   tra_adv_qck_i  :  
    14    !!   tra_adv_qck_j  :  
     11   !!   tra_adv_qck    : update the tracer trend with the horizontal advection 
     12   !!                    trends using a 3rd order finite difference scheme 
     13   !!   tra_adv_qck_i  : apply QUICK scheme in i-direction 
     14   !!   tra_adv_qck_j  : apply QUICK scheme in j-direction 
    1515   !!   tra_adv_cen2_k : 2nd centered scheme for the vertical advection 
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce             ! ocean dynamics and active tracers 
    1818   USE dom_oce         ! ocean space and time domain 
    19    USE trdmod_oce         ! ocean space and time domain 
    20    USE trdtra      ! ocean tracers trends  
     19   USE trdmod_oce      ! ocean space and time domain 
     20   USE trdtra          ! ocean tracers trends  
    2121   USE trabbl          ! advective term in the BBL 
    2222   USE lib_mpp         ! distribued memory computing 
    … …  
    3232   PUBLIC   tra_adv_qck   ! routine called by step.F90 
    3333 
    34    REAL(wp)  :: r1_6 = 1./ 6. 
    35    LOGICAL   :: l_trd    ! flag to compute trends 
     34   LOGICAL  :: l_trd           ! flag to compute trends 
     35   REAL(wp) :: r1_6 = 1./ 6.   ! 1/6 ratio 
    3636 
    3737   !! * Substitutions 
    … …  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    42    !! $Id: traadv_qck.F90 2024 2010-07-29 10:57:35Z cetlod $ 
     42   !! $Id: $ 
    4343   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 
    … …  
    8383      !!---------------------------------------------------------------------- 
    8484      !! 
    85       INTEGER         , INTENT(in   )                              ::   kt              ! ocean time-step index 
    86       CHARACTER(len=3), INTENT(in   )                              ::   cdtype          ! =TRA or TRC (tracer indicator) 
    87       INTEGER         , INTENT(in   )                              ::   kjpt            ! number of tracers 
    88       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)              ::   p2dt            ! vertical profile of tracer time-step 
    89       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)      ::   pun, pvn, pwn   ! 3 ocean velocity components 
    90       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt) ::   ptb, ptn        ! before and now tracer fields 
    91       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
    92       !!---------------------------------------------------------------------- 
    93  
    94       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     85      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     86      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     87      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     88      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
     89      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     91      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     92      !!---------------------------------------------------------------------- 
     93 
     94      IF( kt == nit000 )  THEN 
    9595         IF(lwp) WRITE(numout,*) 
    9696         IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype 
    … …  
    103103 
    104104      ! I. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    105       !--------------------------------------------------------------------------- 
    106  
    107105      CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt )  
    108106      CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt )  
    109107 
    110108      ! II. The vertical fluxes are computed with the 2nd order centered scheme 
    111       !------------------------------------------------------------------------- 
    112       ! 
    113109      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt ) 
    114110      ! 
    115111   END SUBROUTINE tra_adv_qck 
    116112 
     113 
    117114   SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun,    & 
    118115      &                                        ptb, ptn, pta, kjpt   ) 
    … …  
    122119      USE oce         , zwx => ua   ! use ua as workspace 
    123120      !! 
    124       INTEGER         , INTENT(in   )                              ::   kt              ! ocean time-step index 
    125       CHARACTER(len=3), INTENT(in   )                              ::   cdtype          ! =TRA or TRC (tracer indicator) 
    126       INTEGER         , INTENT(in   )                              ::   kjpt            ! number of tracers 
    127       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)              ::   p2dt            ! vertical profile of tracer time-step 
    128       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun             ! zonal velocity component 
    129       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb, ptn    ! before tracer fields 
    130       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
     121      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     122      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     123      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     124      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
     125      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun             ! i-velocity components 
     126      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     127      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    131128      !! 
    132129      INTEGER  :: ji, jj, jk, jn           ! dummy loop indices 
    133       REAL(wp) :: ztra, zbtr               ! temporary scalars 
    134       REAL(wp) :: zdir, zdx, zdt, zmsk     ! temporary scalars 
    135       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd 
     130      REAL(wp) :: ztra, zbtr               ! local scalars 
     131      REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars 
     132      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd   ! 3D wokspace 
    136133      !---------------------------------------------------------------------- 
    137134 
    138        
     135      !                                                          ! =========== 
    139136      DO jn = 1, kjpt                                            ! tracer loop 
    140137         !                                                       ! =========== 
    … …  
    154151            END DO 
    155152         END DO 
    156          ! 
    157          !--- Lateral boundary conditions  
    158          CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. )  
     153         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions  
     154 
    159155          
    160156         ! 
    … …  
    182178               END DO 
    183179            END DO 
    184          END DO      ! 
    185  
     180         END DO  
    186181         !--- Lateral boundary conditions  
    187          CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) 
    188          CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zwx(:,:,:), 'T', 1. ) 
     182         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) 
     183         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zwx(:,:,:), 'T', 1. ) 
    189184 
    190185         !--- QUICKEST scheme 
    … …  
    199194            END DO 
    200195         END DO 
    201          !--- Lateral boundary conditions  
    202          CALL lbc_lnk( zfu(:,:,:), 'T', 1. )  
     196         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ! Lateral boundary conditions  
     197 
    203198         ! 
    204199         ! Tracer flux on the x-direction 
    … …  
    235230   END SUBROUTINE tra_adv_qck_i 
    236231 
     232 
    237233   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,   & 
    238234      &                                        ptb, ptn, pta, kjpt   ) 
    … …  
    243239      USE oce         , zwy => ua   ! use ua as workspace 
    244240      !! 
    245       INTEGER         , INTENT(in   )                              ::   kt              ! ocean time-step index 
    246       CHARACTER(len=3), INTENT(in   )                              ::   cdtype          ! =TRA or TRC (tracer indicator) 
    247       INTEGER         , INTENT(in   )                              ::   kjpt            ! number of tracers 
    248       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)              ::   p2dt            ! vertical profile of tracer time-step 
    249       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pvn             ! meridional velocity component 
    250       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb, ptn    ! before tracer fields 
    251       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
     241      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     242      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     243      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     244      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
     245      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn             ! j-velocity components 
     246      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     247      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    252248      !! 
    253249      INTEGER  :: ji, jj, jk, jn           ! dummy loop indices 
    254       REAL(wp) :: ztra, zbtr               ! temporary scalars 
    255       REAL(wp) :: zdir, zdx, zdt, zmsk     ! temporary scalars 
    256       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd 
     250      REAL(wp) :: ztra, zbtr               ! local scalars 
     251      REAL(wp) :: zdir, zdx, zdt, zmsk     ! local scalars 
     252      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu, zfc, zfd   ! 3D wokspace 
    257253      !---------------------------------------------------------------------- 
    258254 
     255      !                                                          ! =========== 
    259256      DO jn = 1, kjpt                                            ! tracer loop 
    260257         !                                                       ! =========== 
    … …  
    274271            END DO 
    275272         END DO 
    276          ! 
    277          !--- Lateral boundary conditions  
    278          CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. )  
     273         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions  
     274 
    279275          
    280276         ! 
    … …  
    302298               END DO 
    303299            END DO 
    304          END DO      ! 
     300         END DO 
    305301 
    306302         !--- Lateral boundary conditions  
    … …  
    357353         ! 
    358354      END DO 
    359  
     355      ! 
    360356   END SUBROUTINE tra_adv_qck_j 
     357 
    361358 
    362359   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,   & 
    … …  
    365362      !! 
    366363      !!---------------------------------------------------------------------- 
    367       !! 
    368364      USE oce         , zwz => ua   ! use ua as workspace 
    369365      !! 
    370       INTEGER         , INTENT(in   )                              ::   kt              ! ocean time-step index 
    371       CHARACTER(len=3), INTENT(in   )                              ::   cdtype          ! =TRA or TRC (tracer indicator) 
    372       INTEGER         , INTENT(in   )                              ::   kjpt            ! number of tracers 
    373       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pwn             ! vertical velocity component 
    374       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn           ! now tracer field 
    375       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
     366      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     367      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     368      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     369      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn             ! vertical velocity  
     370      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! before and now tracer fields 
     371      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    376372      !! 
    377373      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    379375      !!---------------------------------------------------------------------- 
    380376 
    381       ! 
     377      !                                                          ! =========== 
    382378      DO jn = 1, kjpt                                            ! tracer loop 
    383379         !                                                       ! =========== 
    … …  
    424420      !! ** Method :    
    425421      !!---------------------------------------------------------------------- 
    426       REAL(wp), INTENT(in)    , DIMENSION(jpi,jpj,jpk) :: pfu   ! second upwind point 
    427       REAL(wp), INTENT(in)    , DIMENSION(jpi,jpj,jpk) :: pfd   ! first douwning point 
    428       REAL(wp), INTENT(in)    , DIMENSION(jpi,jpj,jpk) :: pfc   ! the central point (or the first upwind point) 
    429       REAL(wp), INTENT(inout) , DIMENSION(jpi,jpj,jpk) :: puc   ! input as Courant number ; output as flux 
     422      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pfu   ! second upwind point 
     423      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pfd   ! first douwning point 
     424      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::  pfc   ! the central point (or the first upwind point) 
     425      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::  puc   ! input as Courant number ; output as flux 
    430426      !! 
    431427      INTEGER  ::  ji, jj, jk               ! dummy loop indices  
    432       REAL(wp) ::  zcoef1, zcoef2, zcoef3   ! temporary scalars           
    433       REAL(wp) ::  zc, zcurv, zfho          !  
     428      REAL(wp) ::  zcoef1, zcoef2, zcoef3   ! local scalars           
     429      REAL(wp) ::  zc, zcurv, zfho          !   -      - 
    434430      !---------------------------------------------------------------------- 
    435431 
    … …  
    460456               ENDIF 
    461457               puc(ji,jj,jk) = zfho 
    462             ENDDO 
    463          ENDDO 
    464       ENDDO 
     458            END DO 
     459         END DO 
     460      END DO 
    465461      ! 
    466462   END SUBROUTINE quickest 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r2083 r2104  
    44   !! Ocean  tracers:  horizontal & vertical advective trend 
    55   !!============================================================================== 
    6    !! History :       !  95-12  (L. Mortier)  Original code 
    7    !!                 !  00-01  (H. Loukos)  adapted to ORCA  
    8    !!                 !  00-10  (MA Foujols E.Kestenare)  include file not routine 
    9    !!                 !  00-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes 
    10    !!                 !  01-07  (E. Durand G. Madec)  adaptation to ORCA config 
    11    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    12    !!            9.0  !  04-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 
    13    !!            9.0  !  08-04  (S. Cravatte) add the i-, j- & k- trends computation 
    14    !!            " "  !  09-11  (V. Garnier) Surface pressure gradient organization 
    15    !!            3.3  !  10-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    16    !!---------------------------------------------------------------------- 
    17  
     6   !! History :  OPA  !  1995-12  (L. Mortier)  Original code 
     7   !!                 !  2000-01  (H. Loukos)  adapted to ORCA  
     8   !!                 !  2000-10  (MA Foujols E.Kestenare)  include file not routine 
     9   !!                 !  2000-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes 
     10   !!                 !  2001-07  (E. Durand G. Madec)  adaptation to ORCA config 
     11   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module 
     12   !!    NEMO    1.0  !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 
     13   !!            2.0  !  2008-04  (S. Cravatte) add the i-, j- & k- trends computation 
     14   !!             -   !  2009-11  (V. Garnier) Surface pressure gradient organization 
     15   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
     16   !!---------------------------------------------------------------------- 
    1817 
    1918   !!---------------------------------------------------------------------- 
    … …  
    5352CONTAINS 
    5453 
    55    SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, & 
     54   SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn,   & 
    5655      &                                       ptb, ptn, pta, kjpt   ) 
    5756      !!---------------------------------------------------------------------- 
    … …  
    7170      USE oce         , zwy => va   ! use va as workspace 
    7271      !! 
    73       INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index 
    74       CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator) 
    75       INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers 
    76       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::   p2dt            ! vertical profile of tracer time-step 
    77       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components 
    78       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb, ptn        ! before and now tracer fields 
    79       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
    80       !! 
    81       INTEGER  ::   ji, jj, jk, jn          ! dummy loop indices   
    82       REAL(wp) ::   & 
    83          z2dtt, zbtr, ztra,                  &  ! temporary scalar 
    84          zfp_ui, zfp_vj, zfp_wk,             &  !    "         " 
    85          zfm_ui, zfm_vj, zfm_wk                 !    "         " 
    86       REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwi, zwz   ! temporary workspace 
    87       REAL(wp), DIMENSION (:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz 
    88       !!---------------------------------------------------------------------- 
    89  
    90  
    91       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     72      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     73      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     74      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     75      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     79      !! 
     80      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices   
     81      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar 
     82      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      - 
     83      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
     84      REAL(wp), DIMENSION (jpi,jpj,jpk) ::   zwi, zwz   ! 3D workspace 
     85      REAL(wp), DIMENSION (:,:,:), ALLOCATABLE ::   ztrdx, ztrdy, ztrdz 
     86      !!---------------------------------------------------------------------- 
     87 
     88      IF( kt == nit000 )  THEN 
    9289         WRITE(numout,*) 
    9390         WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype 
    … …  
    9996      ! 
    10097      IF( l_trd )  THEN 
    101         ALLOCATE( ztrdx(jpi,jpj,jpk) )      ;      ztrdx(:,:,:) = 0. 
    102         ALLOCATE( ztrdy(jpi,jpj,jpk) )      ;      ztrdy(:,:,:) = 0. 
    103         ALLOCATE( ztrdz(jpi,jpj,jpk) )      ;      ztrdz(:,:,:) = 0. 
     98        ALLOCATE( ztrdx(jpi,jpj,jpk) )      ;      ztrdx(:,:,:) = 0.e0 
     99        ALLOCATE( ztrdy(jpi,jpj,jpk) )      ;      ztrdy(:,:,:) = 0.e0 
     100        ALLOCATE( ztrdz(jpi,jpj,jpk) )      ;      ztrdz(:,:,:) = 0.e0 
    104101      END IF 
    105102      ! 
    … …  
    190187       
    191188         ! antidiffusive flux on k 
    192          ! Surface value 
    193          zwz(:,:,1) = 0.e0 
    194          ! Interior value 
    195          DO jk = 2, jpkm1 
     189         zwz(:,:,1) = 0.e0         ! Surface value 
     190         ! 
     191         DO jk = 2, jpkm1          ! Interior value 
    196192            DO jj = 1, jpj 
    197193               DO ji = 1, jpi 
    … …  
    200196            END DO 
    201197         END DO 
    202  
    203          ! Lateral bondary conditions 
    204          CALL lbc_lnk( zwx, 'U', -1. ) 
    205          CALL lbc_lnk( zwy, 'V', -1. ) 
     198         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions 
    206199         CALL lbc_lnk( zwz, 'W',  1. ) 
    207200 
    … …  
    265258      !!       in-space based differencing for fluid 
    266259      !!---------------------------------------------------------------------- 
    267       REAL(wp), DIMENSION(jpk)         , INTENT( in    ) ::   &   
    268          p2dt                               ! vertical profile of tracer time-step 
    269       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( in    ) ::   & 
    270          pbef,                            & ! before field 
    271          paft                               ! after field 
    272       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) ::   & 
    273          paa,                             & ! monotonic flux in the i direction 
    274          pbb,                             & ! monotonic flux in the j direction 
    275          pcc                                ! monotonic flux in the k direction 
     260      REAL(wp), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
     261      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
     262      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
    276263      !! 
    277264      INTEGER ::   ji, jj, jk               ! dummy loop indices 
    … …  
    332319         END DO 
    333320      END DO 
    334  
    335       ! lateral boundary condition on zbetup & zbetdo   (unchanged sign) 
    336       CALL lbc_lnk( zbetup, 'T', 1. ) 
    337       CALL lbc_lnk( zbetdo, 'T', 1. ) 
     321      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
     322 
    338323 
    339324 
    … …  
    362347         END DO 
    363348      END DO 
    364  
    365       ! lateral boundary condition on paa, pbb, pcc 
    366       CALL lbc_lnk( paa, 'U', -1. )      ! changed sign 
    367       CALL lbc_lnk( pbb, 'V', -1. )      ! changed sign 
     349      CALL lbc_lnk( paa, 'U', -1. )   ;   CALL lbc_lnk( pbb, 'V', -1. )   ! lateral boundary condition (changed sign) 
    368350      ! 
    369351   END SUBROUTINE nonosc 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r2083 r2104  
    55   !!============================================================================== 
    66   !! History :  1.0  !  2006-08  (L. Debreu, R. Benshila)  Original code 
    7   !!             3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
     7   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport 
    88   !!---------------------------------------------------------------------- 
    99 
    … …  
    4141CONTAINS 
    4242 
    43    SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn, & 
     43   SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn,   & 
    4444      &                                       ptb, ptn, pta, kjpt   ) 
    4545      !!---------------------------------------------------------------------- 
    … …  
    7474      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741.  
    7575      !!---------------------------------------------------------------------- 
    76       !!* Module used 
    7776      USE oce         , zwx => ua   ! use ua as workspace 
    7877      USE oce         , zwy => va   ! use va as workspace 
    79       !!* Arguments 
    80       INTEGER         , INTENT(in   )                              ::   kt              ! ocean time-step index 
    81       CHARACTER(len=3), INTENT(in   )                              ::   cdtype          ! =TRA or TRC (tracer indicator) 
    82       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk)       ::   pun, pvn, pwn   ! 3 ocean velocity components 
    83       INTEGER         , INTENT(in   )                               ::   kjpt            ! number of tracers 
    84       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)               ::   p2dt            ! vertical profile of tracer time-step 
    85       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt) ::   ptb, ptn        ! before and now tracer fields 
    86       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta           ! tracer trend  
    87       !!* Local declarations 
     78      !! 
     79      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
     80      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
     81      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
     82      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     84      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     85      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
     86      !! 
    8887      INTEGER  ::   ji, jj, jk, jn          ! dummy loop indices 
    89       REAL(wp) ::   ztra, zbtr, zcoef                  ! temporary scalars 
    90       REAL(wp) ::   zfp_ui, zfm_ui, zcenut  !    "         " 
    91       REAL(wp) ::   zfp_vj, zfm_vj, zcenvt  !    "         "    !    "         " 
    92       REAL(wp) ::   z2dtt                    
    93       REAL(wp) ::   ztak, zfp_wk, zfm_wk    !    "         " 
    94       REAL(wp) ::   zeeu, zeev, z_hdivn      
    95       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu , zltv   !    "              " 
    96       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zti, ztw                !    "              " 
    97       !!---------------------------------------------------------------------- 
    98  
    99  
    100       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     88      REAL(wp) ::   ztra, zbtr, zcoef       ! local scalars 
     89      REAL(wp) ::   zfp_ui, zfm_ui, zcenut  !   -      - 
     90      REAL(wp) ::   zfp_vj, zfm_vj, zcenvt  !   -      - 
     91      REAL(wp) ::   z2dtt                   !   -      - 
     92      REAL(wp) ::   ztak, zfp_wk, zfm_wk    !   -      - 
     93      REAL(wp) ::   zeeu, zeev, z_hdivn     !   -      - 
     94      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu , zltv   ! 3D workspace 
     95      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zti, ztw                !  -      - 
     96      !!---------------------------------------------------------------------- 
     97 
     98      IF( kt == nit000 )  THEN 
    10199         IF(lwp) WRITE(numout,*) 
    102100         IF(lwp) WRITE(numout,*) 'tra_adv_ubs :  horizontal UBS advection scheme on ', cdtype 
    … …  
    113111         ! ---------------------------------- 
    114112         zltu(:,:,jpk) = 0.e0       ;      zltv(:,:,jpk) = 0.e0 
    115          !                                                ! =============== 
     113         !                                               
    116114         DO jk = 1, jpkm1                                 ! Horizontal slab 
    117             !                                             ! =============== 
     115            !                                    
    118116            !  Laplacian 
    119             ! First derivative (gradient) 
    120             DO jj = 1, jpjm1 
     117            DO jj = 1, jpjm1            ! First derivative (gradient) 
    121118               DO ji = 1, fs_jpim1   ! vector opt. 
    122119                  zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) 
    … …  
    126123               END DO 
    127124            END DO 
    128             ! Second derivative (divergence) 
    129             DO jj = 2, jpjm1 
     125            DO jj = 2, jpjm1            ! Second derivative (divergence) 
    130126               DO ji = fs_2, fs_jpim1   ! vector opt. 
    131127                  zcoef = 1. / ( 6. * fse3t(ji,jj,jk) ) 
    … …  
    134130               END DO 
    135131            END DO 
    136             !                                             ! ================= 
    137          END DO                                           !    End of slab 
    138          !                                                ! ================= 
    139           
    140          ! Lateral boundary conditions on the laplacian (zlt)   (unchanged sgn) 
    141          CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. ) 
     132            !                                     
     133         END DO                                           ! End of slab          
     134         CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
    142135 
    143136         !     
    144137         !  Horizontal advective fluxes                
    145          DO jk = 1, jpkm1  
     138         DO jk = 1, jpkm1                                 ! Horizontal slab 
    146139            DO jj = 1, jpjm1 
    147140               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    159152               END DO 
    160153            END DO 
    161          ENDDO 
     154         END DO                                           ! End of slab          
    162155 
    163156         zltu(:,:,:) = pta(:,:,:,jn)      ! store pta trends 
    … …  
    176169               END DO 
    177170            END DO 
    178             !                                             ! =============== 
     171            !                                              
    179172         END DO                                           !   End of slab 
    180          !                                                ! =============== 
    181173 
    182174         ! Horizontal trend used in tra_adv_ztvd subroutine 
    … …  
    286278   END SUBROUTINE tra_adv_ubs 
    287279 
     280 
    288281   SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt ) 
    289282      !!--------------------------------------------------------------------- 
    … …  
    299292      !!       in-space based differencing for fluid 
    300293      !!---------------------------------------------------------------------- 
    301       REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt            ! vertical profile of tracer time-step 
     294      REAL(wp), INTENT(in   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step 
    302295      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field 
    303296      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbc.F90

    r2024 r2104  
    194194      WRITE(*,*) 'tra_bbc: You should not have seen this print! error?', kt 
    195195   END SUBROUTINE tra_bbc 
     196   SUBROUTINE tra_bbc_init           ! Empty routine 
     197   END SUBROUTINE tra_bbc_init 
    196198#endif 
    197199 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl.F90

    r2082 r2104  
    2626   USE phycst         !  
    2727   USE eosbn2         ! equation of state 
    28    USE trdmod_oce        ! ocean space and time domain 
    29    USE trdtra     ! ocean active tracers trends 
     28   USE trdmod_oce     ! ocean space and time domain 
     29   USE trdtra         ! ocean active tracers trends 
    3030   USE iom            ! IOM server                
    3131   USE in_out_manager ! I/O manager 
    3232   USE lbclnk         ! ocean lateral boundary conditions 
    3333   USE prtctl         ! Print control 
    34    USE trc_oce         ! share passive tracers/Ocean variables 
     34   USE trc_oce        ! share passive tracers/Ocean variables 
    3535 
    3636   IMPLICIT NONE 
    … …  
    4949# endif 
    5050 
     51   LOGICAL, PUBLIC              ::   l_bbl               !: flag to compute bbl diffu. flux coef and transport 
     52    
    5153   !                                         !!* Namelist nambbl *  
    5254   INTEGER , PUBLIC ::   nn_bbl_ldf = 0       !: =1   : diffusive bbl or not (=0) 
    … …  
    5759   REAL(wp), PUBLIC ::   rn_gambbl  = 10.e0   !: lateral coeff. for bottom boundary layer scheme [s] 
    5860 
     61   REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   utr_bbl, vtr_bbl   ! u- (v-) transport in the bottom boundary layer 
     62    
    5963   INTEGER , DIMENSION(jpi,jpj) ::   mbkt                   ! vertical index of the bottom ocean T-level 
    6064   INTEGER , DIMENSION(jpi,jpj) ::   mbku     , mbkv        ! vertical index of the (upper) bottom ocean U/V-level 
    6165   INTEGER , DIMENSION(jpi,jpj) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level 
    6266   INTEGER , DIMENSION(jpi,jpj) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction 
    63    REAL(wp), DIMENSION(jpi,jpj), PUBLIC ::   utr_bbl  , vtr_bbl     ! u- (v-) transport in the bottom boundary layer 
    6467   REAL(wp), DIMENSION(jpi,jpj) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points 
    6568   REAL(wp), DIMENSION(jpi,jpj) ::   ahu_bbl  , ahv_bbl     ! masked diffusive bbl coefficients at u and v-points 
    6669   REAL(wp), DIMENSION(jpi,jpj) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points 
    67    REAL(wp), DIMENSION(jpi,jpj) ::   e1e2t_r   ! thichness of the bbl (e3) at u and v-points 
    68    LOGICAL, PUBLIC              ::   l_bbl                    !: flag to compute bbl diffu. flux coef and transport 
     70   REAL(wp), DIMENSION(jpi,jpj) ::   e1e2t_r                ! thichness of the bbl (e3) at u and v-points 
    6971 
    7072   !! * Substitutions 
    … …  
    7375   !!---------------------------------------------------------------------- 
    7476   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    75    !! $Id$  
     77   !! $Id$ 
    7678   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7779   !!---------------------------------------------------------------------- 
    7880 
    7981CONTAINS 
    80  
    8182 
    8283   SUBROUTINE tra_bbl( kt ) 
    … …  
    9091      !!----------------------------------------------------------------------   
    9192      INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
    92       ! 
     93      !! 
    9394      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds 
    9495      !!---------------------------------------------------------------------- 
    … …  
    154155      !!      convection is satified) 
    155156      !! 
    156       !! 
    157157      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    158158      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    159159      !!----------------------------------------------------------------------   
    160       !!* Arguments 
    161       INTEGER         , INTENT(in   )                                ::   kjpt      ! number of tracers 
    162       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab     ! before and now tracer fields 
    163       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa     ! tracer trend  
     160      INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers 
     161      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptrab   ! before and now tracer fields 
     162      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   ptraa   ! tracer trend  
     163      !! 
     164      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
     165      INTEGER  ::   ik           ! local integer 
     166      REAL(wp) ::   zbtr, ztra   ! local scalars  
     167      REAL(wp), DIMENSION(jpi,jpj) :: ztrb, zkx, zky   ! 2D workspace 
     168      !!---------------------------------------------------------------------- 
    164169      ! 
    165       INTEGER  ::   ji, jj, jn           ! dummy loop indices 
    166       INTEGER  ::   ik                       ! temporary integers 
    167       REAL(wp) ::   zbtr, ztra               ! temporary  
    168       REAL(wp), DIMENSION(jpi,jpj) :: ztrb, zkx, zky        ! 2D workspace 
    169       !!---------------------------------------------------------------------- 
    170                                                           ! =========== 
     170      !                                                   ! =========== 
    171171      DO jn = 1, kjpt                                     ! tracer loop 
    172172         !                                                ! =========== 
    … …  
    183183         END DO 
    184184         ! 
     185!!gm  forced unrolling should be uuseless in the loop below (no indirect adressing) 
    185186#  if defined key_vectopt_loop 
    186187         DO jj = 1, 1   ! vector opt. (forced unrolling) 
    … …  
    212213      ! 
    213214   END SUBROUTINE tra_bbl_dif 
     215    
    214216 
    215217   SUBROUTINE tra_bbl_adv( ptrab, ptraa, kjpt ) 
    … …  
    233235      !! 
    234236      !!----------------------------------------------------------------------   
    235       !!* Arguments 
    236       INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers 
    237       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptrab          ! before and now tracer fields 
    238       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptraa          ! tracer trend  
    239       ! 
     237      INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers 
     238      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptrab   ! before and now tracer fields 
     239      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   ptraa   ! tracer trend  
     240      !! 
    240241      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
    241       INTEGER  ::   ik                       ! temporary integers 
    242       INTEGER  ::   iis , iid , ijs , ijd    !    -          - 
    243       INTEGER  ::   ikus, ikud, ikvs, ikvd   !    -          - 
    244       REAL(wp) ::   zbtr, ztra               !    -         - 
    245       REAL(wp) ::   zu_bbl, zv_bbl           !    -         - 
     242      INTEGER  ::   ik                       ! local integers 
     243      INTEGER  ::   iis , iid , ijs , ijd    !   -       - 
     244      INTEGER  ::   ikus, ikud, ikvs, ikvd   !   -       - 
     245      REAL(wp) ::   zbtr, ztra               ! local scalars 
     246      REAL(wp) ::   zu_bbl, zv_bbl           !   -      - 
    246247      !!---------------------------------------------------------------------- 
    247248 
    … …  
    277278                  ptraa(iid,jj,ikud,jn) = ptraa(iid,jj,ikud,jn) + ztra 
    278279               ENDIF 
     280               ! 
    279281               IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection 
    280282                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf) 
    … …  
    306308   END SUBROUTINE tra_bbl_adv 
    307309 
     310 
    308311   SUBROUTINE bbl( kt, cdtype ) 
    309312      !!---------------------------------------------------------------------- 
    … …  
    330333      !!      local density (i.e. referenced at a common local depth). 
    331334      !! 
    332       !! 
    333335      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    334336      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    335337      !!----------------------------------------------------------------------   
    336       INTEGER         , INTENT(in   )                               ::   kt              ! ocean time-step index 
    337       CHARACTER(len=3), INTENT(in   )                               ::   cdtype          ! =TRA or TRC (tracer indicator) 
     338      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
     339      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     340      !! 
    338341      INTEGER  ::   ji, jj                    ! dummy loop indices 
    339       INTEGER  ::   ik                         ! temporary integers 
    340       INTEGER  ::   iis , iid , ijs , ijd     !    -          - 
    341       INTEGER  ::   ikus, ikud, ikvs, ikvd    !    -          - 
    342       REAL(wp) ::   zsign, zsigna, zgbbl      ! temporary scalars 
    343       REAL(wp) ::   zgdrho, zt, zs, zh        !    -         - 
    344       REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb, ztb, zsb, zdep  !  -      - 
     342      INTEGER  ::   ik                        ! local integers 
     343      INTEGER  ::   iis , iid , ijs , ijd     !   -       - 
     344      INTEGER  ::   ikus, ikud, ikvs, ikvd    !   -       - 
     345      REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars 
     346      REAL(wp) ::   zgdrho, zt, zs, zh        !   -      - 
     347      REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb, ztb, zsb, zdep  !  2D workspace 
    345348      !! 
    346349      REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function 
    … …  
    377380      !!---------------------------------------------------------------------- 
    378381       
     382      IF( kt == nit000 )  THEN 
     383         IF(lwp)  WRITE(numout,*) 
     384         IF(lwp)  WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 
     385         IF(lwp)  WRITE(numout,*) '~~~~~~~~~~' 
     386      ENDIF 
     387       
    379388      !                                        !* bottom temperature, salinity, velocity and depth 
    380       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
    381          IF(lwp)  WRITE(numout,*) ' ' 
    382          IF(lwp)  WRITE(numout,*) ' trabbl:bbl  : Compute bbl velocities and diffusive coefficients in ', cdtype 
    383          IF(lwp)  WRITE(numout,*) ' ' 
    384       ENDIF 
    385  
    386389#if defined key_vectopt_loop 
    387390      DO jj = 1, 1   ! vector opt. (forced unrolling) 
    … …  
    392395#endif 
    393396            ik = mbkt(ji,jj)                        ! bottom T-level index 
    394             ztb (ji,jj) = tsb(ji,jj,ik,jp_tem)              ! bottom before T and S 
     397            ztb (ji,jj) = tsb(ji,jj,ik,jp_tem)      ! bottom before T and S 
    395398            zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) 
    396399            zdep(ji,jj) = fsdept_0(ji,jj,ik)        ! bottom T-level reference depth 
    … …  
    440443      ENDIF 
    441444 
    442  
    443445      !                                   !-------------------! 
    444446      IF( nn_bbl_adv /= 0 ) THEN          !   advective bbl   ! 
    … …  
    477479               END DO 
    478480            END DO 
    479          ! 
     481            ! 
    480482         CASE( 2 )                                 != bbl velocity = F( delta rho ) 
    481483            zgbbl = grav * rn_gambbl 
    … …  
    531533      !! 
    532534      !! ** Method  :   Read the nambbl namelist and check the parameters 
    533       !!      called by tra_bbl at the first timestep (nit000) 
     535      !!              called by tra_bbl at the first timestep (nit000) 
    534536      !!---------------------------------------------------------------------- 
    535537      INTEGER ::   ji, jj               ! dummy loop indices 
    536538      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer 
    537539      REAL(wp), DIMENSION(jpi,jpj) ::   zmbk   ! 2D workspace  
    538  
     540      !! 
    539541      NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 
    540542      !!---------------------------------------------------------------------- 
    … …  
    634636   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .FALSE.   !: bbl flag 
    635637CONTAINS 
    636    SUBROUTINE tra_bbl( kt )              ! Empty routine 
     638   SUBROUTINE tra_bbl_init               ! Dummy routine 
     639   END SUBROUTINE tra_bbl_init 
     640   SUBROUTINE tra_bbl( kt )              ! Dummy routine 
    637641      WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt 
    638642   END SUBROUTINE tra_bbl 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tradmp.F90

    r2024 r2104  
    726726      WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt 
    727727   END SUBROUTINE tra_dmp 
     728   SUBROUTINE tra_dmp_init        ! Empty routine 
     729   END SUBROUTINE tra_dmp_init 
    728730#endif 
    729731 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf.F90

    r2082 r2104  
    99 
    1010   !!---------------------------------------------------------------------- 
    11    !!   tra_ldf     : update the tracer trend with the lateral diffusion 
    12    !!       ldf_ctl : initialization, namelist read, and parameters control 
    13    !!       ldf_ano : compute lateral diffusion for constant T-S profiles 
     11   !!   tra_ldf      : update the tracer trend with the lateral diffusion 
     12   !!   tra_ldf_init : initialization, namelist read, and parameters control 
     13   !!       ldf_ano  : compute lateral diffusion for constant T-S profiles 
    1414   !!---------------------------------------------------------------------- 
    1515   USE oce             ! ocean dynamics and tracers 
    … …  
    3737   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 
    3838#if defined key_traldf_ano 
    39    REAL, DIMENSION(jpi,jpj,jpk) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S 
    40       !                                               ! for a constant vertical profile 
     39   REAL, DIMENSION(jpi,jpj,jpk) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S for a constant profile 
    4140#endif 
    4241 
    … …  
    7372      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  ! rotated laplacian  
    7473      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian 
    75       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRA',             tsb, tsa, jpts        )  ! s-coord. horizontal bilaplacian 
     74      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRA',             tsb, tsa, jpts        )  ! s-coord. horizontal bilap. 
    7675         ! 
    7776      CASE ( -1 )                                     ! esopa: test all possibility with control print 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilap.F90

    r2082 r2104  
    44   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!============================================================================== 
    6    !! History :     !  91-11  (G. Madec)  Original code 
    7    !!               !  93-03  (M. Guyon)  symetrical conditions 
    8    !!               !  95-11  (G. Madec)  suppress volumetric scale factors 
    9    !!               !  96-01  (G. Madec)  statement function for e3 
    10    !!               !  96-01  (M. Imbard)  mpp exchange 
    11    !!               !  97-07  (G. Madec)  optimization, and ahtt 
    12    !!          8.5  !  02-08  (G. Madec)  F90: Free form and module 
    13    !!          9.0  !  04-08  (C. Talandier) New trends organization 
    14    !!               !  05-11  (G. Madec)  zps or sco as default option 
    15    !!          3.3  !  10-05  (C. Ethe, G. Madec)  merge TRC-TRA  
     6   !! History :  OPA  !  1991-11  (G. Madec)  Original code 
     7   !!                 !  1993-03  (M. Guyon)  symetrical conditions 
     8   !!                 !  1995-11  (G. Madec)  suppress volumetric scale factors 
     9   !!                 !  1996-01  (G. Madec)  statement function for e3 
     10   !!                 !  1996-01  (M. Imbard)  mpp exchange 
     11   !!                 !  1997-07  (G. Madec)  optimization, and ahtt 
     12   !!            8.5  !  2002-08  (G. Madec)  F90: Free form and module 
     13   !!   NEMO     1.0  !  2004-08  (C. Talandier) New trends organization 
     14   !!             -   !  2005-11  (G. Madec)  zps or sco as default option 
     15   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA  
    1616   !!============================================================================== 
    1717 
    … …  
    2020   !!                   using a iso-level biharmonic operator 
    2121   !!---------------------------------------------------------------------- 
    22    !! * Modules used 
    2322   USE oce             ! ocean dynamics and active tracers 
    2423   USE dom_oce         ! ocean space and time domain 
    … …  
    3332   PRIVATE 
    3433 
    35    !! * Routine accessibility 
    36    PUBLIC tra_ldf_bilap   ! routine called by step.F90 
     34   PUBLIC   tra_ldf_bilap   ! routine called by step.F90 
    3735 
    3836   !! * Substitutions 
    … …  
    4341   !!---------------------------------------------------------------------- 
    4442   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    45    !! $Id$  
    46    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     43   !! $Id$ 
     44   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4745   !!---------------------------------------------------------------------- 
    4846 
    … …  
    8078      USE oce         , ztv => va   ! use va as workspace 
    8179      !! 
    82       INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index 
    83       CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator) 
    84       INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers 
    85       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt  )     ::   pgu, pgv     ! tracer gradient at pstep levels 
    86       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptb          ! before and now tracer fields 
    87       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   pta          ! tracer trend  
     80      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     81      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     82      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     83      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     84      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
     85      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    8886      !! 
    89       INTEGER  ::  ji, jj, jk, jn         ! dummy loop indices 
    90       INTEGER  ::  iku, ikv               ! temporary integers 
    91       REAL(wp) ::  zbtr, ztra             ! temporary scalars 
    92       REAL(wp), DIMENSION(jpi,jpj) ::   &  
    93          zeeu, zeev, zlt               ! 2D workspace 
     87      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
     88      INTEGER  ::  iku, ikv         ! local integers 
     89      REAL(wp) ::  zbtr, ztra       ! local scalars 
     90      REAL(wp), DIMENSION(jpi,jpj) ::   zeeu, zeev, zlt   ! 2D workspace 
    9491      !!---------------------------------------------------------------------- 
    9592 
    96       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     93      IF( kt == nit000 )  THEN 
    9794         IF(lwp) WRITE(numout,*) 
    9895         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype 
    … …  
    103100         !                                                       ! =========== 
    104101         !                                                
    105          DO jk = 1, jpkm1                                  
     102         DO jk = 1, jpkm1                                        ! Horizontal slab 
    106103            !                                              
    107              
    108             ! 0. Initialization of metric arrays (for z- or s-coordinates) 
    109             ! ---------------------------------- 
     104            !                          !==  Initialization of metric arrays (for z- or s-coordinates)  ==! 
    110105            DO jj = 1, jpjm1 
    111106               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    115110            END DO 
    116111 
    117  
    118             ! 1. Laplacian 
    119             ! ------------ 
    120              
    121             ! First derivative (gradient) 
    122             DO jj = 1, jpjm1 
     112            !                          !==  Laplacian  ==! 
     113            ! 
     114            DO jj = 1, jpjm1                 ! First derivative (gradient) 
    123115               DO ji = 1, fs_jpim1   ! vector opt. 
    124116                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    … …  
    126118               END DO 
    127119            END DO 
    128             IF( ln_zps ) THEN      ! set gradient at partial step level 
     120            IF( ln_zps ) THEN                ! set gradient at partial step level 
    129121               DO jj = 1, jpjm1 
    130122                  DO ji = 1, jpim1 
    … …  
    137129               END DO 
    138130            ENDIF 
    139  
    140             ! Second derivative (divergence) multiply by the eddy diffusivity coefficient 
    141             DO jj = 2, jpjm1 
     131            DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient 
    142132               DO ji = fs_2, fs_jpim1   ! vector opt. 
    143133                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    144                   zlt(ji,jj) = fsahtt(ji,jj,jk) & 
    145                      &                * zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
     134                  zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * (   ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
     135                     &                                     + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)   ) 
    146136               END DO 
    147137            END DO 
     138            CALL lbc_lnk( zlt, 'T', 1. )     ! Lateral boundary conditions (unchanged sgn) 
    148139 
    149             ! Lateral boundary conditions on the laplacian (zlt)   (unchanged sgn) 
    150             CALL lbc_lnk( zlt, 'T', 1. ) 
    151  
    152             ! 2. Bilaplacian 
    153             ! -------------- 
    154              
    155             ! third derivative (gradient) 
    156             DO jj = 1, jpjm1 
     140            !                          !==  Bilaplacian  ==! 
     141            ! 
     142            DO jj = 1, jpjm1                 ! third derivative (gradient) 
    157143               DO ji = 1, fs_jpim1   ! vector opt. 
    158144                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) ) 
    … …  
    160146               END DO 
    161147            END DO 
    162  
    163             ! fourth derivative (divergence) and add to the general tracer trend 
    164             DO jj = 2, jpjm1 
     148            DO jj = 2, jpjm1                 ! fourth derivative (divergence) and add to the general tracer trend 
    165149               DO ji = fs_2, fs_jpim1   ! vector opt. 
    166150                  ! horizontal diffusive trends 
    … …  
    171155               END DO 
    172156            END DO 
    173             !                                             ! =============== 
     157            !                                              
    174158         END DO                                           ! Horizontal slab 
    175          !                                                ! =============== 
     159         !                                                 
    176160         ! "zonal" mean lateral diffusive heat and salt transport 
    177161         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN   
    … …  
    179163           IF( jn == jp_sal )  pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    180164         ENDIF 
    181          ! 
    182       END DO 
    183  
     165         !                                                ! =========== 
     166      END DO                                              ! tracer loop 
     167      !                                                   ! =========== 
    184168   END SUBROUTINE tra_ldf_bilap 
    185169 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r2082 r2104  
    1616   !!   ldfght         :  ??? 
    1717   !!---------------------------------------------------------------------- 
    18    !! * Modules used 
    1918   USE oce             ! ocean dynamics and tracers variables 
    2019   USE dom_oce         ! ocean space and time domain variables 
    … …  
    2928   PRIVATE 
    3029 
    31    !! * Routine accessibility 
    32    PUBLIC tra_ldf_bilapg    ! routine called by step.F90 
     30   PUBLIC   tra_ldf_bilapg   ! routine called by step.F90 
    3331 
    3432   !! * Substitutions 
    … …  
    3836   !!---------------------------------------------------------------------- 
    3937   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    40    !! $Id$  
     38   !! $Id$ 
    4139   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4240   !!---------------------------------------------------------------------- 
    … …  
    6866      !!               biharmonic mixing trend. 
    6967      !!---------------------------------------------------------------------- 
    70       !!* Arguments 
    7168      INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index 
    7269      CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator) 
    7370      INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers 
    74       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb          ! before and now tracer fields 
    75       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta          ! tracer trend  
    76       !! * Local declarations 
     71      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb          ! before and now tracer fields 
     72      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta          ! tracer trend  
     73      !! 
    7774      INTEGER ::   ji, jj, jk, jn                 ! dummy loop indices 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk,SIZE(ptb,4)) ::   & 
    79          wk1, wk2                ! work array used for rotated biharmonic 
    80          !                       ! operator on tracers and/or momentum 
    81       !!---------------------------------------------------------------------- 
    82  
    83       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) ::   wk1, wk2   ! 4D workspace 
     76      !!---------------------------------------------------------------------- 
     77 
     78      IF( kt == nit000 )  THEN 
    8479         IF(lwp) WRITE(numout,*) 
    8580         IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype 
    … …  
    9186      ! 1. Laplacian of ptb * aht 
    9287      ! -----------------------------  
    93       ! rotated harmonic operator applied to ptb and multiply by aht ; output in wk1  
    94  
    95       CALL ldfght( kt, cdtype, ptb, wk1, kjpt, 1 ) 
    96  
     88      CALL ldfght( kt, cdtype, ptb, wk1, kjpt, 1 )      ! rotated harmonic operator applied to ptb and multiply by aht  
     89      !                                                 ! output in wk1  
    9790      ! 
    9891      DO jn = 1, kjpt 
    99       ! Lateral boundary conditions on wk1   (unchanged sign) 
    100          CALL lbc_lnk( wk1(:,:,:,jn) , 'T', 1. ) 
     92         CALL lbc_lnk( wk1(:,:,:,jn) , 'T', 1. )        ! Lateral boundary conditions on wk1   (unchanged sign) 
    10193      END DO 
    10294 
    10395      ! 2. Bilaplacian of ptb 
    10496      ! ------------------------- 
    105       ! rotated harmonic operator applied to wk1 ; output in wk2 
    106  
    107       CALL ldfght( kt, cdtype, wk1, wk2, kjpt, 2 ) 
     97      CALL ldfght( kt, cdtype, wk1, wk2, kjpt, 2 )      ! rotated harmonic operator applied to wk1 ; output in wk2 
    10898 
    10999 
    … …  
    167157      !! 
    168158      !!---------------------------------------------------------------------- 
    169       !!  
    170159      USE oce         , zftv => ua     ! use ua as workspace 
    171160      !! 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r2082 r2104  
    44   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend 
    55   !!====================================================================== 
    6    !! History :   OPA  !  1994-08  (G. Madec, M. Imbard) 
    7    !!                  !  1997-05  (G. Madec)  split into traldf and trazdf 
    8    !!             NEMO !  2002-08  (G. Madec)  Free form, F90 
    9    !!             1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-) 
    10    !!             3.0  !  2008-01  (C. Ethe, G. Madec) Merge TRA-TRC 
     6   !! History :  OPA  !  1994-08  (G. Madec, M. Imbard) 
     7   !!            8.0  !  1997-05  (G. Madec)  split into traldf and trazdf 
     8   !!            NEMO !  2002-08  (G. Madec)  Free form, F90 
     9   !!            1.0  !  2005-11  (G. Madec)  merge traldf and trazdf :-) 
     10   !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC 
    1111   !!---------------------------------------------------------------------- 
    1212#if   defined key_ldfslp   ||   defined key_esopa 
    1313   !!---------------------------------------------------------------------- 
    1414   !!   'key_ldfslp'               slope of the lateral diffusive direction 
    15    !!---------------------------------------------------------------------- 
    1615   !!---------------------------------------------------------------------- 
    1716   !!   tra_ldf_iso  : update the tracer trend with the horizontal  
    … …  
    4544   !!---------------------------------------------------------------------- 
    4645   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    47    !! $Id$  
     46   !! $Id$ 
    4847   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4948   !!---------------------------------------------------------------------- 
    … …  
    9291      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9392      !!---------------------------------------------------------------------- 
    94       !!* Module used 
    9593      USE oce         , zftu => ua   ! use ua as workspace 
    9694      USE oce         , zftv => va   ! use va as workspace 
    97       !!* Arguments 
    98       INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index 
    99       CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator) 
    100       INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers 
    101       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt  )     ::   pgu, pgv     ! tracer gradient at pstep levels 
    102       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptb          ! before and now tracer fields 
    103       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   pta          ! tracer trend  
    104       REAL(wp)        , INTENT(in   )                                ::   pahtb0         ! background diffusion coef 
    105       !!* Local declarations 
     95      !! 
     96      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     97      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     98      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     99      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     100      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
     101      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
     102      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef 
     103      !! 
    106104      INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices 
    107       INTEGER  ::  iku, ikv     ! temporary integer 
    108       REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! temporary scalars 
    109       REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !    "         " 
    110       REAL(wp) ::  zcoef0, zbtr, ztra                           !    "         " 
     105      INTEGER  ::  iku, ikv        ! temporary integer 
     106      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars 
     107      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      - 
     108      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      - 
    111109      REAL(wp), DIMENSION(jpi,jpj)     ::   zdkt, zdk1t         ! 2D workspace 
    112       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw     ! 3D workspace 
     110      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdit, zdjt, ztfw    ! 3D workspace 
    113111#if defined key_diaar5 
    114       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                  !  "         " 
    115       REAL(wp)                         ::   zztmp                !  "         " 
     112      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                 ! 2D workspace 
     113      REAL(wp)                         ::   zztmp               ! local scalar 
    116114#endif 
    117115      !!---------------------------------------------------------------------- 
    118116 
    119       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     117      IF( kt == nit000 )  THEN 
    120118         IF(lwp) WRITE(numout,*) 
    121119         IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 
    … …  
    159157         !!   II - horizontal trend  (full) 
    160158         !!---------------------------------------------------------------------- 
    161           
    162159!CDIR PARALLEL DO PRIVATE( zdk1t )  
    163160         !                                                ! =============== 
    … …  
    167164            ! ------------------------------------------------ 
    168165            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 
    169              
    170166            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
    171              
    172             IF( jk == 1 ) THEN 
    173                zdkt(:,:) = zdk1t(:,:) 
    174             ELSE 
    175                zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 
     167            ! 
     168            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:) 
     169            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 
    176170            ENDIF 
    177171 
    178  
    179172            ! 2. Horizontal fluxes 
    180             ! -------------------- 
    181              
     173            ! --------------------    
    182174            DO jj = 1 , jpjm1 
    183175               DO ji = 1, fs_jpim1   ! vector opt. 
    184176                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 
    185177                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 
    186                    
     178                  ! 
    187179                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
    188180                     &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. ) 
    189                    
     181                  ! 
    190182                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   & 
    191183                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. ) 
    192                    
     184                  ! 
    193185                  zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
    194186                  zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
    … …  
    202194               END DO 
    203195            END DO 
    204  
    205196 
    206197            ! II.4 Second derivative (divergence) and add to the general trend 
    … …  
    216207         END DO                                        !   End of slab   
    217208         !                                             ! =============== 
    218          ! "Poleward" diffusive heat or salt transports 
     209         ! 
     210         ! "Poleward" diffusive heat or salt transports (T-S case only) 
    219211         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    220212            IF( jn == jp_tem)   pht_ldf(:) = ptr_vj( zftv(:,:,:) ) 
    … …  
    229221               DO jj = 2, jpjm1 
    230222                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    231                      z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk)   & 
    232             &                    * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) * e1u(ji,jj) * fse3u(ji,jj,jk)  
     223                     z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk)       & 
     224                        &       * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) * e1u(ji,jj) * fse3u(ji,jj,jk)  
    233225                  END DO 
    234226               END DO 
    … …  
    240232               DO jj = 2, jpjm1 
    241233                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    242                      z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk)   & 
    243            &                   * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) * e2v(ji,jj) * fse3v(ji,jj,jk)  
     234                     z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk)       & 
     235                        &       * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) * e2v(ji,jj) * fse3v(ji,jj,jk)  
    244236                  END DO 
    245237               END DO 
    … …  
    269261               DO ji = fs_2, fs_jpim1   ! vector opt. 
    270262                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) 
    271                    
     263                  ! 
    272264                  zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      & 
    273265                     &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  ) 
    274                    
    275266                  zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      & 
    276267                     &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  ) 
    277                    
     268                  ! 
    278269                  zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) 
    279270                  zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 
    280                    
     271                  ! 
    281272                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      & 
    282273                     &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   & 
    … …  
    290281         ! I.5 Divergence of vertical fluxes added to the general tracer trend 
    291282         ! ------------------------------------------------------------------- 
    292           
    293283         DO jk = 1, jpkm1 
    294284            DO jj = 2, jpjm1 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r2082 r2104  
    1313   !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC 
    1414   !!---------------------------------------------------------------------- 
     15 
    1516   !!---------------------------------------------------------------------- 
    1617   !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion 
    1718   !!                 using a iso-level harmonic (laplacien) operator. 
    1819   !!---------------------------------------------------------------------- 
    19    !! * Modules used 
    2020   USE oce             ! ocean dynamics and active tracers 
    2121   USE dom_oce         ! ocean space and time domain 
    … …  
    2525   USE trc_oce         ! share passive tracers/Ocean variables 
    2626 
    27  
    2827   IMPLICIT NONE 
    2928   PRIVATE 
    3029 
    31    !! * Routine accessibility 
    32    PUBLIC tra_ldf_lap  ! routine called by step.F90 
     30   PUBLIC   tra_ldf_lap   ! routine called by step.F90 
    3331 
    3432   REAL(wp), DIMENSION(jpi,jpj) ::   e1ur, e2vr   ! scale factor coefficients 
    … …  
    4038   !!---------------------------------------------------------------------- 
    4139   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    42    !! $Id$  
     40   !! $Id$ 
    4341   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    4442   !!---------------------------------------------------------------------- 
    … …  
    4644CONTAINS 
    4745 
    48    SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,  & 
     46   SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,   & 
    4947      &                                ptb, pta, kjpt )  
    5048      !!---------------------------------------------------------------------- 
    … …  
    6866      !!                harmonic mixing trend. 
    6967      !!---------------------------------------------------------------------- 
    70       !! 
    7168      USE oce         , ztu => ua   ! use ua as workspace 
    7269      USE oce         , ztv => va   ! use va as workspace 
    7370      !! 
    74       INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index 
    75       CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator) 
    76       INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers 
    77       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,kjpt  )     ::   pgu, pgv     ! tracer gradient at pstep levels 
    78       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptb          ! before and now tracer fields 
    79       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   pta          ! tracer trend  
     71      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
     72      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
     73      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
     74      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
     75      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    8077      !! 
    81       INTEGER ::   ji, jj, jk, jn          ! dummy loop indices 
    82       INTEGER ::   iku, ikv                ! temporary integers 
    83       REAL(wp) ::   & 
    84          zabe1, zabe2, ztra, zbtr           ! temporary scalars 
     78      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
     79      INTEGER  ::   iku, ikv             ! local integers 
     80      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars 
    8581      !!---------------------------------------------------------------------- 
    8682       
    87       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     83      IF( kt == nit000 )  THEN 
    8884         IF(lwp) WRITE(numout,*) 
    8985         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 
    … …  
    9389      ENDIF 
    9490 
    95       ! 
    96       DO jn = 1, kjpt                                            ! tracer loop 
    97          !                                                       ! ===========       
    98          !                                                  
    99          DO jk = 1, jpkm1                                 
     91      !                                                          ! =========== ! 
     92      DO jn = 1, kjpt                                            ! tracer loop ! 
     93         !                                                       ! =========== !     
     94         DO jk = 1, jpkm1                                            ! slab loop 
    10095            !                                            
    10196            ! 1. First derivative (gradient) 
    … …  
    133128               DO ji = fs_2, fs_jpim1   ! vector opt. 
    134129                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    135                   ! horizontal diffusive trends 
    136                   ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
    137                      &           + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    138                   ! add it to the general tracer trends 
    139                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
     130                  ! horizontal diffusive trends added to the general tracer trends 
     131                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
     132                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    140133               END DO 
    141134            END DO 
    142             !                                               ! ============= 
     135            ! 
    143136         END DO                                             !  End of slab   
    144          !                                                  ! ============= 
     137         ! 
    145138         ! "Poleward" diffusive heat or salt transports 
    146139         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    … …  
    148141            IF( jn  == jp_sal)   pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 
    149142         ENDIF 
    150          ! 
    151       END DO 
    152       ! 
     143         !                                                  ! ================== 
     144      END DO                                                ! end of tracer loop 
     145      !                                                     ! ================== 
    153146   END SUBROUTINE tra_ldf_lap 
    154147 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranpc.F90

    r2082 r2104  
    88   !!   NEMO     1.0  ! 2002-06  (G. Madec)  free form F90 
    99   !!            3.0  ! 2008-06  (G. Madec)  applied on ta, sa and called before tranxt in step.F90 
     10   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    5556      !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 
    5657      !!---------------------------------------------------------------------- 
    57       !!  
    5858      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5959      !! 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranxt.F90

    r2083 r2104  
    1515   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf 
    1616   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option 
     17   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
    1718   !!---------------------------------------------------------------------- 
    1819 
    … …  
    8788      !! 
    8889      INTEGER  ::   jk    ! dummy loop indices 
    89       REAL(wp) ::   zfact ! temporary scalars 
     90      REAL(wp) ::   zfact ! local scalars 
    9091      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds 
    91  
    9292      !!---------------------------------------------------------------------- 
    9393 
    … …  
    131131 
    132132      ! Leap-Frog + Asselin filter time stepping 
    133       IF( lk_vvl )   THEN   ;   CALL tra_nxt_vvl( kt, nit000, tsb, tsn, tsa, jpts )  ! variable volume level (vvl)      
    134       ELSE                  ;   CALL tra_nxt_fix( kt, nit000, tsb, tsn, tsa, jpts )  ! fixed    volume level  
     133      IF( lk_vvl )   THEN   ;   CALL tra_nxt_vvl( kt, tsb, tsn, tsa, jpts )  ! variable volume level (vvl)      
     134      ELSE                  ;   CALL tra_nxt_fix( kt, tsb, tsn, tsa, jpts )  ! fixed    volume level  
    135135      ENDIF 
    136136 
    … …  
    160160   END SUBROUTINE tra_nxt 
    161161 
    162    SUBROUTINE tra_nxt_fix( kt, kit000,                    & 
    163       &                               ptb, ptn, pta, kjpt ) 
     162 
     163   SUBROUTINE tra_nxt_fix( kt, ptb, ptn, pta, kjpt ) 
    164164      !!---------------------------------------------------------------------- 
    165165      !!                   ***  ROUTINE tra_nxt_fix  *** 
    … …  
    184184      !!---------------------------------------------------------------------- 
    185185      INTEGER , INTENT(in   )                               ::  kt            ! ocean time-step index 
    186       INTEGER , INTENT(in   )                               ::  kit000        ! first time-step index 
    187186      INTEGER , INTENT(in   )                               ::  kjpt            ! number of tracers 
    188187      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb  ! before tracer fields 
    … …  
    194193      !!---------------------------------------------------------------------- 
    195194 
    196       IF( kt == kit000 )  THEN 
     195      IF( kt == nit000 )  THEN 
    197196         IF(lwp) WRITE(numout,*) 
    198197         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping' 
    … …  
    204203         !                                           ! ----------------------- ! 
    205204         ! 
    206          IF( neuler == 0 .AND. kt == kit000 ) THEN        ! Euler time-stepping at first time-step 
     205         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
    207206            !                                             ! (only swap) 
    208207            DO jn = 1, kjpt 
    … …  
    234233         !                                           ! ----------------------- ! 
    235234         ! 
    236          IF( neuler == 0 .AND. kt == kit000 ) THEN        ! Euler time-stepping at first time-step 
     235         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
    237236            DO jn = 1, kjpt 
    238237               DO jk = 1, jpkm1 
    … …  
    262261   END SUBROUTINE tra_nxt_fix 
    263262 
    264    SUBROUTINE tra_nxt_vvl( kt, kit000,                    & 
    265       &                               ptb, ptn, pta, kjpt ) 
     263 
     264   SUBROUTINE tra_nxt_vvl( kt, ptb, ptn, pta, kjpt ) 
    266265      !!---------------------------------------------------------------------- 
    267266      !!                   ***  ROUTINE tra_nxt_vvl  *** 
    … …  
    288287      !!---------------------------------------------------------------------- 
    289288      INTEGER , INTENT(in   )                               ::  kt            ! ocean time-step index 
    290       INTEGER , INTENT(in   )                               ::  kit000        ! first time-step index 
    291289      INTEGER , INTENT(in   )                               ::  kjpt            ! number of tracers 
    292290      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::  ptb  ! before tracer fields 
    … …  
    300298      !!---------------------------------------------------------------------- 
    301299 
    302       IF( kt == kit000 ) THEN 
     300      IF( kt == nit000 ) THEN 
    303301         IF(lwp) WRITE(numout,*) 
    304302         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping' 
    … …  
    310308         !                                           ! ----------------------- ! 
    311309         ! 
    312          IF( neuler == 0 .AND. kt == kit000 ) THEN        ! Euler time-stepping at first time-step 
     310         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
    313311            DO jn = 1, kjpt                               ! (only swap) 
    314312               DO jk = 1, jpkm1                               
    … …  
    358356         !                                           ! ----------------------- ! 
    359357         ! 
    360          IF( neuler == 0 .AND. kt == kit000 ) THEN        ! case of Euler time-stepping at first time-step 
     358         IF( neuler == 0 .AND. kt == nit000 ) THEN        ! case of Euler time-stepping at first time-step 
    361359            DO jn = 1, kjpt                               ! No filter nor thickness weighting computation required     
    362360               DO jk = 1, jpkm1                           ! ONLY swap                         

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trasbc.F90

    r2052 r2104  
    44   !! Ocean active tracers:  surface boundary condition 
    55   !!============================================================================== 
    6    !! History :  8.2  !  98-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
    7    !!            8.2  !  01-02  (D. Ludicone)  sea ice and free surface 
    8    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
     6   !! History :  OPA  !  1998-10  (G. Madec, G. Roullet, M. Imbard)  Original code 
     7   !!            8.2  !  2001-02  (D. Ludicone)  sea ice and free surface 
     8   !!  NEMO      1.0  !  2002-06  (G. Madec)  F90: Free form and module 
     9   !!            3.3  !  2010-09  (C. Ethe, G. Madec) Merge TRA-TRC 
    910   !!---------------------------------------------------------------------- 
    1011 
    … …  
    3334#  include "vectopt_loop_substitute.h90" 
    3435   !!---------------------------------------------------------------------- 
    35    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     36   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    3637   !! $Id$ 
    3738   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    100101      !!              - save the trend it in ttrd ('key_trdtra') 
    101102      !!---------------------------------------------------------------------- 
    102       !! 
    103       INTEGER, INTENT(in) ::   kt     ! ocean time-step index 
    104       !! 
    105       INTEGER  ::   ji, jj, jk           ! dummy loop indices   
    106       REAL(wp) ::   zta, zsa             ! temporary scalars, adjustment to temperature and salinity   
    107       REAL(wp) ::   zata, zasa           ! temporary scalars, calculations of automatic change to temp & sal due to vvl (done elsewhere)   
    108       REAL(wp) ::   zsrau, zse3t, zdep   ! temporary scalars, 1/density, 1/height of box, 1/height of effected water column   
     103      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     104      !! 
     105      INTEGER  ::   ji, jj, jk      ! dummy loop indices   
     106      REAL(wp) ::   zta, zsa        ! local scalars, adjustment to temperature and salinity   
     107      REAL(wp) ::   zata, zasa      ! local scalars, calculations of automatic change to temp & sal due to vvl (done elsewhere)   
     108      REAL(wp) ::   zsrau, zse3t, zdep   ! local scalars, 1/density, 1/height of box, 1/height of effected water column   
    109109      REAL(wp) ::   zdheat, zdsalt       ! total change of temperature and salinity   
    110110      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds 
    … …  
    136136#endif 
    137137            IF( lk_vvl) THEN 
    138                zta =  ro0cpr * qns(ji,jj) * zse3t &                  ! temperature : heat flux  
    139                 &    - emp(ji,jj) * zsrau * tsn(ji,jj,1,jp_tem) * zse3t      ! & cooling/heating effet of EMP flux  
    140                zsa = ( emps(ji,jj) - emp(ji,jj) ) & 
    141                 &                 * zsrau * tsn(ji,jj,1,jp_sal) * zse3t     ! concent./dilut. effect due to sea-ice  
    142                                                                      ! melt/formation and (possibly) SSS restoration 
     138               ! temperature : heat flux and heat content of EMP flux 
     139               zta = ( ro0cpr * qns(ji,jj) - emp(ji,jj) * zsrau * tsn(ji,jj,1,jp_tem) ) * zse3t 
     140               ! Salinity    : concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration 
     141               zsa = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal) * zse3t 
    143142            ELSE 
    144                zta =  ro0cpr * qns(ji,jj) * zse3t                    ! temperature : heat flux  
    145                zsa =  emps(ji,jj) * zsrau * tsn(ji,jj,1,jp_sal) * zse3t      ! salinity :  concent./dilut. effect  
     143               zta =  ro0cpr * qns(ji,jj) * zse3t                         ! temperature : heat flux  
     144               zsa =  emps(ji,jj) * zsrau * tsn(ji,jj,1,jp_sal) * zse3t   ! salinity :  concent./dilut. effect  
    146145            ENDIF 
    147146            tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta                  ! add the trend to the general tracer trend 
    … …  
    150149      END DO 
    151150 
    152       IF ( ln_rnf .AND. ln_rnf_att ) THEN   
    153         ! Concentration / dilution effect on (t,s) due to river runoff   
     151      IF( ln_rnf .AND. ln_rnf_att ) THEN        ! Concentration / dilution effect on (t,s) due to river runoff   
    154152        DO jj = 1, jpj   
    155153           DO ji = 1, jpi   
    156               rnf_dep(ji,jj) = 0.   
     154              rnf_dep(ji,jj) = 0.e0  
    157155              DO jk = 1, rnf_mod_dep(ji,jj)                          ! recalculates rnf_dep to be the depth   
    158156                rnf_dep(ji,jj) = rnf_dep(ji,jj) + fse3t(ji,jj,jk)    ! in metres to the bottom of the relevant grid box   
    159               ENDDO   
     157              END DO   
    160158              zdep = 1. / rnf_dep(ji,jj)   
    161159              zse3t= 1. / fse3t(ji,jj,1)   
    162               IF ( rnf_tmp(ji,jj) == -999 )   rnf_tmp(ji,jj) = tsn(ji,jj,1,jp_tem)    ! if not specified set runoff temp to be sst   
    163    
    164               IF ( rnf(ji,jj) > 0.0 ) THEN   
     160              IF( rnf_tmp(ji,jj) == -999 )   rnf_tmp(ji,jj) = tsn(ji,jj,1,jp_tem)   ! if not specified set runoff temp to be sst   
     161   
     162              IF( rnf(ji,jj) > 0.e0 ) THEN   
    165163   
    166164                IF( lk_vvl ) THEN   
    167165                  ! indirect flux, concentration or dilution effect : force a dilution effect in all levels  
    168                   zdheat = 0.0   
    169                   zdsalt = 0.0   
     166                  zdheat = 0.e0   
     167                  zdsalt = 0.e0   
    170168                  DO jk = 1, rnf_mod_dep(ji,jj)   
    171169                    zta = -tsn(ji,jj,jk,jp_tem) * rnf(ji,jj) * zsrau * zdep   
    172170                    zsa = -tsn(ji,jj,jk,jp_sal) * rnf(ji,jj) * zsrau * zdep   
    173                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta                  ! add the trend to the general tracer trend 
     171                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta        ! add the trend to the general tracer trend 
    174172                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    175173                    zdheat = zdheat + zta * fse3t(ji,jj,jk)   
    176174                    zdsalt = zdsalt + zsa * fse3t(ji,jj,jk)   
    177                   ENDDO   
    178                   ! negate this total change in heat and salt content from top level   
     175                  END DO   
     176                  ! negate this total change in heat and salt content from top level    !!gm I don't understand this 
    179177                  zta = -zdheat * zse3t   
    180178                  zsa = -zdsalt * zse3t   
    181                   tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta                  ! add the trend to the general tracer trend 
     179                  tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta            ! add the trend to the general tracer trend 
    182180                  tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + zsa 
    183181     
    … …  
    187185     
    188186                  DO jk = 1, rnf_mod_dep(ji,jj)   
    189                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta                  ! add the trend to the general tracer trend 
     187                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta        ! add the trend to the general tracer trend 
    190188                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    191                   ENDDO   
    192     
     189                  END DO   
    193190                ELSE   
    194191                  DO jk = 1, rnf_mod_dep(ji,jj)   
    195192                    zta = ( rnf_tmp(ji,jj) - tsn(ji,jj,jk,jp_tem) ) * rnf(ji,jj) * zsrau * zdep   
    196193                    zsa = ( rnf_sal(ji,jj) - tsn(ji,jj,jk,jp_sal) ) * rnf(ji,jj) * zsrau * zdep   
    197                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta                  ! add the trend to the general tracer trend 
     194                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta        ! add the trend to the general tracer trend 
    198195                    tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    199                   ENDDO   
     196                  END DO   
    200197                ENDIF   
    201198   
    202               ELSE IF( rnf(ji,jj) < 0.) THEN   ! for use in baltic when flow is out of domain, want no change in temp and sal   
     199              ELSEIF( rnf(ji,jj) < 0.e0) THEN   ! for use in baltic when flow is out of domain, want no change in temp and sal   
    203200   
    204201                IF( lk_vvl ) THEN   
    … …  
    212209              ENDIF   
    213210   
    214            ENDDO   
    215         ENDDO   
    216  
    217       ELSE IF( ln_rnf ) THEN 
    218  
    219       ! Concentration dilution effect on (t,s) due to runoff without temperatue, salinity and depth attributes 
     211           END DO   
     212        END DO   
     213 
     214      ELSE IF( ln_rnf ) THEN      ! Concentration dilution effect on (t,s) due to runoff without T, S and depth attributes 
     215 
     216 
    220217        DO jj = 2, jpj 
    221218           DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    225222              IF( lk_vvl) THEN 
    226223                 zta =    rnf(ji,jj) * zsrau * tsn(ji,jj,1,jp_tem) * zse3t       ! & cooling/heating effect of runoff 
    227                  zsa =    0.e0                                            ! No salinity concent./dilut. effect 
     224                 zsa =    0.e0                                                   ! No salinity concent./dilut. effect 
    228225              ELSE 
    229226                 zta =    0.0                                            ! temperature : heat flux  

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traswp.F90

    r2034 r2104  
    44   !! Ocean active tracers: swapping array  
    55   !!============================================================================== 
    6    USE par_oce 
     6   USE par_oce         ! ocean parameters 
    77   USE oce             ! ocean dynamics and active tracers 
    88 
    … …  
    1515   !!---------------------------------------------------------------------- 
    1616   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    17    !! $Id: traswap.F90 2024 2010-07-29 10:57:35Z cetlod $  
     17   !! $Id: $  
    1818   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1919   !!---------------------------------------------------------------------- 
    … …  
    2828      !! 
    2929      !!---------------------------------------------------------------------- 
    30  
     30      ! 
    3131      tsn(:,:,:,jp_tem) = tn(:,:,:)      ;      tsn(:,:,:,jp_sal) = sn(:,:,:) 
    3232      tsb(:,:,:,jp_tem) = tb(:,:,:)      ;      tsb(:,:,:,jp_sal) = sb(:,:,:) 
    3333      tsa(:,:,:,jp_tem) = ta(:,:,:)      ;      tsa(:,:,:,jp_sal) = sa(:,:,:) 
    34  
     34      ! 
    3535   END SUBROUTINE tra_swap 
    3636 
    … …  
    4242      !! 
    4343      !!---------------------------------------------------------------------- 
    44  
     44      ! 
    4545      tn(:,:,:) = tsn(:,:,:,jp_tem)      ;      sn(:,:,:) = tsn(:,:,:,jp_sal) 
    4646      tb(:,:,:) = tsb(:,:,:,jp_tem)      ;      sb(:,:,:) = tsb(:,:,:,jp_sal) 
    4747      ta(:,:,:) = tsa(:,:,:,jp_tem)      ;      sa(:,:,:) = tsa(:,:,:,jp_sal) 
    48  
     48      ! 
    4949   END SUBROUTINE tra_unswap 
    5050 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf.F90

    r2082 r2104  
    44   !! Ocean active tracers:  vertical component of the tracer mixing trend 
    55   !!============================================================================== 
    6    !! History :  9.0  ! 2005-11  (G. Madec)  Original code 
    7    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
     6   !! History :  1.0  ! 2005-11  (G. Madec)  Original code 
     7   !!           3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
    88   !!---------------------------------------------------------------------- 
    99 
    1010   !!---------------------------------------------------------------------- 
    1111   !!   tra_zdf      : Update the tracer trend with the vertical diffusion 
    12    !!       zdf_ctl  : ??? 
     12   !!   tra_zdf_init : initialisation of the computation 
    1313   !!---------------------------------------------------------------------- 
    1414   USE oce             ! ocean dynamics and tracers variables 
    … …  
    4747#  include "vectopt_loop_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    49    !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 
     49   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    5050   !! $Id$ 
    5151   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    6161      !!--------------------------------------------------------------------- 
    6262      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    63  
     63      !! 
    6464      INTEGER  ::   jk                   ! Dummy loop indices 
    6565      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace 
    … …  
    124124      !!---------------------------------------------------------------------- 
    125125 
    126       !  Define the vertical tracer physics scheme 
    127       ! ========================================== 
    128  
    129126      ! Choice from ln_zdfexp already read in namelist in zdfini module 
    130       IF( ln_zdfexp ) THEN               ! use explicit scheme 
    131          nzdf = 0 
    132       ELSE                               ! use implicit scheme 
    133          nzdf = 1 
     127      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme 
     128      ELSE                   ;   nzdf = 1           ! use implicit scheme 
    134129      ENDIF 
    135130 
    … …  
    138133      IF( ln_traldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics 
    139134      IF( ln_traldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate 
    140  
    141       IF( ln_zdfexp .AND. nzdf == 1 )   THEN 
    142          CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator or TKE ', & 
    143             &           '          or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' ) 
    144       ENDIF 
     135      IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   & 
     136            &                         ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' ) 
    145137 
    146138      ! Test: esopa 
    … …  
    155147         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme' 
    156148      ENDIF 
    157  
     149      ! 
    158150   END SUBROUTINE tra_zdf_init 
    159151 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_exp.F90

    r2082 r2104  
    4141#  include "vectopt_loop_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA  3.3 , LOCEAN-IPSL (2010)  
    44    !! $Id$  
     43   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     44   !! $Id$ 
    4545   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    … …  
    4848CONTAINS 
    4949 
    50    SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp,  & 
     50   SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp,   & 
    5151      &                                ptb , pta      , kjpt ) 
    5252      !!---------------------------------------------------------------------- 
    … …  
    7373      !! ** Action : - after tracer fields pta 
    7474      !!--------------------------------------------------------------------- 
    75       !!  
    76       INTEGER         , INTENT(in   )                                ::   kt          ! ocean time-step index 
    77       CHARACTER(len=3), INTENT(in   )                                ::   cdtype      ! =TRA or TRC (tracer indicator) 
    78       INTEGER         , INTENT(in   )                                ::   kjpt        ! number of tracers 
    79       INTEGER         , INTENT(in   )                                ::   kn_zdfexp   ! number of sub-time step 
    80       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)                ::   p2dt        ! vertical profile of tracer time-step 
    81       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptb       ! before and now tracer fields 
    82       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   pta       ! tracer trend  
     75      INTEGER                              , INTENT(in   ) ::   kt          ! ocean time-step index 
     76      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype      ! =TRA or TRC (tracer indicator) 
     77      INTEGER                              , INTENT(in   ) ::   kjpt        ! number of tracers 
     78      INTEGER                              , INTENT(in   ) ::   kn_zdfexp   ! number of sub-time step 
     79      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend  
    8382      !!  
    8483      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices 
    85       REAL(wp) ::  zlavmr, zave3r, ze3tr     ! temporary scalars 
    86       REAL(wp) ::  ztra, ze3tb               ! temporary scalars 
     84      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! local scalars 
     85      REAL(wp) ::  ztra, ze3tb               !   -      - 
    8786      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy   ! 3D workspace 
    8887      !!--------------------------------------------------------------------- 
    8988 
    90       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     89      IF( kt == nit000 )  THEN 
    9190         IF(lwp) WRITE(numout,*) 
    9291         IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype 
    … …  
    9695      ! Initializations 
    9796      ! --------------- 
    98       zlavmr = 1. / float( kn_zdfexp )                           ! Local constant 
     97      zlavmr = 1. / float( kn_zdfexp )         ! Local constant 
    9998      ! 
    10099      ! 
    101       DO jn = 1, kjpt 
     100      DO jn = 1, kjpt                          ! loop over tracers 
    102101         ! 
    103102         zwy(:,:, 1 ) = 0.e0     ! surface boundary conditions: no flux 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r2082 r2104  
    8989      !! 
    9090      !!--------------------------------------------------------------------- 
    91       !!  
    9291      USE oce    , ONLY :   zwd   => ua   ! ua used as workspace 
    9392      USE oce    , ONLY :   zws   => va   ! va  -          - 
    9493      !!  
    95       INTEGER         , INTENT(in   )                                ::   kt             ! ocean time-step index 
    96       CHARACTER(len=3), INTENT(in   )                                ::   cdtype         ! =TRA or TRC (tracer indicator) 
    97       INTEGER         , INTENT(in   )                                ::   kjpt            ! number of tracers 
    98       REAL(wp)        , INTENT(in   ), DIMENSION(jpk)                ::   p2dt        ! vertical profile of tracer time-step 
    99       REAL(wp)        , INTENT(in   ), DIMENSION(jpi,jpj,jpk,kjpt)   ::   ptb          ! before and now tracer fields 
    100       REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)   ::   pta          ! tracer trend  
     94      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
     95      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
     96      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers 
     97      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step 
     98      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields 
     99      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
    101100      !! 
    102101      INTEGER  ::  ji, jj, jk, jn        ! dummy loop indices 
    103       REAL(wp) ::  zavi, zrhs, znvvl     ! temporary scalars 
     102      REAL(wp) ::  zavi, zrhs, znvvl     ! local scalars 
    104103      REAL(wp) ::  ze3tb, ze3tn, ze3ta   ! variable vertical scale factors 
    105104      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwi, zwt   ! workspace arrays 
    106105      !!--------------------------------------------------------------------- 
    107106 
    108       IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) )  THEN 
     107      IF( kt == nit000 )  THEN 
    109108         IF(lwp)WRITE(numout,*) 
    110109         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype 
    … …  
    287286               DO ji = fs_2, fs_jpim1 
    288287                  pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) ) & 
    289                   &                    / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
     288                     &             / zwt(ji,jj,jk) * tmask(ji,jj,jk) 
    290289               END DO 
    291290            END DO 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90

    r2082 r2104  
    44   !! z-coordinate - partial step : Horizontal Derivative 
    55   !!============================================================================== 
    6    !! History : 
    7    !!       OPA   8.5  !  2002-04  (A. Bozec)  Original code 
    8    !!             8.5  !  2002-08  (G. Madec E. Durand)  Optimization and Free form 
    9    !!             9.0  !  2004-03  (C. Ethe)  adapted for passive tracers 
    10    !!      NEMO   3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA  
     6   !! History :  OPA  !  2002-04  (A. Bozec)  Original code 
     7   !!            8.5  !  2002-08  (G. Madec E. Durand)  Optimization and Free form 
     8   !!   NEMO     1.0  !  2004-03  (C. Ethe)  adapted for passive tracers 
     9   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA  
    1110   !!============================================================================== 
    1211    
    … …  
    1514   !!                   ocean level (Z-coord. with Partial Steps) 
    1615   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1816   USE dom_oce         ! ocean space domain variables 
    1917   USE oce             ! ocean dynamics and tracers variables 
    … …  
    2624   PRIVATE 
    2725 
    28    !! * Routine accessibility 
    29    PUBLIC zps_hde          ! routine called by step.F90 
    30    PUBLIC zps_hde_init     ! routine called by opa.F90 
    31  
    32    !! * module variables 
    33    INTEGER, DIMENSION(jpi,jpj) ::   & 
    34       mbatu, mbatv      ! bottom ocean level index at U- and V-points 
     26   PUBLIC   zps_hde        ! routine called by step.F90 
     27   PUBLIC   zps_hde_init   ! routine called by opa.F90 
     28 
     29   INTEGER, DIMENSION(jpi,jpj) ::   mbatu, mbatv   ! bottom ocean level index at U- and V-points 
    3530 
    3631   !! * Substitutions 
    … …  
    3833#  include "vectopt_loop_substitute.h90" 
    3934   !!---------------------------------------------------------------------- 
    40    !!---------------------------------------------------------------------- 
    41    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    42    !! $Id$  
    43    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     35   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     36   !! $Id$ 
     37   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4438   !!---------------------------------------------------------------------- 
    4539CONTAINS 
    … …  
    9084      !!                and rd at V-points  
    9185      !!---------------------------------------------------------------------- 
    92       !! * Arguments 
    93       INTEGER                              , INTENT( in )           ::  kt    ! ocean time-step index 
    94       INTEGER                              , INTENT( in )           ::  kjpt  ! number of tracers 
    95       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in )           ::  pta   ! 4D active or passive tracers fields 
    96       REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT( out)           ::  pgtu, pgtv  ! horizontal grad. of ptra u- and v-points  
    97       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT( in ), OPTIONAL ::  prd   ! 3D rd fields 
    98       REAL(wp), DIMENSION(jpi,jpj         ), INTENT( out), OPTIONAL ::  pgru, pgrv  ! horizontal grad. of prd u- and v-points  
    99       !! * Local declarations 
     86      INTEGER                              , INTENT(in   )           ::  kt          ! ocean time-step index 
     87      INTEGER                              , INTENT(in   )           ::  kjpt        ! number of tracers 
     88      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   )           ::  pta         ! 4D tracers fields 
     89      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(  out)           ::  pgtu, pgtv  ! hor. grad. of ptra at u- & v-pts  
     90      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ), OPTIONAL ::  prd         ! 3D density anomaly fields 
     91      REAL(wp), DIMENSION(jpi,jpj         ), INTENT(  out), OPTIONAL ::  pgru, pgrv  ! hor. grad. of prd at u- & v-pts  
     92      !! 
    10093      INTEGER  ::   ji, jj, jn      ! Dummy loop indices 
    10194      INTEGER  ::   iku, ikv        ! partial step level at u- and v-points 
    … …  
    109102      ! Interpolation of tracers at the last ocean level 
    110103      DO jn = 1, kjpt 
     104         ! 
    111105# if defined key_vectopt_loop 
    112106         jj = 1 
    … …  
    155149# endif 
    156150         END DO 
    157  
    158          ! Lateral boundary conditions on each gradient 
    159          CALL lbc_lnk( pgtu(:,:,jn) , 'U', -1. ) 
    160          CALL lbc_lnk( pgtv(:,:,jn) , 'V', -1. ) 
    161  
     151         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond. 
     152         ! 
    162153      END DO 
    163154 
    164       ! horizontal derivative of rd 
    165       IF( PRESENT( prd ) ) THEN 
    166          ! depth of the partial step level 
     155      ! horizontal derivative of density anomalies (rd) 
     156      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    167157# if defined key_vectopt_loop 
    168158         jj = 1 
    … …  
    193183         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 
    194184         ! step and store it in  zri, zrj for each  case 
    195          CALL eos( zti, zhi, zri ) 
    196          CALL eos( ztj, zhj, zrj ) 
     185         CALL eos( zti, zhi, zri )   ;   CALL eos( ztj, zhj, zrj ) 
    197186 
    198187         ! Gradient of density at the last level  
    … …  
    222211# endif 
    223212         END DO 
    224  
    225          ! Lateral boundary conditions on each gradient 
    226          CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. ) 
     213         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions 
    227214         ! 
    228215      END IF 
    … …  
    230217   END SUBROUTINE zps_hde 
    231218 
     219 
    232220   SUBROUTINE zps_hde_init 
    233221      !!---------------------------------------------------------------------- 
    … …  
    237225      !!                     
    238226      !!---------------------------------------------------------------------- 
    239       !! * Local declarations 
    240       INTEGER ::   ji, jj           ! Dummy loop indices 
    241       REAL(wp), DIMENSION(jpi,jpj) :: zti, ztj     !  temporary arrays  
    242       !!---------------------------------------------------------------------- 
    243  
     227      INTEGER ::   ji, jj   ! Dummy loop indices 
     228      REAL(wp), DIMENSION(jpi,jpj) ::   zti, ztj     ! 2D workspace  
     229      !!---------------------------------------------------------------------- 
     230      ! 
    244231      mbatu(:,:) = 0 
    245232      mbatv(:,:) = 0 
    … …  
    253240      ztj(:,:) = FLOAT( mbatv(:,:) ) 
    254241      ! lateral boundary conditions: T-point, sign unchanged 
    255       CALL lbc_lnk( zti , 'U', 1. ) 
    256       CALL lbc_lnk( ztj , 'V', 1. ) 
     242      CALL lbc_lnk( zti , 'U', 1. )   ;   CALL lbc_lnk( ztj , 'V', 1. ) 
    257243      mbatu(:,:) = MAX( INT( zti(:,:) ), 2 ) 
    258244      mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 ) 
    259  
     245      ! 
    260246   END SUBROUTINE zps_hde_init 
    261247   !!====================================================================== 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdicp.F90

    r2082 r2104  
    44   !! Ocean diagnostics:  ocean tracers and dynamic trends 
    55   !!===================================================================== 
    6    !! History :       !  91-12 (G. Madec) 
    7    !!                 !  92-06 (M. Imbard) add time step frequency 
    8    !!                 !  96-01 (G. Madec)  terrain following coordinates 
    9    !!            8.5  !  02-06 (G. Madec)  F90: Free form and module 
    10    !!            9.0  !  04-08 (C. Talandier) New trends organization 
     6   !! History :  1.0  !  2004-08 (C. Talandier) New trends organization 
    117   !!---------------------------------------------------------------------- 
    128#if  defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa 
    … …  
    1410   !!   'key_trdtra'  or                  active tracers trends diagnostics 
    1511   !!   'key_trddyn'                            momentum trends diagnostics 
    16    !!---------------------------------------------------------------------- 
    1712   !!---------------------------------------------------------------------- 
    1813   !!   trd_icp          : compute the basin averaged properties for tra/dyn  
    … …  
    4843#  include "vectopt_loop_substitute.h90" 
    4944   !!---------------------------------------------------------------------- 
    50    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    51    !! $Id$  
     45   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     46   !! $Id$ 
    5247   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5348   !!---------------------------------------------------------------------- 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdmod.F90

    r2026 r2104  
    44   !! Ocean diagnostics:  ocean tracers and dynamic trends 
    55   !!===================================================================== 
    6    !! History :  9.0  !  04-08  (C. Talandier) Original code 
    7    !!                 !  05-04  (C. Deltel)    Add Asselin trend in the ML budget 
     6   !! History :  1.0  !  2004-08  (C. Talandier) Original code 
     7   !!             -   !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget 
     8   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    89   !!---------------------------------------------------------------------- 
    910#if  defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa 
    … …  
    3637#  include "vectopt_loop_substitute.h90" 
    3738   !!---------------------------------------------------------------------- 
    38    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     39   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    3940   !! $Id$ 
    4041   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    216217 
    217218      ENDIF 
    218  
     219      ! 
    219220   END SUBROUTINE trd_mod 
    220221 
    221 #   else 
     222#else 
    222223   !!---------------------------------------------------------------------- 
    223224   !!   Default case :                                         Empty module 
    … …  
    230231CONTAINS 
    231232   SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt )   ! Empty routine 
    232       REAL, DIMENSION(:,:,:), INTENT( in ) ::   & 
    233           ptrd3dx,                     &                           ! Temperature or U trend  
    234           ptrd3dy                                                  ! Salinity    or V trend 
    235       INTEGER, INTENT( in ) ::   ktrd                              ! momentum or tracer trend index 
    236       INTEGER, INTENT( in ) ::   kt                                ! Time step 
    237       CHARACTER(len=3), INTENT( in ) ::  ctype                     ! momentum or tracers trends type 
    238       WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1) 
    239       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ptrd3dy(1,1,1) 
    240       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd 
    241       WRITE(*,*) ' "   ": You should not have seen this print! error ?', ctype 
    242       WRITE(*,*) ' "   ": You should not have seen this print! error ?', kt 
     233      REAL    ::   ptrd3dx(:,:,:), ptrd3dy(:,:,:) 
     234      INTEGER ::   ktrd, kt                             
     235      CHARACTER(len=3) ::  ctype                   
     236      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1) 
     237      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd, ctype, kt 
    243238   END SUBROUTINE trd_mod 
    244 #   endif 
     239#endif 
    245240 
    246241   SUBROUTINE trd_mod_init 
    … …  
    251246      !!---------------------------------------------------------------------- 
    252247      USE in_out_manager          ! I/O manager 
    253  
     248      !!     
    254249      NAMELIST/namtrd/ nn_trd, nn_ctls, cn_trdrst_in, cn_trdrst_out, ln_trdmld_restart, rn_ucf, ln_trdmld_instant 
    255250      !!---------------------------------------------------------------------- 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdmod_oce.F90

    r2026 r2104  
    44   !! Ocean trends :   set tracer and momentum trend variables 
    55   !!====================================================================== 
    6    !! History :  9.0  !  04-08  (C. Talandier) Original code 
     6   !! History :  1.0  !  2004-08  (C. Talandier) Original code 
    77   !!---------------------------------------------------------------------- 
    88   USE trdicp_oce              ! ocean momentum/tracers bassin properties trends variables 
    … …  
    3838   LOGICAL , PUBLIC ::   l_trdtrc = .FALSE.               !: tracers  trend flag 
    3939# endif 
    40    !                                                   !!! Active tracers trends indexes 
    41    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_xad =  1   !: x- horizontal advection 
    42    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_yad =  2   !: y- horizontal advection 
    43    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zad =  3   !: z- vertical   advection 
    44    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_ldf =  4   !: lateral       diffusion 
    45    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zdf =  5   !: vertical diffusion (Kz) 
    46    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbc =  6   !: Bottom Boundary Condition (geoth. flux)  
    47    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbl =  7   !: Bottom Boundary Layer (diffusive/convective) 
    48    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_npc =  8   !: static instability mixing 
    49    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_dmp =  9   !: damping 
    50    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_qsr = 10   !: penetrative solar radiation 
    51    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_nsr = 11   !: non solar radiation 
    52    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_atf = 12   !: Asselin correction 
     40   !                                                     !!!* Active tracers trends indexes 
     41   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_xad =  1     !: x- horizontal advection 
     42   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_yad =  2     !: y- horizontal advection 
     43   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zad =  3     !: z- vertical   advection 
     44   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_ldf =  4     !: lateral       diffusion 
     45   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zdf =  5     !: vertical diffusion (Kz) 
     46   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbc =  6     !: Bottom Boundary Condition (geoth. flux)  
     47   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbl =  7     !: Bottom Boundary Layer (diffusive/convective) 
     48   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_npc =  8     !: static instability mixing 
     49   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_dmp =  9     !: damping 
     50   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_qsr = 10     !: penetrative solar radiation 
     51   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_nsr = 11     !: non solar radiation 
     52   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_atf = 12     !: Asselin correction 
    5353#if defined key_top 
    54    !!* Passive tracers trends indexes 
    55    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_sms  = 13   !: sources m. sinks 
    56    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_radn = 14   !: corr. trn<0 in trcrad 
    57    INTEGER, PUBLIC, PARAMETER ::   jptra_trd_radb = 15   !: corr. trb<0 in trcrad (like atf) 
     54   !                                                     !!!* Passive tracers trends indexes 
     55   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_sms  = 13    !: sources m. sinks 
     56   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_radn = 14    !: corr. trn<0 in trcrad 
     57   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_radb = 15    !: corr. trb<0 in trcrad (like atf) 
    5858#endif 
    5959    
    60    !                                                   !!! Momentum trends indexes 
    61    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_hpg =  1   !: hydrostatic pressure gradient  
    62    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_keg =  2   !: kinetic energy gradient 
    63    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_rvo =  3   !: relative vorticity 
    64    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_pvo =  4   !: planetary vorticity 
    65    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_ldf =  5   !: lateral diffusion 
    66    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_had =  6   !: horizontal advection 
    67    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zad =  7   !: vertical advection 
    68    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zdf =  8   !: vertical diffusion 
    69    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_spg =  9   !: surface pressure gradient 
    70    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_dat = 10   !: damping term 
    71    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_swf = 11   !: surface wind forcing 
    72    INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_bfr = 12   !: bottom friction  
     60   !                                                     !!!* Momentum trends indexes 
     61   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_hpg =  1     !: hydrostatic pressure gradient  
     62   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_keg =  2     !: kinetic energy gradient 
     63   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_rvo =  3     !: relative vorticity 
     64   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_pvo =  4     !: planetary vorticity 
     65   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_ldf =  5     !: lateral diffusion 
     66   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_had =  6     !: horizontal advection 
     67   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zad =  7     !: vertical advection 
     68   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zdf =  8     !: vertical diffusion 
     69   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_spg =  9     !: surface pressure gradient 
     70   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_dat = 10     !: damping term 
     71   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_swf = 11     !: surface wind forcing 
     72   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_bfr = 12     !: bottom friction  
    7373 
    7474   !!---------------------------------------------------------------------- 
    75    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    76    !! $Id$  
     75   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     76   !! $Id$ 
    7777   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    7878   !!====================================================================== 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdmod_trc.F90

    r2026 r2104  
    55   !!====================================================================== 
    66   !!---------------------------------------------------------------------- 
    7    !!   Dummy module                                     NO TOP use 
     7   !!   Dummy module                                             NO TOP use 
    88   !!---------------------------------------------------------------------- 
    99CONTAINS 
    1010 
    1111   SUBROUTINE trd_mod_trc( ptrtrd, kjn, ktrd, kt ) 
    12       INTEGER               , INTENT( in )     ::   kt      ! time step 
    13       INTEGER               , INTENT( in )     ::   kjn     ! tracer index 
    14       INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index 
    15       REAL, DIMENSION(:,:,:), INTENT( in )     ::   ptrtrd  ! Temperature or U trend 
     12      INTEGER ::   kt, kjn, ktrd    
     13      REAL    ::   ptrtrd(:,:,:)   
    1614      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1) 
    17       WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn 
    18       WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd 
    19       WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt 
     15      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn, ktrd, kt 
    2016   END SUBROUTINE trd_mod_trc 
    2117 
     18   !!====================================================================== 
    2219END MODULE trdmod_trc 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r2027 r2104  
    77   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
    88   !!            3.2  ! 2009-09  (A.C.Coward)  Correction to include barotropic contribution 
     9   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    910   !!---------------------------------------------------------------------- 
    1011 
    … …  
    1213   !!   zdf_bfr      : update momentum Kz at the ocean bottom due to the type of bottom friction chosen 
    1314   !!   zdf_bfr_init : read in namelist and control the bottom friction parameters. 
    14    !!   zdf_bfr_2d   : read in namelist and control the bottom friction 
    15    !!                  parameters. 
     15   !!   zdf_bfr_2d   : read in namelist and control the bottom friction parameters. 
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce             ! ocean dynamics and tracers variables 
    … …  
    4444#  include "domzgr_substitute.h90" 
    4545   !!---------------------------------------------------------------------- 
    46    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    47    !! $Id$  
     46   !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010)  
     47   !! $Id$ 
    4848   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4949   !!---------------------------------------------------------------------- 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r2027 r2104  
    66   !! History :  OPA  ! 2000-08  (G. Madec)  double diffusive mixing 
    77   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     8   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_zdfddm   ||   defined key_esopa 
    … …  
    3940#  include "vectopt_loop_substitute.h90" 
    4041   !!---------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    42    !! $Id$  
     42   !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010)  
     43   !! $Id$ 
    4344   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4445   !!---------------------------------------------------------------------- 
    … …  
    9798            DO ji = 1, jpi 
    9899               ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
    99                IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN 
    100                   zmsks(ji,jj) = 0.e0 
    101                ELSE 
    102                   zmsks(ji,jj) = 1.e0 
     100               IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0.e0 
     101               ELSE                                       ;   zmsks(ji,jj) = 1.e0 
    103102               ENDIF 
    104103               ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere             
    105                IF( rrau(ji,jj,jk) <= 1. ) THEN 
    106                   zmskf(ji,jj) = 0.e0 
    107                ELSE 
    108                   zmskf(ji,jj) = 1.e0 
     104               IF( rrau(ji,jj,jk) <= 1.          ) THEN   ;   zmskf(ji,jj) = 0.e0 
     105               ELSE                                       ;   zmskf(ji,jj) = 1.e0 
    109106               ENDIF 
    110107               ! diffusive layering indicators:  
    111                !   mskdl1=1 if 0<rrau<1; 0 elsewhere 
    112                IF( rrau(ji,jj,jk) >= 1. ) THEN 
    113                   zmskd1(ji,jj) = 0.e0 
    114                ELSE 
    115                   zmskd1(ji,jj) = 1.e0 
    116                ENDIF 
    117                !   mskdl2=1 if 0<rrau<0.5; 0 elsewhere 
    118                IF( rrau(ji,jj,jk) >= 0.5 ) THEN 
    119                   zmskd2(ji,jj) = 0.e0 
    120                ELSE 
    121                   zmskd2(ji,jj) = 1.e0 
     108               !     ! mskdl1=1 if 0<rrau<1; 0 elsewhere 
     109               IF( rrau(ji,jj,jk) >= 1.          ) THEN   ;   zmskd1(ji,jj) = 0.e0 
     110               ELSE                                       ;   zmskd1(ji,jj) = 1.e0 
     111               ENDIF 
     112               !     ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere 
     113               IF( rrau(ji,jj,jk) >= 0.5         ) THEN   ;   zmskd2(ji,jj) = 0.e0 
     114               ELSE                                       ;   zmskd2(ji,jj) = 1.e0 
    122115               ENDIF 
    123116               !   mskdl3=1 if 0.5<rrau<1; 0 elsewhere 
    124                IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN 
    125                   zmskd3(ji,jj) = 0.e0 
    126                ELSE 
    127                   zmskd3(ji,jj) = 1.e0 
     117               IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0.e0 
     118               ELSE                                                         ;   zmskd3(ji,jj) = 1.e0 
    128119               ENDIF 
    129120            END DO 
    … …  
    226217      WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt 
    227218   END SUBROUTINE zdf_ddm 
     219   SUBROUTINE zdf_ddm_init            ! Dummy routine 
     220   END SUBROUTINE zdf_ddm_init 
    228221#endif 
    229222 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r2027 r2104  
    55   !!                 turbulent closure parameterization 
    66   !!===================================================================== 
    7    !! History :  8.1  ! 00-03 (W.G. Large, J. Chanut) Original code 
    8    !!            8.1  ! 02-06 (J.M. Molines) for real case CLIPPER   
    9    !!            8.2  ! 03-10 (Chanut J.) re-writting 
    10    !!            9.0  ! 05-01 (C. Ethe) Free form, F90 
     7   !! History :  OPA  ! 2000-03 (W.G. Large, J. Chanut) Original code 
     8   !!            8.1  ! 2002-06 (J.M. Molines) for real case CLIPPER   
     9   !!            8.2  ! 2003-10 (Chanut J.) re-writting 
     10   !!   NEMO     1.0  ! 2005-01 (C. Ethe, G. Madec) Free form, F90 + creation of tra_kpp routine 
     11   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_zdfkpp   ||   defined key_esopa 
    … …  
    1415   !!   'key_zdfkpp'                                             KPP scheme 
    1516   !!---------------------------------------------------------------------- 
    16    !!---------------------------------------------------------------------- 
    1717   !!   zdf_kpp      : update momentum and tracer Kz from a kpp scheme 
    1818   !!   zdf_kpp_init : initialization, namelist read, and parameters control 
     19   !!   tra_kpp      : compute and add to the T & S trend the non-local flux 
     20   !!   trc_kpp      : compute and add to the passive tracer trend the non-local flux (lk_top=T) 
    1921   !!---------------------------------------------------------------------- 
    2022   USE oce             ! ocean dynamics and active tracers  
    … …  
    5860 
    5961#if defined key_zdfddm 
    60    REAL(wp) ::                 & !!! ** Double diffusion Mixing 
    61       difssf  = 1.e-03_wp   ,  &  ! maximum salt fingering mixing  
    62       Rrho0   = 1.9_wp      ,  &  ! limit for salt  fingering mixing  
    63       difsdc  = 1.5e-06_wp       ! maximum diffusive convection mixing 
     62   !                                        !!! ** Double diffusion Mixing 
     63   REAL(wp) ::   difssf  = 1.e-03_wp         ! maximum salt fingering mixing  
     64   REAL(wp) ::   Rrho0   = 1.9_wp            ! limit for salt  fingering mixing  
     65   REAL(wp) ::   difsdc  = 1.5e-06_wp        ! maximum diffusive convection mixing 
    6466#endif 
    6567   LOGICAL  ::   ln_kpprimix  = .TRUE.       ! Shear instability mixing  
    6668 
    67    REAL(wp) ::                 & !!! ** General constants  ** 
    68       epsln   = 1.0e-20_wp   , &  ! a small positive number     
    69       pthird  = 1._wp/3._wp  , &  ! 1/3 
    70       pfourth = 1._wp/4._wp       ! 1/4 
    71  
    72    REAL(wp) ::                 & !!! ** Boundary Layer Turbulence Parameters  ** 
    73       vonk     = 0.4_wp     ,  &  ! von Karman's constant 
    74       epsilon  = 0.1_wp     ,  &  ! nondimensional extent of the surface layer 
    75       rconc1   = 5.0_wp     ,  &  ! standard flux profile function parmaeters 
    76       rconc2   = 16.0_wp    ,  &  !         "        " 
    77       rconcm   = 8.38_wp    ,  &  ! momentum flux profile fit 
    78       rconam   = 1.26_wp    ,  &  !         "       " 
    79       rzetam   = -.20_wp    ,  &  !         "       "        
    80       rconcs   = 98.96_wp   ,  &  !  scalar  flux profile fit 
    81       rconas   = -28.86_wp  ,  &  !         "       " 
    82       rzetas   = -1.0_wp          !         "       "   
    83    REAL(wp) ::                 & !!! ** Boundary Layer Depth Diagnostic  ** 
    84       Ricr     = 0.3_wp     ,  &  ! critical bulk Richardson Number 
    85       rcekman  = 0.7_wp     ,  &  ! coefficient for ekman depth   
    86       rcmonob  = 1.0_wp     ,  &  ! coefficient for Monin-Obukhov depth  
    87       rconcv   = 1.7_wp     ,  &  ! ratio of interior buoyancy frequency to buoyancy frequency at entrainment depth 
    88       hbf      = 1.0_wp     ,  &  ! fraction of bound. layer depth to which absorbed solar  
    89       !                           ! rad. and contributes to surf. buo. forcing 
    90       Vtc                         ! function of rconcv,rconcs,epsilon,vonk,Ricr 
    91    REAL(wp) ::                 & !!! ** Nonlocal Boundary Layer Mixing ** 
    92       rcstar   = 5.0_wp     ,  &  ! coefficient for convective nonlocal transport 
    93       rcs      = 1.0e-3_wp  ,  &  ! conversion: mm/s ==> m/s    
    94       rcg                         ! non-dimensional coefficient for nonlocal transport 
     69   !                                        !!! ** General constants  ** 
     70   REAL(wp) ::   epsln   = 1.0e-20_wp        ! a small positive number     
     71   REAL(wp) ::   pthird  = 1._wp/3._wp       ! 1/3 
     72   REAL(wp) ::   pfourth = 1._wp/4._wp       ! 1/4 
     73 
     74   !                                        !!! ** Boundary Layer Turbulence Parameters  ** 
     75   REAL(wp) ::   vonk     = 0.4_wp           ! von Karman's constant 
     76   REAL(wp) ::   epsilon  = 0.1_wp           ! nondimensional extent of the surface layer 
     77   REAL(wp) ::   rconc1   = 5.0_wp           ! standard flux profile function parmaeters 
     78   REAL(wp) ::   rconc2   = 16.0_wp          !         "        " 
     79   REAL(wp) ::   rconcm   = 8.38_wp          ! momentum flux profile fit 
     80   REAL(wp) ::   rconam   = 1.26_wp          !         "       " 
     81   REAL(wp) ::   rzetam   = -.20_wp          !         "       "        
     82   REAL(wp) ::   rconcs   = 98.96_wp         !  scalar  flux profile fit 
     83   REAL(wp) ::   rconas   = -28.86_wp        !         "       " 
     84   REAL(wp) ::   rzetas   = -1.0_wp          !         "       "   
     85    
     86   !                                        !!! ** Boundary Layer Depth Diagnostic  ** 
     87   REAL(wp) ::   Ricr     = 0.3_wp           ! critical bulk Richardson Number 
     88   REAL(wp) ::   rcekman  = 0.7_wp           ! coefficient for ekman depth   
     89   REAL(wp) ::   rcmonob  = 1.0_wp           ! coefficient for Monin-Obukhov depth  
     90   REAL(wp) ::   rconcv   = 1.7_wp           ! ratio of interior buoyancy frequency to its value at entrainment depth 
     91   REAL(wp) ::   hbf      = 1.0_wp           ! fraction of bound. layer depth to which absorbed solar  
     92      !                                      ! rad. and contributes to surf. buo. forcing 
     93   REAL(wp) ::   Vtc                         ! function of rconcv,rconcs,epsilon,vonk,Ricr 
     94    
     95   !                                        !!! ** Nonlocal Boundary Layer Mixing ** 
     96   REAL(wp) ::   rcstar   = 5.0_wp           ! coefficient for convective nonlocal transport 
     97   REAL(wp) ::   rcs      = 1.0e-3_wp        ! conversion: mm/s ==> m/s    
     98   REAL(wp) ::   rcg                         ! non-dimensional coefficient for nonlocal transport 
    9599 
    96100#if ! defined key_kppcustom 
    97    REAL(wp), DIMENSION(jpk,jpk) ::   del   ! array for reference mean values of vertical integration  
     101   REAL(wp), DIMENSION(jpk,jpk) ::   del     ! array for reference mean values of vertical integration  
    98102#endif 
    99103 
    100104#if defined key_kpplktb 
    101    INTEGER, PARAMETER ::       & !!! ** Parameters for lookup table for turbulent velocity scales **  
    102       nilktb   = 892        ,  &  ! number of values for zehat in KPP lookup table 
    103       njlktb   = 482        ,  &  ! number of values for ustar in KPP lookup table 
    104       nilktbm1 = nilktb - 1 ,  &  ! 
    105       njlktbm1 = njlktb - 1       ! 
    106  
    107    REAL(wp), DIMENSION(nilktb,njlktb) ::   wmlktb   ! lookup table for the turbulent vertical velocity scale for momentum 
    108    REAL(wp), DIMENSION(nilktb,njlktb) ::   wslktb   ! lookup table for the turbulent vertical velocity scale for tracers 
    109  
    110    REAL(wp) ::                 & 
    111       dehatmin = -4.e-7_wp  ,  &  ! minimum limit for zhat in lookup table (m3/s3)  
    112       dehatmax = 0._wp      ,  &  ! maximum limit for zhat in lookup table (m3/s3) 
    113       ustmin   = 0._wp      ,  &  ! minimum limit for ustar in lookup table (m/s) 
    114       ustmax   = 0.04_wp    ,  &  ! maximum limit for ustar in lookup table (m/s)     
    115       dezehat               ,  &  ! delta zhat in lookup table 
    116       deustar                     ! delta ustar in lookup table 
     105   !                                         !!! ** Parameters for lookup table for turbulent velocity scales **  
     106   INTEGER, PARAMETER ::   nilktb   = 892     ! number of values for zehat in KPP lookup table 
     107   INTEGER, PARAMETER ::   njlktb   = 482     ! number of values for ustar in KPP lookup table 
     108   INTEGER, PARAMETER ::   nilktbm1 = nilktb-1   ! 
     109   INTEGER, PARAMETER ::   njlktbm1 = njlktb-1   ! 
     110 
     111   REAL(wp), DIMENSION(nilktb,njlktb) ::   wmlktb   ! lookup table for the turbulent vertical velocity scale (momentum) 
     112   REAL(wp), DIMENSION(nilktb,njlktb) ::   wslktb   ! lookup table for the turbulent vertical velocity scale (tracers) 
     113 
     114   REAL(wp) ::   dehatmin = -4.e-7_wp    ! minimum limit for zhat in lookup table (m3/s3)  
     115   REAL(wp) ::   dehatmax = 0._wp        ! maximum limit for zhat in lookup table (m3/s3) 
     116   REAL(wp) ::   ustmin   = 0._wp        ! minimum limit for ustar in lookup table (m/s) 
     117   REAL(wp) ::   ustmax   = 0.04_wp      ! maximum limit for ustar in lookup table (m/s)     
     118   REAL(wp) ::   dezehat                 ! delta zhat in lookup table 
     119   REAL(wp) ::   deustar                 ! delta ustar in lookup table 
    117120#endif 
    118121   REAL(wp), DIMENSION(jpk) ::   ratt   ! attenuation coef  (already defines in module traqsr,  
    119122   !                                    ! but only if the solar radiation penetration is considered) 
    120    REAL(wp) ::                 & !!! * penetrative solar radiation coefficient * 
    121       rabs = 0.58_wp        ,  &  ! fraction associated with xsi1 
    122       xsi1 = 0.35_wp        ,  &  ! first depth of extinction  
    123       xsi2 = 23.0_wp              ! second depth of extinction  
     123    
     124   !                                    !!! * penetrative solar radiation coefficient * 
     125   REAL(wp) ::   rabs = 0.58_wp          ! fraction associated with xsi1 
     126   REAL(wp) ::   xsi1 = 0.35_wp          ! first depth of extinction  
     127   REAL(wp) ::   xsi2 = 23.0_wp          ! second depth of extinction  
    124128      !                           ! (default values: water type Ib)  
    125129 
    126    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    127       etmean                ,  &  ! coefficient used for horizontal smoothing 
    128       eumean                ,  &  ! at t-, u- and v-points 
    129       evmean   
     130   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   etmean, eumean, evmean   ! coeff. used for hor. smoothing at t-, u- & v-points 
     131         
    130132  
    131133#if defined key_c1d 
    132    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   & 
    133       rig                   ,  &  ! gradient Richardson number 
    134       rib                   ,  &  ! bulk Richardson number 
    135       buof                  ,  &  ! buoyancy forcing 
    136       mols                        ! moning-Obukhov length scale  
    137    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ekdp   ! Ekman depth 
     134   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rig    !: gradient Richardson number 
     135   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rib    !: bulk Richardson number 
     136   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   buof   !: buoyancy forcing 
     137   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   mols   !: moning-Obukhov length scale  
     138   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ekdp   !: Ekman depth 
    138139#endif 
    139140 
    … …  
    145146#  include  "zdfddm_substitute.h90" 
    146147   !!---------------------------------------------------------------------- 
    147    !! NEMO/OPA 3.2 , LOCEAN-IPSL   (2009) 
     148   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    148149   !! $Id$ 
    149150   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    152153CONTAINS 
    153154 
    154    SUBROUTINE zdf_kpp ( kt ) 
     155   SUBROUTINE zdf_kpp( kt ) 
    155156      !!---------------------------------------------------------------------- 
    156157      !!                   ***  ROUTINE zdf_kpp  *** 
    … …  
    188189      !!---------------------------------------------------------------------- 
    189190#if defined  key_zdfddm 
    190       USE oce     , zviscos => ua,      &  ! temp. array for viscosities use ua as workspace 
    191          &          zdiffut => ta,      &  ! temp. array for diffusivities use sa as workspace 
    192          &          zdiffus => sa          ! temp. array for diffusivities use sa as workspace 
     191      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace 
     192      USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace 
     193      USE oce     , zdiffus => sa   ! temp. array for diffusivities use sa as workspace 
    193194#else 
    194       USE oce     , zviscos => ua,      &  ! temp. array for viscosities use ua as workspace 
    195          &          zdiffut => ta          ! temp. array for diffusivities use sa as workspace 
     195      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace 
     196      USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace 
    196197#endif 
    197198      !! 
    … …  
    201202      INTEGER ::   ikbot, jkmax, jkm1, jkp2   ! 
    202203 
    203       REAL(wp), DIMENSION(jpi,jpj) ::   & !!! Surface buoyancy forcing, friction velocity 
    204          zBo, zBosol, zustar              ! 
    205                       ! 
    206       REAL(wp) ::                       &  ! 
    207          ztx, zty, zflageos,            &  ! 
    208          zstabl, zbuofdep,zucube,       &  ! 
    209          zrhos, zalbet, zbeta,          &  ! 
    210          zthermal, zhalin, zatt1           ! 
    211       
    212       REAL(wp) ::                       & !!! Bulk richardson number 
    213          zref, zt, zs, zh,              &  ! 
    214          zu, zv, zrh,                   &  ! 
    215          zrib, zrinum,                  &  ! 
    216          zdVsq, zVtsq                      ! 
    217        
    218       REAL(wp) ::                       & !!! Velocity scales 
    219          zehat, zeta, zhrib, zsig,      &  ! 
    220          zscale, zwst, zws, zwm 
    221  
     204      REAL(wp), DIMENSION(jpi,jpj) ::   zBo, zBosol, zustar         ! Surface buoyancy forcing, friction velocity 
     205      REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube     ! 
     206      REAL(wp) ::   zrhos, zalbet, zbeta, zthermal, zhalin, zatt1   ! 
     207      REAL(wp) ::   zref, zt, zs, zh, zu, zv, zrh                   ! Bulk richardson number 
     208      REAL(wp) ::   zrib, zrinum, zdVsq, zVtsq                      ! 
     209      REAL(wp) ::   zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm   ! Velocity scales 
    222210#if defined key_kpplktb 
    223       INTEGER ::                        & !!! Lookup table or Analytical functions  
    224          il, jl                            ! 
    225       REAL(wp) ::                       &  ! 
    226          ud, zfrac, ufrac,              &  ! 
    227          zwam, zwbm, zwas, zwbs            ! 
     211      INTEGER ::    il, jl                                          ! Lookup table or Analytical functions  
     212      REAL(wp) ::   ud, zfrac, ufrac, zwam, zwbm, zwas, zwbs        ! 
    228213#else 
    229      REAL(wp) ::                        &  ! 
    230         zwsun, zwmun,                   &  
    231         zcons, zconm, zwcons, zwconm      ! 
    232 #endif 
    233   
    234      REAL(wp) ::                       & !!! In situ density 
    235          zsr, zbw, ze,                  &  ! 
    236          zb, zd, zc, zaw, za,           &  ! 
    237          zb1, za1, zkw, zk0,            &  ! 
    238          zcomp , zrhd, zrhdr,zbvzed       ! 
    239  
     214      REAL(wp) ::   zwsun, zwmun, zcons, zconm, zwcons, zwconm      ! 
     215#endif 
     216      REAL(wp) ::   zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed   ! In situ density 
    240217#if ! defined key_kppcustom      
    241      !! * local declarations 
    242       INTEGER ::                        & 
    243          jm                                ! dummy loop indices 
    244       REAL(wp) ::                       & !!! Compression terms 
    245          zr1, zr2, zr3, zr4,            &  ! 
    246          zrhop                             ! 
    247 #endif 
    248   
    249       REAL(wp) ::                       &  ! 
    250          zflag, ztemp, zrn2,            &  ! 
    251          zdep21, zdep32, zdep43 
    252  
    253       REAL(wp) ::                       & !!! Interior richardson mixing 
    254          zdku2, zdkv2, ze3sqr,          &  ! 
    255          zsh2, zri, zfri                   ! 
    256  
    257       REAL(wp), DIMENSION(jpi,0:2) ::  &  !!! Moning-Obukov limitation 
    258          zmoek 
    259       REAL(wp), DIMENSION(jpi)     ::  & 
    260          zmoa, zekman                 
    261       REAL(wp)                     ::  & 
    262          zmob, zek 
    263  
    264       REAL(wp), DIMENSION(jpi,4) ::     &  !!! The pipe  
    265          zdepw, zdift, zvisc 
    266       REAL(wp), DIMENSION(jpi,3) ::     &  
    267          zdept 
    268       REAL(wp), DIMENSION(jpi,2) ::     &   
    269          zriblk 
    270       REAL(wp), DIMENSION(jpi,jpk) ::   &  ! 
    271          zmask                           
    272       REAL(wp), DIMENSION(jpi) ::       &  !  
    273          zhmax, zria, zhbl  
    274       REAL(wp) ::                       &  ! 
    275          zflagri, zflagek,              &  ! 
    276          zflagmo, zflagh, zflagkb          ! 
    277       REAL(wp), DIMENSION(jpi)     ::   & !!! Shape function (G) 
    278          za2m, za3m, zkmpm,             & 
    279          za2t, za3t, zkmpt 
    280       REAL(wp) ::                       &  ! 
    281          zdelta, zdelta2,               &  ! 
    282          zdzup, zdzdn, zdzh,            &  ! 
    283          zvath, zgat1, zdat1,           &  ! 
    284          zkm1m, zkm1t 
    285       REAL(wp), DIMENSION(jpi,jpk) ::   & !!! Boundary layer diffusivities/viscosities 
    286          zblcm, zblct                           
     218      INTEGER  ::   jm                          ! dummy loop indices 
     219      REAL(wp) ::   zr1, zr2, zr3, zr4, zrhop   ! Compression terms 
     220#endif 
     221      REAL(wp) ::   zflag, ztemp, zrn2, zdep21, zdep32, zdep43 
     222      REAL(wp) ::   zdku2, zdkv2, ze3sqr, zsh2, zri, zfri          ! Interior richardson mixing 
     223      REAL(wp), DIMENSION(jpi,0:2) ::   zmoek                      ! Moning-Obukov limitation 
     224      REAL(wp), DIMENSION(jpi)     ::   zmoa, zekman                 
     225      REAL(wp)                     ::   zmob, zek 
     226      REAL(wp), DIMENSION(jpi,4)   ::   zdepw, zdift, zvisc   ! The pipe  
     227      REAL(wp), DIMENSION(jpi,3)   ::   zdept 
     228      REAL(wp), DIMENSION(jpi,2)   ::   zriblk 
     229      REAL(wp), DIMENSION(jpi,jpk) ::   zmask                           
     230      REAL(wp), DIMENSION(jpi)     ::   zhmax, zria, zhbl  
     231      REAL(wp) ::   zflagri, zflagek, zflagmo, zflagh, zflagkb   ! 
     232      REAL(wp), DIMENSION(jpi)     ::   za2m, za3m, zkmpm, za2t, za3t, zkmpt   ! Shape function (G) 
     233      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 
     234      REAL(wp), DIMENSION(jpi,jpk) ::   zblcm, zblct   ! Boundary layer diffusivities/viscosities 
    287235#if defined key_zdfddm 
    288       REAL(wp) ::                       & !!! double diffusion mixing 
    289          zrrau, zds,                    & 
    290          zavdds, zavddt,zinr  
    291       REAL(wp), DIMENSION(jpi,4) ::     &   
    292         zdifs 
    293       REAL(wp), DIMENSION(jpi)     ::   & 
    294          za2s, za3s, zkmps 
    295       REAL(wp) ::                       &  
    296          zkm1s 
    297       REAL(wp), DIMENSION(jpi,jpk) ::   &  
    298          zblcs                      
     236      REAL(wp) ::   zrrau, zds, zavdds, zavddt,zinr   ! double diffusion mixing 
     237      REAL(wp), DIMENSION(jpi,4) ::     zdifs 
     238      REAL(wp), DIMENSION(jpi)     ::   za2s, za3s, zkmps 
     239      REAL(wp) ::                       zkm1s 
     240      REAL(wp), DIMENSION(jpi,jpk) ::   zblcs                      
    299241#endif 
    300242      !!-------------------------------------------------------------------- 
    301  
    302  
    303       ! Initialization (first time-step only) 
    304       ! -------------- 
    305       IF( kt == nit000  )   CALL zdf_kpp_init 
    306243      
    307244      zviscos(:,:,:) = 0. 
    … …  
    12411178      !!                  ***  ROUTINE tra_kpp  *** 
    12421179      !! 
    1243       !! ** Purpose :   compute and add to the tracer trend the non-local 
    1244       !!                tracer flux 
     1180      !! ** Purpose :   compute and add to the tracer trend the non-local tracer flux 
    12451181      !! 
    12461182      !! ** Method  :   ??? 
    1247       !! 
    1248       !! history : 
    1249       !!     1.0  ! 2005-11 (G. Madec)  Original code 
    1250       !!     3.3  ! 2010-06 (C. Ethe)  Merge TRA-TRC 
    12511183      !!---------------------------------------------------------------------- 
    1252       !! * Modules used 
    12531184      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace 
    12541185      !!---------------------------------------------------------------------- 
    … …  
    13751306      !! 
    13761307      !! ** input   :   Namlist namkpp 
    1377       !! 
    1378       !! 
    1379       !! history : 
    1380       !!     8.1  ! 00-02 (J. Chanut) KPP Mixing 
    1381       !!     9.0  ! 05-01 (C. Ethe) F90 : free form 
    13821308      !!---------------------------------------------------------------------- 
    1383       !! * local declarations 
    1384  
    1385       INTEGER    ::   & 
    1386          ji, jj, jk             ! dummy loop indices 
    1387        
     1309      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    13881310#if ! defined key_kppcustom 
    1389       INTEGER    ::   & 
    1390          jm                       ! dummy loop indices      
    1391       REAL(wp)   ::              & !!! tempory scalars 
    1392          zref, zdist 
    1393 #endif 
    1394  
     1311      INTEGER  ::   jm             ! dummy loop indices      
     1312      REAL(wp) ::   zref, zdist    ! tempory scalars 
     1313#endif 
    13951314#if defined key_kpplktb 
    1396       REAL(wp)   ::              & !!! tempory scalars 
    1397          zustar,    & 
    1398          zucube, zustvk,         &  
    1399          zeta, zehat 
    1400 #endif 
    1401       REAL(wp)   ::             & !!! tempory scalars 
    1402          zhbf 
    1403       LOGICAL ::                & 
    1404          ll_kppcustom,          &  ! 1st ocean level taken as surface layer 
    1405          ll_kpplktb                ! Lookup table for turbul. velocity scales  
     1315      REAL(wp) ::   zustar, zucube, zustvk, zeta, zehat   ! tempory scalars 
     1316#endif 
     1317      REAL(wp) ::   zhbf           ! tempory scalars 
     1318      LOGICAL  ::   ll_kppcustom   ! 1st ocean level taken as surface layer 
     1319      LOGICAL  ::   ll_kpplktb     ! Lookup table for turbul. velocity scales  
    14061320      !! 
    14071321      NAMELIST/namzdf_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave 
    … …  
    16101524   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfkpp = .FALSE.   !: KPP flag 
    16111525CONTAINS 
    1612    SUBROUTINE zdf_kpp( kt )          ! Empty routine 
     1526   SUBROUTINE zdf_kpp_init           ! Dummy routine 
     1527      WRITE(*,*) 'zdf_kpp_init: You should not have seen this print! error?' 
     1528   END SUBROUTINE zdf_kpp_init 
     1529   SUBROUTINE zdf_kpp( kt )          ! Dummy routine 
    16131530      WRITE(*,*) 'zdf_kpp: You should not have seen this print! error?', kt 
    16141531   END SUBROUTINE zdf_kpp 
    1615    SUBROUTINE tra_kpp( kt )          ! Empty routine 
     1532   SUBROUTINE tra_kpp( kt )          ! Dummy routine 
    16161533      WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt 
    16171534   END SUBROUTINE tra_kpp 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdfric.F90

    r2027 r2104  
    1010   !!            8.0  ! 1997-06 (G. Madec)  complete rewriting of zdfmix 
    1111   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     12   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    1213   !!---------------------------------------------------------------------- 
    1314#if defined key_zdfric   ||   defined key_esopa 
    … …  
    4344#  include "domzgr_substitute.h90" 
    4445   !!---------------------------------------------------------------------- 
    45    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    46    !! $Id$  
     46   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     47   !! $Id$ 
    4748   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4849   !!---------------------------------------------------------------------- 
    … …  
    192193   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .FALSE.   !: Richardson mixing flag 
    193194CONTAINS 
     195   SUBROUTINE zdf_ric_init         ! Dummy routine 
     196   END SUBROUTINE zdf_ric_init 
    194197   SUBROUTINE zdf_ric( kt )        ! Dummy routine 
    195198      WRITE(*,*) 'zdf_ric: You should not have seen this print! error?', kt 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdftke.F90

    r2027 r2104  
    2525   !!            3.2  !  2009-06  (G. Madec, S. Masson) TKE restart compatible with key_cpl  
    2626   !!                 !                                + cleaning of the parameters + bugs correction 
     27   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    2728   !!---------------------------------------------------------------------- 
    2829#if defined key_zdftke   ||   defined key_esopa 
    … …  
    3031   !!   'key_zdftke'                                   TKE vertical physics 
    3132   !!---------------------------------------------------------------------- 
    32    !!   zdf_tke       : update momentum and tracer Kz from a tke scheme 
    33    !!   tke_tke       : tke time stepping: update tke at now time step (en) 
    34    !!   tke_avn       : compute mixing length scale and deduce avm and avt 
    35    !!   tke_init      : initialization, namelist read, and parameters control 
    36    !!   tke_rst       : read/write tke restart in ocean restart file 
     33   !!   zdf_tke      : update momentum and tracer Kz from a tke scheme 
     34   !!   tke_tke      : tke time stepping: update tke at now time step (en) 
     35   !!   tke_avn      : compute mixing length scale and deduce avm and avt 
     36   !!   zdf_tke_init : initialization, namelist read, and parameters control 
     37   !!   tke_rst      : read/write tke restart in ocean restart file 
    3738   !!---------------------------------------------------------------------- 
    3839   USE oce            ! ocean dynamics and active tracers  
    … …  
    5354   PRIVATE 
    5455 
    55    PUBLIC   zdf_tke    ! routine called in step module 
    56    PUBLIC   tke_init   ! routine called in opa module 
    57    PUBLIC   tke_rst    ! routine called in step module 
     56   PUBLIC   zdf_tke        ! routine called in step module 
     57   PUBLIC   zdf_tke_init   ! routine called in opa module 
     58   PUBLIC   tke_rst        ! routine called in step module 
    5859 
    5960   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke = .TRUE.  !: TKE vertical mixing flag 
    … …  
    9596#  include "vectopt_loop_substitute.h90" 
    9697   !!---------------------------------------------------------------------- 
    97    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    98    !! $Id: zdftke2.F90 1201 2008-09-24 13:24:21Z rblod $ 
     98   !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010)  
     99   !! $Id: $ 
    99100   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    100101   !!---------------------------------------------------------------------- 
    … …  
    150151      !!---------------------------------------------------------------------- 
    151152      ! 
    152                            CALL tke_tke      ! now tke (en) 
    153                            ! 
    154                            CALL tke_avn      ! now avt, avm, avmu, avmv 
     153      CALL tke_tke      ! now tke (en) 
     154      ! 
     155      CALL tke_avn      ! now avt, avm, avmu, avmv 
    155156      ! 
    156157   END SUBROUTINE zdf_tke 
    … …  
    655656 
    656657 
    657    SUBROUTINE tke_init 
     658   SUBROUTINE zdf_tke_init 
    658659      !!---------------------------------------------------------------------- 
    659       !!                  ***  ROUTINE tke_init  *** 
     660      !!                  ***  ROUTINE zdf_tke_init  *** 
    660661      !!                      
    661662      !! ** Purpose :   Initialization of the vertical eddy diffivity and  
    … …  
    685686      IF(lwp) THEN                    !* Control print 
    686687         WRITE(numout,*) 
    687          WRITE(numout,*) 'zdf_tke : tke turbulent closure scheme - initialisation' 
    688          WRITE(numout,*) '~~~~~~~~' 
     688         WRITE(numout,*) 'zdf_tke_init : tke turbulent closure scheme - initialisation' 
     689         WRITE(numout,*) '~~~~~~~~~~~~' 
    689690         WRITE(numout,*) '   Namelist namzdf_tke : set tke mixing parameters' 
    690691         WRITE(numout,*) '      coef. to compute avt                        rn_ediff  = ', rn_ediff 
    … …  
    747748      CALL tke_rst( nit000, 'READ' ) 
    748749      ! 
    749    END SUBROUTINE tke_init 
     750   END SUBROUTINE zdf_tke_init 
    750751 
    751752 
    … …  
    824825   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke = .FALSE.   !: TKE flag 
    825826CONTAINS 
    826    SUBROUTINE zdf_tke( kt )          ! Empty routine 
     827   SUBROUTINE zdf_tke_init           ! Dummy routine 
     828   END SUBROUTINE zdf_tke_init 
     829   SUBROUTINE zdf_tke( kt )          ! Dummy routine 
    827830      WRITE(*,*) 'zdf_tke: You should not have seen this print! error?', kt 
    828831   END SUBROUTINE zdf_tke 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdftke_old.F90

    r2027 r2104  
    4848   PRIVATE 
    4949 
    50    PUBLIC   zdf_tke_old   ! routine called in step module 
    51    PUBLIC   zdf_tke_init  ! routine called in opa module 
     50   PUBLIC   zdf_tke_old     ! routine called in step module 
     51   PUBLIC   zdf_tke_init_o  ! routine called in opa module 
    5252 
    5353   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke_old = .TRUE.  !: TKE vertical mixing flag 
    … …  
    696696 
    697697 
    698    SUBROUTINE zdf_tke_init 
     698   SUBROUTINE zdf_tke_init_o 
    699699      !!---------------------------------------------------------------------- 
    700       !!                  ***  ROUTINE zdf_tke_init  *** 
     700      !!                  ***  ROUTINE zdf_tke_init_o  *** 
    701701      !!                      
    702702      !! ** Purpose :   Initialization of the vertical eddy diffivity and  
    … …  
    743743      IF(lwp) THEN 
    744744         WRITE(numout,*) 
    745          WRITE(numout,*) 'zdf_tke_init : tke turbulent closure scheme (old scheme)' 
    746          WRITE(numout,*) '~~~~~~~~~~~~' 
     745         WRITE(numout,*) 'zdf_tke_init_o : tke turbulent closure scheme (old scheme)' 
     746         WRITE(numout,*) '~~~~~~~~~~~~~~' 
    747747         WRITE(numout,*) '          Namelist namzdf_tke : set tke mixing parameters' 
    748748         WRITE(numout,*) '             restart with tke from no tke              ln_rstke = ', ln_rstke 
    … …  
    853853      CALL tke_rst( nit000, 'READ' ) 
    854854      ! 
    855    END SUBROUTINE zdf_tke_init 
     855   END SUBROUTINE zdf_tke_init_o 
    856856 
    857857 
    … …  
    901901   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftke_old = .FALSE.   !: TKE flag 
    902902CONTAINS 
    903    SUBROUTINE zdf_tke_old( kt )          ! Empty routine 
     903   SUBROUTINE zdf_tke_init_o             ! Dummy routine 
     904   END SUBROUTINE zdf_tke_init_o 
     905   SUBROUTINE zdf_tke_old( kt )          ! Dummy routine 
    904906      WRITE(*,*) 'zdf_tke_old: You should not have seen this print! error?', kt 
    905907   END SUBROUTINE zdf_tke_old 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r2027 r2104  
    66   !! History :  1.0  !  2004-04  (L. Bessieres, G. Madec)  Original code 
    77   !!             -   !  2006-08  (A. Koch-Larrouy) Indonesian strait 
     8   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_zdftmx 
    … …  
    4849#  include "vectopt_loop_substitute.h90" 
    4950   !!---------------------------------------------------------------------- 
    50    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    51    !! $Id$  
     51   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     52   !! $Id: $ 
    5253   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5354   !!---------------------------------------------------------------------- 
    … …  
    486487         ! 
    487488      ENDIF 
    488  
     489      ! 
    489490   END SUBROUTINE zdf_tmx_init 
    490491 
    … …  
    495496   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .FALSE.   !: tidal mixing flag 
    496497CONTAINS 
    497    SUBROUTINE zdf_tmx( kt )          ! Empty routine 
     498   SUBROUTINE zdf_tmx_init           ! Dummy routine 
     499      WRITE(*,*) 'zdf_tmx: You should not have seen this print! error?' 
     500   END SUBROUTINE zdf_tmx_init 
     501   SUBROUTINE zdf_tmx( kt )          ! Dummy routine 
    498502      WRITE(*,*) 'zdf_tmx: You should not have seen this print! error?', kt 
    499503   END SUBROUTINE zdf_tmx 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/cla.F90

    r2027 r2104  
    763763   USE in_out_manager  ! I/O manager 
    764764CONTAINS 
     765   SUBROUTINE tra_cla_init  
     766   END SUBROUTINE tra_cla_init 
    765767   SUBROUTINE tra_cla( kt )  
    766768      INTEGER, INTENT(in) ::   kt    ! ocean time-step indice 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/istate.F90

    r2084 r2104  
    44   !! Ocean state   :  initial state setting 
    55   !!===================================================================== 
    6    !! History :   4.0  !  89-12  (P. Andrich)  Original code 
    7    !!             5.0  !  91-11  (G. Madec)  rewritting 
    8    !!             6.0  !  96-01  (G. Madec)  terrain following coordinates 
    9    !!             8.0  !  01-09  (M. Levy, M. Ben Jelloul)  istate_eel 
    10    !!             8.0  !  01-09  (M. Levy, M. Ben Jelloul)  istate_uvg 
    11    !!             9.0  !  03-08  (G. Madec)  F90: Free form, modules 
    12    !!             9.0  !  03-09  (G. Madec, C. Talandier)  add EEL R5 
    13    !!             9.0  !  04-05  (A. Koch-Larrouy)  istate_gyre  
    14    !!             9.0  !  06-07  (S. Masson)  distributed restart using iom 
     6   !! History :  OPA  !  1989-12  (P. Andrich)  Original code 
     7   !!            5.0  !  1991-11  (G. Madec)  rewritting 
     8   !!            6.0  !  1996-01  (G. Madec)  terrain following coordinates 
     9   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_eel 
     10   !!            8.0  !  2001-09  (M. Levy, M. Ben Jelloul)  istate_uvg 
     11   !!   NEMO     1.0  !  2003-08  (G. Madec, C. Talandier)  F90: Free form, modules + EEL R5 
     12   !!             -   !  2004-05  (A. Koch-Larrouy)  istate_gyre  
     13   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom 
     14   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA 
    1515   !!---------------------------------------------------------------------- 
    1616 
    … …  
    2525   USE oce             ! ocean dynamics and active tracers  
    2626   USE dom_oce         ! ocean space and time domain  
    27    USE daymod          !  
     27   USE daymod          ! calendar 
     28   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine) 
    2829   USE ldftra_oce      ! ocean active tracers: lateral physics 
    2930   USE zdf_oce         ! ocean vertical physics 
    … …  
    3334   USE restart         ! ocean restart                   (rst_read routine) 
    3435   USE in_out_manager  ! I/O manager 
    35    USE iom 
     36   USE iom             ! I/O library 
    3637   USE c1d             ! re-initialization of u-v mask for the 1D configuration 
    3738   USE zpshde          ! partial step: hor. derivative (zps_hde routine) 
    … …  
    5354#  include "vectopt_loop_substitute.h90" 
    5455   !!---------------------------------------------------------------------- 
    55    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     56   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    5657   !! $Id$ 
    5758   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    6667      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
    6768      !!---------------------------------------------------------------------- 
    68       USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine) 
    6969 
    7070      IF(lwp) WRITE(numout,*) 
    … …  
    8282         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog) 
    8383         CALL rst_read                           ! Read the restart file 
    84          CALL tra_swap                           ! swap 3D arrays (ta,sa)  in a 4D array 
     84         CALL tra_swap                           ! swap 3D arrays (t,s)  in a 4D array (ts) 
    8585         CALL day_init                           ! model calendar (using both namelist and restart infos) 
    8686      ELSE 
    … …  
    9191         CALL day_init                           ! model calendar (using both namelist and restart infos) 
    9292         !                                       ! Initialization of ocean to zero 
    93          !     before fields       !       now fields           
    94              ub   (:,:,:) = 0.e0   ;   un   (:,:,:) = 0.e0   ; sshb(:,:) = 0.e0 
    95              vb   (:,:,:) = 0.e0   ;   vn   (:,:,:) = 0.e0   ; sshn(:,:) = 0.e0 
    96              rotb (:,:,:) = 0.e0   ;   rotn (:,:,:) = 0.e0 
    97              hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0 
     93         !   before fields     !       now fields      
     94         sshb (:,:)   = 0.e0   ;   sshn (:,:)   = 0.e0 
     95         ub   (:,:,:) = 0.e0   ;   un   (:,:,:) = 0.e0 
     96         vb   (:,:,:) = 0.e0   ;   vn   (:,:,:) = 0.e0   
     97         rotb (:,:,:) = 0.e0   ;   rotn (:,:,:) = 0.e0 
     98         hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0 
    9899         ! 
    99100         IF( cp_cfg == 'eel' ) THEN 
    100             CALL istate_eel                      ! EEL   configuration : start from pre-defined 
    101             !                                    !                       velocity and thermohaline fields 
     101            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields 
    102102         ELSEIF( cp_cfg == 'gyre' ) THEN          
    103             CALL istate_gyre                     ! GYRE  configuration : start from pre-defined temperature 
    104             !                                    !                       and salinity fields  
     103            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields 
    105104         ELSE 
    106             !                                    ! Other configurations: Initial temperature and salinity fields 
     105            !                                    ! Other configurations: Initial T-S fields 
    107106#if defined key_dtatem 
    108107            CALL dta_tem( nit000 )                  ! read 3D temperature data 
    109             tb(:,:,:) = t_dta(:,:,:)                ! use temperature data read 
    110             tn(:,:,:) = t_dta(:,:,:) 
     108            tb(:,:,:) = t_dta(:,:,:)   ;   tn(:,:,:) = t_dta(:,:,:) 
     109             
    111110#else 
    112111            IF(lwp) WRITE(numout,*)                 ! analytical temperature profile 
    … …  
    116115#if defined key_dtasal 
    117116            CALL dta_sal( nit000 )                  ! read 3D salinity data 
    118             sb(:,:,:) = s_dta(:,:,:)                ! use salinity data read 
    119             sn(:,:,:) = s_dta(:,:,:) 
     117            sb(:,:,:) = s_dta(:,:,:)   ;   sn(:,:,:) = s_dta(:,:,:) 
    120118#else 
    121119            ! No salinity data 
    … …  
    125123#endif 
    126124         ENDIF 
    127  
    128          CALL tra_swap                     ! swap 3D arrays (ta,sa)  in a 4D array 
     125         ! 
     126         CALL tra_swap                     ! swap 3D arrays (tb,sb,tn,sn)  in a 4D array 
    129127         CALL eos( tsb, rhd, rhop )        ! before potential and in situ densities 
    130          IF( ln_zps .AND. .NOT. lk_c1d )   & 
    131                            CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient 
    132             &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
    133           
     128         IF( ln_zps .AND. .NOT. lk_c1d )   CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  & ! zps: before hor. gradient 
     129            &                                                          rhd, gru , grv  )   ! of t,s,rd at ocean bottom 
     130         !     
    134131      ENDIF 
    135132      ! 
    136       IF( lk_agrif ) THEN 
    137          ! read free surface arrays in restart file 
     133      IF( lk_agrif ) THEN                  ! read free surface arrays in restart file 
    138134         IF( ln_rstart ) THEN 
    139135            IF( lk_dynspg_flt )   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields 
    … …  
    162158      IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile' 
    163159      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    164  
     160      ! 
    165161      DO jk = 1, jpk 
    166162         DO jj = 1, jpj 
    … …  
    173169        END DO 
    174170      END DO 
    175  
     171      ! 
    176172      IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    177173         &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    … …  
    193189      REAL(wp) ::   zsal = 35.50_wp 
    194190      !!---------------------------------------------------------------------- 
    195  
     191      ! 
    196192      IF(lwp) WRITE(numout,*) 
    197193      IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal 
    198194      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    199  
     195      ! 
    200196      sn(:,:,:) = zsal * tmask(:,:,:) 
    201197      sb(:,:,:) = sn(:,:,:) 
    202        
     198      ! 
    203199   END SUBROUTINE istate_sal 
    204200 
    … …  
    216212      !!                and relative vorticity fields 
    217213      !!---------------------------------------------------------------------- 
    218       USE eosbn2     ! eq. of state, Brunt Vaisala frequency (eos     routine) 
    219214      USE divcur     ! hor. divergence & rel. vorticity      (div_cur routine) 
    220215      USE iom 
    … …  
    224219      INTEGER  ::   ijloc 
    225220      REAL(wp) ::   zh1, zh2, zslope, zcst, zfcor   ! temporary scalars 
    226       REAL(wp) ::   zt1  = 15._wp,               &  ! surface temperature value (EEL R5) 
    227          &          zt2  =  5._wp,               &  ! bottom  temperature value (EEL R5) 
    228          &          zsal = 35.0_wp,              &  ! constant salinity (EEL R2, R5 and R6) 
    229          &          zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5) 
     221      REAL(wp) ::   zt1  = 15._wp                   ! surface temperature value (EEL R5) 
     222      REAL(wp) ::   zt2  =  5._wp                   ! bottom  temperature value (EEL R5) 
     223      REAL(wp) ::   zsal = 35.0_wp                  ! constant salinity (EEL R2, R5 and R6) 
     224      REAL(wp) ::   zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5) 
    230225      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain 
    231226      !!---------------------------------------------------------------------- 
    … …  
    235230         CASE ( 5 )                                     ! EEL R5 configuration 
    236231            !                                           ! ==================== 
    237  
     232            ! 
    238233            ! set temperature field with a linear profile 
    239234            ! ------------------------------------------- 
    … …  
    241236            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile' 
    242237            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    243  
     238            ! 
    244239            zh1 = gdept_0(  1  ) 
    245240            zh2 = gdept_0(jpkm1) 
    246  
     241            ! 
    247242            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 ) 
    248243            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 ) 
    249  
     244            ! 
    250245            DO jk = 1, jpk 
    251246               tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 
    252247               tb(:,:,jk) = tn(:,:,jk) 
    253248            END DO 
    254  
     249            ! 
    255250            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    256251               &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    257252               &                 1     , 1.    , numout                  ) 
    258  
     253            ! 
    259254            ! set salinity field to a constant value 
    260255            ! -------------------------------------- 
    … …  
    262257            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal 
    263258            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    264  
     259            ! 
    265260            sn(:,:,:) = zsal * tmask(:,:,:) 
    266261            sb(:,:,:) = sn(:,:,:) 
    267        
    268  
     262            ! 
    269263            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary) 
    270264            ! ---------------- 
    … …  
    273267            ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y) 
    274268            ! we use the Coriolis frequency at mid-channel.    
    275      
    276269            ub(:,:,:) = zueel * umask(:,:,:) 
    277270            un(:,:,:) = ub(:,:,:) 
    278271            ijloc = mj0(INT(jpjglo-1)/2) 
    279272            zfcor = ff(1,ijloc) 
    280  
     273            ! 
    281274            DO jj = 1, jpjglo 
    282275               zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav  
    283276            END DO 
    284  
     277            ! 
    285278            IF(lwp) THEN 
    286279               WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel 
    … …  
    288281               WRITE(numout,'(12(1x,f6.2))') zssh(1,:) 
    289282            ENDIF 
    290  
     283            ! 
    291284            DO jj = 1, nlcj 
    292285               DO ji = 1, nlci 
    … …  
    296289            sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns 
    297290            sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows 
    298  
     291            ! 
    299292            sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value 
    300  
     293            ! 
    301294            IF( nn_rstssh /= 0 ) THEN   
    302                nn_rstssh = 0                           ! hand-made initilization of ssh  
     295               nn_rstssh = 0                        ! hand-made initilization of ssh  
    303296               CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' ) 
    304297            ENDIF 
    305  
    306             ! horizontal divergence and relative vorticity (curl) 
    307             CALL div_cur( nit000 ) 
    308  
     298            ! 
     299            CALL div_cur( nit000 )                  ! horizontal divergence and relative vorticity (curl) 
    309300            ! N.B. the vertical velocity will be computed from the horizontal divergence field 
    310301            ! in istate by a call to wzv routine 
    … …  
    314305         CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration 
    315306            !                                     ! ========================== 
    316   
     307            ! 
    317308            ! set temperature field with a NetCDF file 
    318309            ! ---------------------------------------- 
    … …  
    320311            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file' 
    321312            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    322  
     313            ! 
    323314            CALL iom_open ( 'eel.initemp', inum ) 
    324315            CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb) 
    325316            CALL iom_close( inum ) 
    326       
     317            ! 
    327318            tn(:,:,:) = tb(:,:,:)                            ! set nox temperature to tb 
    328  
     319            ! 
    329320            IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    330321               &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    331322               &                 1     , 1.    , numout                  ) 
    332  
    333  
     323            ! 
    334324            ! set salinity field to a constant value 
    335325            ! -------------------------------------- 
    … …  
    337327            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal 
    338328            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    339   
     329            ! 
    340330            sn(:,:,:) = zsal * tmask(:,:,:) 
    341331            sb(:,:,:) = sn(:,:,:) 
    342  
     332            ! 
    343333            !                                    ! =========================== 
    344334         CASE DEFAULT                            ! NONE existing configuration 
    … …  
    346336            WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded' 
    347337            CALL ctl_stop( ctmp1 ) 
    348  
     338            ! 
    349339      END SELECT 
    350  
     340      ! 
    351341   END SUBROUTINE istate_eel 
    352342 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/oce.F90

    r2082 r2104  
    44   !! Ocean        :  dynamics and active tracers defined in memory  
    55   !!====================================================================== 
    6    !! History :  0.1  !  2002-11  (G. Madec)  F90: Free form and module 
    7    !!            1.0  !  2005-11  (V. Garnier) Surface pressure gradient organization 
     6   !! History :  1.0  !  2002-11  (G. Madec)  F90: Free form and module 
    87   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate 
     8   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays 
    99   !!---------------------------------------------------------------------- 
    1010   USE par_oce      ! ocean parameters 
    … …  
    1313   PRIVATE 
    1414 
    15    LOGICAL, PUBLIC ::   l_traldf_rot    = .FALSE.  !: rotated laplacian operator for lateral diffusion 
     15   LOGICAL         , PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion 
     16   CHARACTER(len=3), PUBLIC ::   l_adv                   !: flag for the advection scheme used (= 'ce2', 'tvd' ...) 
    1617 
    17    !! dynamics and tracer fields             !  before  !  now     !  after   ! the after trends becomes the fields 
    18    !! --------------------------             !  fields  !  fields  !  trends  ! only after tra_zdf and dyn_spg 
    19    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ub     ,  un      ,  ua      !: i-horizontal velocity      [m/s] 
    20    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   vb     ,  vn      ,  va      !: j-horizontal velocity      [m/s] 
    21    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::             wn                 !: vertical velocity          [m/s] 
    22    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rotb   ,  rotn               !: relative vorticity         [s-1] 
    23    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   hdivb  ,  hdivn              !: horizontal divergence      [s-1] 
    24    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   tb     ,  tn      ,  ta      !: potential temperature      [Celcius] 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   sb     ,  sn      ,  sa      !: salinity                   [psu] 
    26    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rn2b   ,  rn2                !: brunt-vaisala frequency**2 [s-2] 
     18   !! dynamics and tracer fields                  ! before ! now    ! after   ! the after trends becomes the fields 
     19   !! --------------------------                  ! fields ! fields ! trends  ! only after tra_zdf and dyn_spg 
     20   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   ub   ,  un    , ua      !: i-horizontal velocity        [m/s] 
     21   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   vb   ,  vn    , va      !: j-horizontal velocity        [m/s] 
     22   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::           wn              !: vertical velocity            [m/s] 
     23   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   rotb ,  rotn            !: relative vorticity           [s-1] 
     24   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   hdivb,  hdivn           !: horizontal divergence        [s-1] 
     25   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   tb   ,  tn    , ta      !: potential temperature    [Celcius] 
     26   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   sb   ,  sn    , sa      !: salinity                     [psu] 
     27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpts) ::   tsb  ,  tsn   , tsa     !: 4D T-S fields        [Celcius,psu]  
     28   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)      ::   rn2b ,  rn2             !: brunt-vaisala frequency**2   [s-2] 
    2729   ! 
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0     [no units] 
     30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
    2931   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rhop   !: potential volumic mass                           [kg/m3] 
    30  
    31    !! advection scheme choice 
    32    !! ----------------------- 
    33    CHARACTER(len=3), PUBLIC  ::   l_adv   !: flag for the advection scheme used (= 'ce2', 'tvd', 'mus' or ...) 
    34  
    35    !! surface pressure gradient 
    36    !! ------------------------- 
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   spgu, spgv      !: horizontal surface pressure gradient 
    38  
    39    !! interpolated gradient (only used in zps case) 
    40    !! --------------------- 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::   gtsu, gtsv !: horizontal gradient of T, S bottom u-point 
    42    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   gru , grv   !: horizontal gradient of rd at bottom u-point 
    4332 
    4433   !! free surface                       !  before  !  now     !  after   ! 
    … …  
    4837   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshv_b ,  sshv_n  ,  sshv_a  !: sea surface height at u-point [m] 
    4938   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sshf_b ,  sshf_n  ,  sshf_a  !: sea surface height at f-point [m] 
     39   ! 
     40   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   spgu, spgv                   !: horizontal surface pressure gradient 
    5041 
    51    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpts) ::  tsb, tsn, tsa         !: 4D array for T & S  
    52    !                                                                       !: ( tb, sb),  (tn, sn ),  (ta, sa ) 
     42   !! interpolated gradient (only used in zps case) 
     43   !! --------------------- 
     44   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point 
     45   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)      ::   gru , grv    !: horizontal gradient of rd at bottom u-point 
    5346 
    5447   !!---------------------------------------------------------------------- 
    55    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2008)  
     48   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    5649   !! $Id$  
    5750   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/opa.F90

    r2082 r2104  
    77   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
    88   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,  
    9    !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes ) release 7.1  
     9   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1  
    1010   !!             -   ! 1992-06  (L.Terray)  coupling implementation 
    1111   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice  
    1212   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,  
    13    !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy)  release 8.0 
     13   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 
    1414   !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
    1515   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model  
    … …  
    3131   !!   opa_model      : solve ocean dynamics, tracer and/or sea-ice 
    3232   !!   opa_init       : initialization of the opa model 
    33    !!   opa_flg        : initialisation of algorithm flag  
     33   !!   opa_ctl        : initialisation of algorithm flag  
    3434   !!   opa_closefile  : close remaining files 
    3535   !!---------------------------------------------------------------------- 
    … …  
    7272 
    7373   !!---------------------------------------------------------------------- 
    74    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     74   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    7575   !! $Id$ 
    7676   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    204204         WRITE(numout,*) '                       NEMO team' 
    205205         WRITE(numout,*) '            Ocean General Circulation Model' 
    206          WRITE(numout,*) '                  version 3.2  (2009) ' 
     206         WRITE(numout,*) '                  version 3.3  (2010) ' 
    207207         WRITE(numout,*) 
    208208         WRITE(numout,*) 
    … …  
    217217      !                             !--------------------------------! 
    218218 
    219       CALL opa_flg                           ! Control prints & Benchmark 
     219      CALL opa_ctl                           ! Control prints & Benchmark 
    220220 
    221221      !                                      ! Domain decomposition 
    … …  
    223223      ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
    224224      ENDIF 
    225   
    226  
    227  
    228       
    229225 
    230226      !                                      ! General initialization 
    … …  
    243239 
    244240      !                                     ! Ocean physics 
    245                             CALL     sbc_init   !  Forcings : surface module  
    246  
     241                            CALL     sbc_init   ! Forcings : surface module  
    247242      !                                         ! Vertical physics 
    248243                            CALL     zdf_init      ! namelist read 
    249244                            CALL zdf_bfr_init      ! bottom friction 
    250245      IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz 
    251       IF( lk_zdftke_old )   CALL zdf_tke_init      ! TKE closure scheme for Kz (old scheme) 
    252       IF( lk_zdftke     )   CALL     tke_init      ! TKE closure scheme for Kz 
     246      IF( lk_zdftke_old )   CALL zdf_tke_init_o    ! TKE closure scheme for Kz (old scheme) 
     247      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme for Kz 
    253248      IF( lk_zdfkpp     )   CALL zdf_kpp_init      ! KPP closure scheme for Kz 
    254249      IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing 
    … …  
    272267      !                                     ! Dynamics 
    273268                            CALL dyn_adv_init   ! advection (vector or flux form) 
    274                             CALL     vor_init   ! vorticity term including Coriolis 
     269                            CALL dyn_vor_init   ! vorticity term including Coriolis 
    275270                            CALL dyn_ldf_init   ! lateral mixing 
    276                             CALL     hpg_init   ! horizontal gradient of Hydrostatic pressure 
     271                            CALL dyn_hpg_init   ! horizontal gradient of Hydrostatic pressure 
    277272                            CALL dyn_zdf_init   ! vertical diffusion 
    278273                            CALL dyn_spg_init   ! surface pressure gradient 
    … …  
    291286 
    292287 
    293    SUBROUTINE opa_flg 
     288   SUBROUTINE opa_ctl 
    294289      !!---------------------------------------------------------------------- 
    295290      !!                     ***  ROUTINE opa  *** 
    … …  
    308303      IF(lwp) THEN                 ! Parameter print 
    309304         WRITE(numout,*) 
    310          WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 
     305         WRITE(numout,*) 'opa_ctl: Control prints & Benchmark' 
    311306         WRITE(numout,*) '~~~~~~~ ' 
    312307         WRITE(numout,*) '   Namelist namctl' 
    … …  
    377372         END SELECT 
    378373      ENDIF 
    379  
    380       REWIND( numnam )              ! Read Namelist namdyn_hpg : ln_dynhpg_imp must be read at the initialisation phase 
    381       READ  ( numnam, namdyn_hpg ) 
    382       ! 
    383    END SUBROUTINE opa_flg 
     374      ! 
     375   END SUBROUTINE opa_ctl 
    384376 
    385377 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/par_oce.F90

    r2025 r2104  
    44   !! Ocean :   set the ocean parameters 
    55   !!====================================================================== 
    6    !! History : 
    7    !!   4.0  !  91     (Imbard, Levy, Madec)  Original code 
    8    !!   9.0  !  04-01  (G. Madec, J.-M. Molines)  Free form and module 
    9    !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
    10    !!---------------------------------------------------------------------- 
    11    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    12    !! $Id$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    14    !!---------------------------------------------------------------------- 
    15    !! * Modules used 
     6   !! History :  OPA  !  1991     (Imbard, Levy, Madec)  Original code 
     7   !!   NEMO     1.0  !  2004-01  (G. Madec, J.-M. Molines)  Free form and module 
     8   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal 
     9   !!---------------------------------------------------------------------- 
    1610   USE par_kind          ! kind parameters 
    1711 
    … …  
    2216   !!   Domain decomposition 
    2317   !!---------------------------------------------------------------------- 
    24    !! * if we dont use massively parallel computer (parameters jpni=jpnj=1) 
    25    !!      so jpiglo=jpi and jpjglo=jpj 
    26  
     18   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj 
    2719#if ! defined key_mpp_dyndist  
    28    INTEGER, PUBLIC, PARAMETER ::    &  !:  
    29       jpni   = 1,                   &  !: number of processors following i  
    30       jpnj   = 1,                   &  !: number of processors following j 
    31       jpnij  = 1                       !: nb of local domain = nb of processors  
    32       !                                !  ( <= jpni x jpnj ) 
    33 #else 
    34    INTEGER, PUBLIC ::               &  ! 
    35       jpni      ,                   &  !: number of processors following i  
    36       jpnj      ,                   &  !: number of processors following j 
    37       jpnij                            !: nb of local domain = nb of processors  
    38       !                                !  ( <= jpni x jpnj ) 
    39 #endif 
    40  
    41    INTEGER, PUBLIC, PARAMETER ::    &  !: 
    42       jpr2di = 0,                   &  !: number of columns for extra outer halo  
    43       jpr2dj = 0,                   &  !: number of rows    for extra outer halo  
    44       jpreci = 1,                   &  !: number of columns for overlap  
    45       jprecj = 1                       !: number of rows    for overlap  
     20   INTEGER, PUBLIC, PARAMETER ::   jpni   = 1   !: number of processors following i  
     21   INTEGER, PUBLIC, PARAMETER ::   jpnj   = 1   !: number of processors following j 
     22   INTEGER, PUBLIC, PARAMETER ::   jpnij  = 1   !: nb of local domain = nb of processors ( <= jpni x jpnj ) 
     23#else 
     24   INTEGER, PUBLIC            ::   jpni         !: number of processors following i  
     25   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j 
     26   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj ) 
     27#endif 
     28   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo  
     29   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo  
     30   INTEGER, PUBLIC, PARAMETER ::   jpreci = 1   !: number of columns for overlap  
     31   INTEGER, PUBLIC, PARAMETER ::   jprecj = 1   !: number of rows    for overlap  
    4632 
    4733   !! Ocean Domain sizes 
    … …  
    10086   !!   default option  :                               small closed basin 
    10187   !!--------------------------------------------------------------------- 
    102    CHARACTER(len=16), PUBLIC, PARAMETER ::   &  !: 
    103       cp_cfg = "default"               !: name of the configuration 
    104    INTEGER, PARAMETER ::            &  !: 
    105       jp_cfg = 0  ,                 &  !: resolution of the configuration 
    106  
    107       ! data size                     !!! * size of all input files * 
    108       jpidta  = 10,                 &  !: 1st lateral dimension ( >= jpi ) 
    109       jpjdta  = 12,                 &  !: 2nd    "         "    ( >= jpj ) 
    110       jpkdta  = 31,                 &  !: number of levels      ( >= jpk ) 
    111  
    112       ! global or zoom domain size    !!! * computational domain * 
    113       jpiglo  = jpidta,             &  !: 1st dimension of global domain --> i 
    114       jpjglo  = jpjdta,             &  !: 2nd    "                  "    --> j 
    115       jpk     = jpkdta,             &  !: number of vertical levels 
    116       ! zoom starting position  
    117       jpizoom =   1   ,             &  !: left bottom (i,j) indices of the zoom 
    118       jpjzoom =   1   ,             &  !: in data domain indices 
    119  
    120       ! Domain characteristics 
    121       jperio  =  0                     !: lateral cond. type (between 0 and 6) 
    122          !                             !  = 0 closed 
    123          !                             !  = 1 cyclic East-West 
    124          !                             !  = 2 equatorial symmetric 
    125          !                             !  = 3 North fold T-point pivot 
    126          !                             !  = 4 cyclic East-West AND North fold T-point pivot 
    127          !                             !  = 5 North fold F-point pivot 
    128          !                             !  = 6 cyclic East-West AND North fold F-point pivot 
    129  
    130       !!  Values set to pp_not_used indicates that this parameter is not used in THIS config. 
    131       !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr 
    132       REAL(wp), PARAMETER ::   &  !: 
    133          pp_not_used       = 999999._wp , &  !: 
    134          pp_to_be_computed = 999999._wp      !: 
     88   CHARACTER(len=16), PUBLIC, PARAMETER ::   cp_cfg = "default"   !: name of the configuration 
     89   INTEGER          , PUBLIC, PARAMETER ::   jp_cfg = 0           !: resolution of the configuration 
     90 
     91   ! data size                                       !!! * size of all input files * 
     92   INTEGER, PUBLIC, PARAMETER ::   jpidta  = 10       !: 1st lateral dimension ( >= jpi ) 
     93   INTEGER, PUBLIC, PARAMETER ::   jpjdta  = 12       !: 2nd    "         "    ( >= jpj ) 
     94   INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk ) 
     95 
     96   ! global or zoom domain size                      !!! * computational domain * 
     97   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i 
     98   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j 
     99   INTEGER, PUBLIC, PARAMETER ::   jpk     = jpkdta   !: number of vertical levels 
     100   ! zoom starting position  
     101   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom 
     102   INTEGER, PUBLIC, PARAMETER ::   jpjzoom =   1      !: in data domain indices 
     103 
     104   ! Domain characteristics 
     105   INTEGER, PUBLIC, PARAMETER ::   jperio  =  0       !: lateral cond. type (between 0 and 6) 
     106   !                                                  !  = 0 closed                 ;   = 1 cyclic East-West 
     107   !                                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot 
     108   !                                                  !  = 4 cyclic East-West AND North fold T-point pivot 
     109   !                                                  !  = 5 North fold F-point pivot 
     110   !                                                  !  = 6 cyclic East-West AND North fold F-point pivot 
     111 
     112   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config. 
     113   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr 
     114   REAL(wp), PUBLIC, PARAMETER ::   pp_not_used       = 999999._wp   !: vertical grid parameter 
     115   REAL(wp), PUBLIC, PARAMETER ::   pp_to_be_computed = 999999._wp   !:    -      -       - 
    135116 
    136117 
    137118   !! Horizontal grid parameters for domhgr 
    138119   !! ===================================== 
    139  
    140    INTEGER, PUBLIC, PARAMETER   ::   &  !: 
    141       jphgr_msh = 0            !: type of horizontal mesh 
    142       !                        !  = 0 curvilinear coordinate on the sphere 
    143       !                        !      read in coordinate.nc file 
    144       !                        !  = 1 geographical mesh on the sphere 
    145       !                        !      with regular grid-spacing 
    146       !                        !  = 2 f-plane with regular grid-spacing 
    147       !                        !  = 3 beta-plane with regular grid-spacing 
    148       !                        !  = 4 Mercator grid with T/U point at the equator  with 
    149       !                        !      isotropic resolution (e1_deg) 
    150  
    151    REAL(wp) , PUBLIC, PARAMETER ::   &   !: 
    152       ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1) 
    153       ppgphi0  =  -35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1) 
    154       !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3) 
    155       ppe1_deg =    1.0_wp,   &  !: zonal      grid-spacing (degrees) 
    156       ppe2_deg =    0.5_wp,   &  !: meridional grid-spacing (degrees) 
    157       ppe1_m   = 5000.0_wp,   &  !: zonal      grid-spacing (degrees) 
    158       ppe2_m   = 5000.0_wp       !: meridional grid-spacing (degrees) 
     120   INTEGER, PUBLIC, PARAMETER  ::   jphgr_msh = 0   !: type of horizontal mesh 
     121   !                                                !  = 0 curvilinear coordinate on the sphere read in coordinate.nc 
     122   !                                                !  = 1 geographical mesh on the sphere with regular grid-spacing 
     123   !                                                !  = 2 f-plane with regular grid-spacing 
     124   !                                                !  = 3 beta-plane with regular grid-spacing 
     125   !                                                !  = 4 Mercator grid with T/U point at the equator 
     126 
     127   REAL(wp) , PUBLIC, PARAMETER ::   ppglam0  =    0.0_wp   !: longitude of first raw and column T-point (jphgr_msh = 1) 
     128   REAL(wp) , PUBLIC, PARAMETER ::   ppgphi0  =  -35.0_wp   !: latitude  of first raw and column T-point (jphgr_msh = 1) 
     129   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3) 
     130   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_deg =    1.0_wp   !: zonal      grid-spacing (degrees) 
     131   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_deg =    0.5_wp   !: meridional grid-spacing (degrees) 
     132   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_m   = 5000.0_wp   !: zonal      grid-spacing (degrees) 
     133   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_m   = 5000.0_wp   !: meridional grid-spacing (degrees) 
    159134 
    160135   !! Vertical grid parameter for domzgr 
    161136   !! ================================== 
    162  
    163    REAL(wp), PUBLIC, PARAMETER  ::   &  !: 
    164       &     ppsur = -4762.96143546300_wp ,  &  !: ORCA r4, r2 and r05 coefficients 
    165       &     ppa0  =   255.58049070440_wp ,  &  !: (default coefficients) 
    166       &     ppa1  =   245.58132232490_wp ,  &  !: 
    167       &     ppkth =    21.43336197938_wp ,  &  !: 
    168       &     ppacr =     3.00000000000_wp       !: 
    169  
    170    !!  If both ppa0 ppa1 and ppsur are specified to 0, then 
    171    !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr 
    172  
    173    REAL(wp), PUBLIC, PARAMETER ::   &  !: 
    174       &     ppdzmin = 10._wp             ,  &  !: Minimum vertical spacing 
    175       &     pphmax  = 5000._wp                 !: Maximum depth 
    176  
    177    !!--------------------------------------------------------------------- 
    178 #endif 
    179  
    180    INTEGER, PUBLIC, PARAMETER :: jpts   = 2    !: Number of active tracers ( T & S ) 
    181    INTEGER, PUBLIC, PARAMETER :: jp_tem = 1    !: indice for temperature 
    182    INTEGER, PUBLIC, PARAMETER :: jp_sal = 2    !: indice for salinity 
    183  
    184    !!--------------------------------------------------------------------- 
    185    !! Domain Matrix size 
    186    !!--------------------------------------------------------------------- 
    187    INTEGER  &  !: 
    188 #if !defined key_agrif 
    189       ,PARAMETER  & 
    190 #endif 
    191     :: & 
    192       jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ,   &  !: first  dimension 
    193       jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ,   &  !: second dimension 
    194       jpim1 = jpi-1,                                             &  !: inner domain indices 
    195       jpjm1 = jpj-1,                                             &  !:   "            " 
    196       jpkm1 = jpk-1,                                             &  !:   "            " 
    197       jpij  = jpi*jpj                                               !:  jpi x jpj 
    198  
     137   REAL(wp), PUBLIC, PARAMETER ::   ppsur = -4762.96143546300_wp   !: ORCA r4, r2 and r05 coefficients 
     138   REAL(wp), PUBLIC, PARAMETER ::   ppa0  =   255.58049070440_wp   !: (default coefficients) 
     139   REAL(wp), PUBLIC, PARAMETER ::   ppa1  =   245.58132232490_wp   !: 
     140   REAL(wp), PUBLIC, PARAMETER ::   ppkth =    21.43336197938_wp   !: 
     141   REAL(wp), PUBLIC, PARAMETER ::   ppacr =     3.00000000000_wp   !: 
     142   ! 
     143   !  If both ppa0 ppa1 and ppsur are specified to 0, then 
     144   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr 
     145   REAL(wp), PUBLIC, PARAMETER ::   ppdzmin = 10._wp     !: Minimum vertical spacing 
     146   REAL(wp), PUBLIC, PARAMETER ::   pphmax  = 5000._wp   !: Maximum depth 
     147 
     148#endif 
     149 
     150 
     151   !!--------------------------------------------------------------------- 
     152   !! Active tracer parameters 
     153   !!--------------------------------------------------------------------- 
     154   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S ) 
     155   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature 
     156   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity 
     157 
     158   !!--------------------------------------------------------------------- 
     159   !! Domain Matrix size  (if AGRIF, they are not all parameters) 
     160   !!--------------------------------------------------------------------- 
    199161#if defined key_agrif 
    200    !!--------------------------------------------------------------------- 
    201    !! Agrif variables 
    202    !!--------------------------------------------------------------------- 
    203    INTEGER, PUBLIC, PARAMETER :: nbghostcells = 1 
    204    INTEGER, PUBLIC :: nbcellsx = jpiglo - 2 - 2*nbghostcells 
    205    INTEGER, PUBLIC :: nbcellsy = jpjglo - 2 - 2*nbghostcells 
    206 #endif 
     162   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 1                             !: number of ghost cells 
     163   INTEGER, PUBLIC            ::   nbcellsx     = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction 
     164   INTEGER, PUBLIC            ::   nbcellsy     = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction 
     165   ! 
     166   INTEGER, PUBLIC            ::   jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension 
     167   INTEGER, PUBLIC            ::   jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension 
     168   INTEGER, PUBLIC            ::   jpim1 = jpi-1                                            !: inner domain indices 
     169   INTEGER, PUBLIC            ::   jpjm1 = jpj-1                                            !:   -     -      - 
     170   INTEGER, PUBLIC            ::   jpkm1 = jpk-1                                            !:   -     -      - 
     171   INTEGER, PUBLIC            ::   jpij  = jpi*jpj                                          !:  jpi x jpj 
     172#else 
     173   INTEGER, PUBLIC, PARAMETER ::   jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension 
     174   INTEGER, PUBLIC, PARAMETER ::   jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension 
     175   INTEGER, PUBLIC, PARAMETER ::   jpim1 = jpi-1                                            !: inner domain indices 
     176   INTEGER, PUBLIC, PARAMETER ::   jpjm1 = jpj-1                                            !:   -     -      - 
     177   INTEGER, PUBLIC, PARAMETER ::   jpkm1 = jpk-1                                            !:   -     -      - 
     178   INTEGER, PUBLIC, PARAMETER ::   jpij  = jpi*jpj                                          !:  jpi x jpj 
     179#endif 
     180 
    207181   !!--------------------------------------------------------------------- 
    208182   !! Optimization/control flags 
    … …  
    214188#endif 
    215189 
    216 #if defined key_vectopt_memory 
    217    LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_mem  = .TRUE.   !: vector optimization flag 
    218 #else 
    219    LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_mem  = .FALSE.  !: vector optimization flag 
    220 #endif 
    221  
    222190#if defined key_vectopt_loop 
    223191   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag 
    … …  
    226194#endif 
    227195 
     196   !!---------------------------------------------------------------------- 
     197   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
     198   !! $Id$  
     199   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    228200   !!====================================================================== 
    229201END MODULE par_oce 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/step.F90

    r2082 r2104  
    2121   !!            3.2  !  2009-02  (G. Madec, R. Benshila)  reintroduicing z*-coordinate 
    2222   !!             -   !  2009-06  (S. Masson, G. Madec)  TKE restart compatible with key_cpl 
     23   !!            3.3  !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
    2324   !!---------------------------------------------------------------------- 
    2425 
    … …  
    2728   !!---------------------------------------------------------------------- 
    2829   USE step_oce         ! time stepping definition modules  
     30#if defined key_top 
     31   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
     32#endif 
    2933 
    3034   IMPLICIT NONE 
    … …  
    3741#  include "zdfddm_substitute.h90" 
    3842   !!---------------------------------------------------------------------- 
    39    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     43   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    4044   !! $Id$ 
    4145   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    … …  
    7377#if defined key_agrif 
    7478      kstp = nit000 + Agrif_Nb_Step() 
    75 !      IF( Agrif_Root() .and. lwp) Write(*,*) '---' 
    76 !      IF(lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
    7779# if defined key_iomput 
    78       IF( Agrif_Nbstepint() == 0) CALL iom_swap 
     80      IF( Agrif_Nbstepint() == 0 )  CALL iom_swap 
    7981# endif    
    8082#endif    
    81       indic = 1                                       ! reset to no error condition 
    82  
    83       IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init) 
    84  
    85       CALL iom_setkt( kstp )                          ! say to iom that we are at time step kstp 
    86        
    87       CALL rst_opn( kstp )                            ! Open the restart file 
     83                             indic = 0                ! reset to no error condition 
     84      IF( kstp /= nit000 )   CALL day      ( kstp )   ! Calendar (day was already called at nit000 in day_init) 
     85                             CALL iom_setkt( kstp )   ! say to iom that we are at time step kstp 
     86                             CALL rst_opn  ( kstp )   ! Open the restart file 
    8887 
    8988      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    … …  
    190189                             CALL tra_nxt    ( kstp )            ! tracer fields at next time step 
    191190                             CALL eos( tsa, rhd, rhop )       ! Time-filtered in situ density for hpg computation 
    192          IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv,  &    ! Partial steps: time filtered hor. derivative 
     191         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv,  &    ! zps: time filtered hor. derivative 
    193192            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
    194193          
    195194      ELSE                                                  ! centered hpg  (eos then time stepping) 
    196195                             CALL eos( tsn, rhd, rhop )       ! now in situ density for hpg computation 
    197          IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! Partial steps: now hor. derivative 
     196         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative 
    198197            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level 
    199198         IF( ln_zdfnpc   )   CALL tra_npc    ( kstp )       ! update after fields by non-penetrative convection 
    … …  
    217216                               CALL dyn_bfr( kstp )           ! bottom friction    
    218217                               CALL dyn_zdf( kstp )         ! vertical diffusion 
    219                                indic=0 
    220218                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient 
    221219                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/step_oce.F90

    r2082 r2104  
    22   !!====================================================================== 
    33   !!                       ***  MODULE step_oce  *** 
    4    !! Time-stepping    : manager of the ocean, tracer and ice time stepping 
    5    !!---------------------------------------------------------------------- 
    6    USE oce             ! ocean dynamics and tracers variables 
    7    USE dom_oce         ! ocean space and time domain variables  
    8    USE zdf_oce         ! ocean vertical physics variables 
    9    USE ldftra_oce      ! ocean tracer   - trends 
    10    USE ldfdyn_oce      ! ocean dynamics - trends 
    11    USE in_out_manager  ! I/O manager 
    12    USE iom             ! 
     4   !! Time-stepping    : module used for the ocean time stepping 
     5   !!====================================================================== 
     6   USE oce              ! ocean dynamics and tracers variables 
     7   USE dom_oce          ! ocean space and time domain variables  
     8   USE zdf_oce          ! ocean vertical physics variables 
     9   USE ldftra_oce       ! ocean tracer   - trends 
     10   USE ldfdyn_oce       ! ocean dynamics - trends 
     11   USE in_out_manager   ! I/O manager 
     12   USE iom              ! 
    1313   USE lbclnk 
    1414 
    15    USE daymod          ! calendar                         (day     routine) 
     15   USE daymod           ! calendar                         (day     routine) 
    1616 
    17    USE dtatem          ! ocean temperature data           (dta_tem routine) 
    18    USE dtasal          ! ocean salinity    data           (dta_sal routine) 
    19    USE sbcmod          ! surface boundary condition       (sbc     routine) 
    20    USE sbcrnf          ! surface boundary condition: runoff variables 
    21    USE sbccpl          ! surface boundary condition: coupled formulation (call send at end of step) 
     17   USE dtatem           ! ocean temperature data           (dta_tem routine) 
     18   USE dtasal           ! ocean salinity    data           (dta_sal routine) 
     19   USE sbcmod           ! surface boundary condition       (sbc     routine) 
     20   USE sbcrnf           ! surface boundary condition: runoff variables 
     21   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step) 
    2222   USE cpl_oasis3, ONLY : lk_cpl 
    2323 
    24 #if defined key_top 
    25    USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
    26 #endif 
     24   USE traqsr           ! solar radiation penetration      (tra_qsr routine) 
     25   USE trasbc           ! surface boundary condition       (tra_sbc routine) 
     26   USE trabbc           ! bottom boundary condition        (tra_bbc routine) 
     27   USE trabbl           ! bottom boundary layer            (tra_bbl routine) 
     28   USE tradmp           ! internal damping                 (tra_dmp routine) 
     29   USE traadv           ! advection scheme control     (tra_adv_ctl routine) 
     30   USE traldf           ! lateral mixing                   (tra_ldf routine) 
     31   USE cla              ! cross land advection             (tra_cla routine) 
     32   !   zdfkpp           ! KPP non-local tracer fluxes      (tra_kpp routine) 
     33   USE trazdf           ! vertical mixing                  (tra_zdf routine) 
     34   USE tranxt           ! time-stepping                    (tra_nxt routine) 
     35   USE tranpc           ! non-penetrative convection       (tra_npc routine) 
    2736 
    28    USE traqsr          ! solar radiation penetration      (tra_qsr routine) 
    29    USE trasbc          ! surface boundary condition       (tra_sbc routine) 
    30    USE trabbc          ! bottom boundary condition        (tra_bbc routine) 
    31    USE trabbl          ! bottom boundary layer            (tra_bbl routine) 
    32    USE tradmp          ! internal damping                 (tra_dmp routine) 
    33    USE traadv          ! advection scheme control     (tra_adv_ctl routine) 
    34    USE traldf          ! lateral mixing                   (tra_ldf routine) 
    35    USE cla             ! cross land advection             (tra_cla routine) 
    36    !   zdfkpp          ! KPP non-local tracer fluxes      (tra_kpp routine) 
    37    USE trazdf          ! vertical mixing                  (tra_zdf routine) 
    38    USE tranxt          ! time-stepping                    (tra_nxt routine) 
    39    USE tranpc          ! non-penetrative convection       (tra_npc routine) 
     37   USE eosbn2           ! equation of state                (eos_bn2 routine) 
    4038 
    41    USE eosbn2          ! equation of state                (eos_bn2 routine) 
     39   USE dynadv           ! advection                        (dyn_adv routine) 
     40   USE dynbfr           ! Bottom friction terms            (dyn_bfr routine) 
     41   USE dynvor           ! vorticity term                   (dyn_vor routine) 
     42   USE dynhpg           ! hydrostatic pressure grad.       (dyn_hpg routine) 
     43   USE dynldf           ! lateral momentum diffusion       (dyn_ldf routine) 
     44   USE dynzdf           ! vertical diffusion               (dyn_zdf routine) 
     45   USE dynspg_oce       ! surface pressure gradient        (dyn_spg routine) 
     46   USE dynspg           ! surface pressure gradient        (dyn_spg routine) 
     47   USE dynnxt           ! time-stepping                    (dyn_nxt routine) 
    4248 
    43    USE dynadv          ! advection                        (dyn_adv routine) 
    44    USE dynbfr          ! Bottom friction terms            (dyn_bfr routine) 
    45    USE dynvor          ! vorticity term                   (dyn_vor routine) 
    46    USE dynhpg          ! hydrostatic pressure grad.       (dyn_hpg routine) 
    47    USE dynldf          ! lateral momentum diffusion       (dyn_ldf routine) 
    48    USE dynzdf          ! vertical diffusion               (dyn_zdf routine) 
    49    USE dynspg_oce      ! surface pressure gradient        (dyn_spg routine) 
    50    USE dynspg          ! surface pressure gradient        (dyn_spg routine) 
    51    USE dynnxt          ! time-stepping                    (dyn_nxt routine) 
     49   USE obc_par          ! open boundary condition variables 
     50   USE obcdta           ! open boundary condition data     (obc_dta routine) 
     51   USE obcrst           ! open boundary cond. restart      (obc_rst routine) 
     52   USE obcrad           ! open boundary cond. radiation    (obc_rad routine) 
    5253 
    53    USE obc_par         ! open boundary condition variables 
    54    USE obcdta          ! open boundary condition data     (obc_dta routine) 
    55    USE obcrst          ! open boundary cond. restart      (obc_rst routine) 
    56    USE obcrad          ! open boundary cond. radiation    (obc_rad routine) 
     54   USE bdy_par          ! unstructured open boundary data variables 
     55   USE bdydta           ! unstructured open boundary data  (bdy_dta routine) 
    5756 
    58    USE bdy_par         ! unstructured open boundary data variables 
    59    USE bdydta          ! unstructured open boundary data  (bdy_dta routine) 
     57   USE sshwzv           ! vertical velocity and ssh        (ssh_wzv routine) 
    6058 
    61    USE sshwzv          ! vertical velocity and ssh        (ssh_wzv routine) 
     59   USE ldfslp           ! iso-neutral slopes               (ldf_slp routine) 
     60   USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine) 
    6261 
    63    USE ldfslp          ! iso-neutral slopes               (ldf_slp routine) 
    64    USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine) 
     62   USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine) 
     63   USE zdfbfr           ! bottom friction                  (zdf_bfr routine) 
     64   USE zdftke_old       ! old TKE vertical mixing      (zdf_tke_old routine) 
     65   USE zdftke           ! TKE vertical mixing              (zdf_tke routine) 
     66   USE zdfkpp           ! KPP vertical mixing              (zdf_kpp routine) 
     67   USE zdfddm           ! double diffusion mixing          (zdf_ddm routine) 
     68   USE zdfevd           ! enhanced vertical diffusion      (zdf_evd routine) 
     69   USE zdfric           ! Richardson vertical mixing       (zdf_ric routine) 
     70   USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine) 
    6571 
    66    USE zdftmx          ! tide-induced vertical mixing     (zdf_tmx routine) 
    67    USE zdfbfr          ! bottom friction                  (zdf_bfr routine) 
    68    USE zdftke_old      ! old TKE vertical mixing      (zdf_tke_old routine) 
    69    USE zdftke          ! TKE vertical mixing              (zdf_tke routine) 
    70    USE zdfkpp          ! KPP vertical mixing              (zdf_kpp routine) 
    71    USE zdfddm          ! double diffusion mixing          (zdf_ddm routine) 
    72    USE zdfevd          ! enhanced vertical diffusion      (zdf_evd routine) 
    73    USE zdfric          ! Richardson vertical mixing       (zdf_ric routine) 
    74    USE zdfmxl          ! Mixed-layer depth                (zdf_mxl routine) 
     72   USE zpshde           ! partial step: hor. derivative     (zps_hde routine) 
    7573 
    76    USE zpshde          ! partial step: hor. derivative     (zps_hde routine) 
     74   USE diawri           ! Standard run outputs             (dia_wri routine) 
     75   USE trdicp           ! Ocean momentum/tracers trends    (trd_wri routine) 
     76   USE trdmld           ! mixed-layer trends               (trd_mld routine) 
     77   USE trdmld_rst       ! restart for mixed-layer trends 
     78   USE trdmod_oce       ! ocean momentum/tracers trends 
     79   USE trdmod           ! momentum/tracers trends    
     80   USE trdvor           ! vorticity budget                 (trd_vor routine) 
     81   USE diagap           ! hor. mean model-data gap         (dia_gap routine) 
     82   USE diahdy           ! dynamic height                   (dia_hdy routine) 
     83   USE diaptr           ! poleward transports              (dia_ptr routine) 
     84   USE diaar5           ! AR5 diagnosics                   (dia_ar5 routine) 
     85   USE diahth           ! thermocline depth                (dia_hth routine) 
     86   USE diafwb           ! freshwater budget                (dia_fwb routine) 
     87   USE flo_oce          ! floats variables 
     88   USE floats           ! floats computation               (flo_stp routine) 
    7789 
    78    USE diawri          ! Standard run outputs             (dia_wri routine) 
    79    USE trdicp          ! Ocean momentum/tracers trends    (trd_wri routine) 
    80    USE trdmld          ! mixed-layer trends               (trd_mld routine) 
    81    USE trdmld_rst      ! restart for mixed-layer trends 
    82    USE trdmod_oce      ! ocean momentum/tracers trends 
    83    USE trdmod          ! momentum/tracers trends    
    84    USE trdvor          ! vorticity budget                 (trd_vor routine) 
    85    USE diagap          ! hor. mean model-data gap         (dia_gap routine) 
    86    USE diahdy          ! dynamic height                   (dia_hdy routine) 
    87    USE diaptr          ! poleward transports              (dia_ptr routine) 
    88    USE diaar5          ! AR5 diagnosics                   (dia_ar5 routine) 
    89    USE diahth          ! thermocline depth                (dia_hth routine) 
    90    USE diafwb          ! freshwater budget                (dia_fwb routine) 
    91    USE flo_oce         ! floats variables 
    92    USE floats          ! floats computation               (flo_stp routine) 
     90   USE stpctl           ! time stepping control            (stp_ctl routine) 
     91   USE restart          ! ocean restart                    (rst_wri routine) 
     92   USE prtctl           ! Print control                    (prt_ctl routine) 
    9393 
    94    USE stpctl          ! time stepping control            (stp_ctl routine) 
    95    USE restart         ! ocean restart                    (rst_wri routine) 
    96    USE prtctl          ! Print control                    (prt_ctl routine) 
    97  
    98    USE traswp          ! Swap arrays                      (tra_swp routine) 
    99                        !                                (tra_unswp routine)  
     94   USE traswp           ! Swap arrays           (tra_swp, tra_unswp routine) 
    10095 
    10196#if defined key_agrif 
    10297   USE agrif_opa_sponge ! Momemtum and tracers sponges 
    10398#endif 
    104  
    10599   !!====================================================================== 
    106100END MODULE step_oce 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/trc_oce.F90

    r2082 r2104  
    2121   PUBLIC   trc_oce_ext_lev    ! function called by traqsr.F90 at least 
    2222  
    23    INTEGER , PUBLIC  ::  nn_dttrc      !: frequency of step on passive tracers 
    24    INTEGER , PUBLIC  ::  nittrc000     !: first time step of passive tracers model 
    25    
    2623   REAL(wp), PUBLIC , DIMENSION(jpi,jpj,jpk) ::   etot3   !: light absortion coefficient 
    2724 
    … …  
    4138#  include "domzgr_substitute.h90" 
    4239   !!---------------------------------------------------------------------- 
    43    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     40   !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010)  
    4441   !! $Id$  
    4542   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    r2038 r2104  
    179179      ! Check number of tracers 
    180180      ! -----------------------    
    181       IF( jp_c14b > 1) THEN 
    182           IF(lwp) THEN 
    183               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    184               WRITE (numout,*) ' =======   ============= ' 
    185               WRITE (numout,*)                             & 
    186               &   ' STOP, change jp_c14b to 1 in par_C14b module ' 
    187           END IF 
    188           STOP 'TRC_CTL' 
    189       END IF 
     181      IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 
    190182 
    191183      ! Check tracer names 
    … …  
    197189 
    198190      IF(lwp) THEN 
    199          WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    200          WRITE (numout,*) ' =======   ============= ' 
    201          WRITE (numout,*) ' we force tracer names' 
     191         CALL ctl_warn( ' we force tracer names' ) 
    202192         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14) 
    203193         WRITE(numout,*) ' ' 
    … …  
    209199          ctrcun(jpc14) = 'ration' 
    210200          IF(lwp) THEN 
    211              WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    212              WRITE (numout,*) ' =======   ============= ' 
    213              WRITE (numout,*) ' we force tracer unit' 
     201             CALL ctl_warn( ' we force tracer unit' ) 
    214202             WRITE(numout,*) ' tracer  ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14) 
    215203             WRITE(numout,*) ' ' 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcrst_c14b.F90

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

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r2082 r2104  
    131131      !!---------------------------------------------------------------------- 
    132132 
    133       IF( kt == nittrc000 )  THEN 
     133      IF( kt == nit000 )  THEN 
    134134         ! Computation of decay coeffcient 
    135135         zdemi   = 5730. 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2082 r2104  
    9393      !!---------------------------------------------------------------------- 
    9494 
    95       IF( kt == nittrc000 )   CALL trc_cfc_cst 
     95      IF( kt == nit000 )   CALL trc_cfc_cst 
    9696 
    9797      ! Temporal interpolation 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r2082 r2104  
    2020   USE lbclnk          !  
    2121   USE prtctl_trc      ! Print control for debbuging 
     22   USE trdmod_oce 
    2223   USE trdmod_trc 
    2324   USE iom 
    … …  
    8182      !!--------------------------------------------------------------------- 
    8283 
    83       IF( kt == nittrc000 ) THEN 
     84      IF( kt == nit000 ) THEN 
    8485         IF(lwp) WRITE(numout,*) 
    8586         IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r2082 r2104  
    1919   USE lbclnk 
    2020   USE trc 
    21    USE trctrp_lec 
     21   USE trcnam_trp 
    2222   USE prtctl_trc      ! Print control for debbuging 
     23   USE trdmod_oce 
    2324   USE trdmod_trc 
    2425   USE iom 
    … …  
    6061      !!--------------------------------------------------------------------- 
    6162 
    62       IF( kt == nittrc000 ) THEN 
     63      IF( kt == nit000 ) THEN 
    6364         IF(lwp) WRITE(numout,*) 
    6465         IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' 
    … …  
    125126      IF( ln_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 
    126127         zfact = 2. * rdttra(jk) * FLOAT( nn_dttrc )  
    127          IF( neuler == 0 .AND. kt == nittrc000 )   zfact = rdttra(jk) * FLOAT(nn_dttrc)  
     128         IF( neuler == 0 .AND. kt == nit000 )   zfact = rdttra(jk) * FLOAT(nn_dttrc)  
    128129         sedpoca(:,:) =  sedpocb(:,:) + zfact * sedpoca(:,:)  
    129130      ENDIF 
    … …  
    133134      ! ------------------------------ 
    134135      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd  ) THEN         ! centred or tvd scheme 
    135          IF( neuler == 0 .AND. kt == nittrc000 ) THEN 
     136         IF( neuler == 0 .AND. kt == nit000 ) THEN 
    136137            DO jj = 1, jpj 
    137138               DO ji = 1, jpi 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r2038 r2104  
    275275      ! Check number of tracers 
    276276      ! ----------------------- 
    277       IF (jp_lobster /= 6) THEN 
    278           IF (lwp) THEN 
    279               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    280               WRITE (numout,*) ' =======   ============= ' 
    281               WRITE (numout,*)                             & 
    282               &   ' STOP, change jp_lobster to 6 in '           & 
    283               &   ,'par_lobster.F90 ' 
    284           END IF 
    285           STOP 'TRC_CTL' 
    286       END IF 
     277      IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' ) 
     278 
    287279      ! Check tracer names 
    288280      ! ------------------ 
    … …  
    309301         ctrcnl(jp_lob_dom)='Dissolved organic matter' 
    310302         IF(lwp) THEN 
    311             WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    312             WRITE (numout,*) ' =======   ============= ' 
    313             WRITE (numout,*) ' we force tracer names' 
     303            CALL ctl_warn( ' We force tracer names ' ) 
    314304            DO jl = 1, jp_lobster 
    315305               jn = jp_lob0 + jl - 1 
    … …  
    326316            ctrcun(jn) = 'mmole-N/m3' 
    327317            IF(lwp) THEN 
    328                WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    329                WRITE (numout,*) ' =======   ============= ' 
    330                WRITE (numout,*) ' we force tracer unit' 
     318               CALL ctl_warn( ' We force tracer units ' ) 
    331319               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
    332320            ENDIF 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r2082 r2104  
    6565      !!--------------------------------------------------------------------- 
    6666 
    67       IF( kt == nittrc000 ) THEN 
     67      IF( kt == nit000 ) THEN 
    6868         IF(lwp) WRITE(numout,*) 
    6969         IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r2082 r2104  
    1818   USE sms_lobster 
    1919   USE lbclnk 
     20   USE trdmod_oce 
    2021   USE trdmod_trc 
    2122   USE iom 
    … …  
    6768      !!--------------------------------------------------------------------- 
    6869 
    69       IF( kt == nittrc000 ) THEN 
     70      IF( kt == nit000 ) THEN 
    7071         IF(lwp) WRITE(numout,*) 
    7172         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90

    r2038 r2104  
    2020   USE trcexp 
    2121   USE trdmod_oce 
     22   USE trdmod_trc_oce 
    2223   USE trdmod_trc 
    2324   USE trdmld_trc 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r1953 r2104  
    8484      CALL p4z_sink ( kt, jnt )     ! vertical flux of particulate organic matter 
    8585      CALL p4z_opt  ( kt, jnt )     ! Optic: PAR in the water column 
    86       CALL p4z_lim  ( kt, jnt )     ! co-limitations by the various nutrients 
     86      CALL p4z_lim  ( kt      )     ! co-limitations by the various nutrients 
    8787      CALL p4z_prod ( kt, jnt )     ! phytoplankton growth rate over the global ocean.  
    8888      !                             ! (for each element : C, Si, Fe, Chl ) 
    89       CALL p4z_rem  ( kt, jnt )     ! remineralization terms of organic matter+scavenging of Fe 
    90       CALL p4z_mort ( kt, jnt )     ! phytoplankton mortality 
     89      CALL p4z_rem  ( kt      )     ! remineralization terms of organic matter+scavenging of Fe 
     90      CALL p4z_mort ( kt      )     ! phytoplankton mortality 
    9191      !                             ! zooplankton sources/sinks routines  
    92       CALL p4z_micro( kt, jnt )           ! microzooplankton 
     92      CALL p4z_micro( kt      )           ! microzooplankton 
    9393      CALL p4z_meso ( kt, jnt )           ! mesozooplankton 
    9494 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zche.F90

    r2082 r2104  
    249249                  &    + ( cb8 + cb9 * zsqrt + cb10 * zsal ) * zlogt + cb11 * zsqrt * ztkel             & 
    250250                  &    + LOG(  ( 1.+ zst / zcks + zft / zckf ) / ( 1.+ zst / zcks )  ) 
    251 !!gm zsal**2 to be replaced by a *... 
    252                zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal**2 
     251 
     252               zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal 
    253253               zck2    = c20 * ztr + c21 + c22 * zsal   + c23 * zsal**2 
    254254 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r2082 r2104  
    3333 
    3434   PUBLIC   p4z_flx   
     35   PUBLIC   p4z_flx_init   
    3536 
    3637   REAL(wp) :: &  ! pre-industrial atmospheric [co2] (ppm)   
    … …  
    8182 
    8283      !!--------------------------------------------------------------------- 
    83  
    84  
    85       IF( kt == nittrc000  )   CALL p4z_flx_init      ! Initialization (first time-step only) 
    8684 
    8785      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    … …  
    246244      !! 
    247245      !! ** Method  :   Read the nampisext namelist and check the parameters 
    248       !!      called at the first timestep (nittrc000) 
     246      !!      called at the first timestep (nit000) 
    249247      !! ** input   :   Namelist nampisext 
    250248      !! 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r2082 r2104  
    2323 
    2424   PUBLIC p4z_lim     
     25   PUBLIC p4z_lim_init     
    2526 
    2627   !! * Shared module variables 
    … …  
    5051CONTAINS 
    5152 
    52    SUBROUTINE p4z_lim( kt, jnt ) 
     53   SUBROUTINE p4z_lim( kt ) 
    5354      !!--------------------------------------------------------------------- 
    5455      !!                     ***  ROUTINE p4z_lim  *** 
    … …  
    5960      !! ** Method  : - ??? 
    6061      !!--------------------------------------------------------------------- 
    61       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     62      INTEGER, INTENT(in)  :: kt 
    6263      INTEGER  ::   ji, jj, jk 
    6364      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim 
    … …  
    6768 
    6869 
    69       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_lim_init      ! Initialization (first time-step only) 
    70  
    71  
    72 !  Tuning of the iron concentration to a minimum 
    73 !  level that is set to the detection limit 
    74 !  ------------------------------------- 
     70      !  Tuning of the iron concentration to a minimum 
     71      !  level that is set to the detection limit 
     72      !  ------------------------------------- 
    7573 
    7674      DO jk = 1, jpkm1 
    … …  
    8583      END DO 
    8684 
    87 !  Computation of a variable Ks for iron on diatoms 
    88 !  taking into account that increasing biomass is 
    89 !  made of generally bigger cells 
    90 !  ------------------------------------------------ 
     85      !  Computation of a variable Ks for iron on diatoms taking into account 
     86      !  that increasing biomass is made of generally bigger cells 
     87      !  ------------------------------------------------ 
    9188 
    9289      DO jk = 1, jpkm1 
    … …  
    107104      END DO 
    108105 
    109       DO jk = 1, jpkm1 
    110          DO jj = 1, jpj 
    111             DO ji = 1, jpi 
    112      
    113 !      Michaelis-Menten Limitation term for nutrients 
    114 !      Small flagellates 
    115 !      ----------------------------------------------- 
     106     !  Michaelis-Menten Limitation term for nutrients Small flagellates 
     107     !      ----------------------------------------------- 
     108      DO jk = 1, jpkm1 
     109         DO jj = 1, jpj 
     110            DO ji = 1, jpi 
    116111              zdenom = 1. / & 
    117112                  & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 
    … …  
    132127      END DO 
    133128 
    134       DO jk = 1, jpkm1 
    135          DO jj = 1, jpj 
    136             DO ji = 1, jpi 
    137  
    138 !   Michaelis-Menten Limitation term for nutrients Diatoms 
    139 !   ---------------------------------------------- 
     129      !   Michaelis-Menten Limitation term for nutrients Diatoms 
     130      !   ---------------------------------------------- 
     131      DO jk = 1, jpkm1 
     132         DO jj = 1, jpj 
     133            DO ji = 1, jpi 
    140134              zdenom = 1. / & 
    141135                  & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) 
    … …  
    181175      !! 
    182176      !! ** Method  :   Read the nampislim namelist and check the parameters 
    183       !!      called at the first timestep (nittrc000) 
     177      !!      called at the first timestep (nit000) 
    184178      !! 
    185179      !! ** input   :   Namelist nampislim 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r2038 r2104  
    2727   PRIVATE 
    2828 
    29    PUBLIC   p4z_lys    ! called in p4zprg.F90 
     29   PUBLIC   p4z_lys         ! called in trcsms_pisces.F90 
     30   PUBLIC   p4z_lys_init    ! called in trcsms_pisces.F90 
    3031 
    3132   !! * Shared module variables 
    … …  
    7273      !!--------------------------------------------------------------------- 
    7374 
    74       IF( kt == nittrc000  )   CALL p4z_lys_init      ! Initialization (first time-step only) 
    75  
    7675      zco3(:,:,:) = 0. 
    7776 
    … …  
    197196      !! 
    198197      !! ** Method  :   Read the nampiscal namelist and check the parameters 
    199       !!      called at the first timestep (nittrc000) 
     198      !!      called at the first timestep (nit000) 
    200199      !! 
    201200      !! ** input   :   Namelist nampiscal 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmeso.F90

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

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmicro.F90

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

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmort.F90

    r2038 r2104  
    2525 
    2626   PUBLIC   p4z_mort     
     27   PUBLIC   p4z_mort_init     
    2728 
    2829 
    … …  
    3536     mpratm = 0.01_wp           !: 
    3637 
    37    !! * Module variables 
    38    REAL(wp) :: zstep 
    39  
    40  
    4138 
    4239   !!* Substitution 
    … …  
    5047CONTAINS 
    5148 
    52    SUBROUTINE p4z_mort( kt, jnt ) 
     49   SUBROUTINE p4z_mort( kt ) 
    5350      !!--------------------------------------------------------------------- 
    5451      !!                     ***  ROUTINE p4z_mort  *** 
    … …  
    5956      !! ** Method  : - ??? 
    6057      !!--------------------------------------------------------------------- 
    61       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    62       !!--------------------------------------------------------------------- 
    63  
    64       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_mort_init      ! Initialization (first time-step only) 
    65  
    66       zstep = rfact2 / rday      ! Time step duration for biology 
     58      INTEGER, INTENT(in) ::   kt ! ocean time step 
     59      !!--------------------------------------------------------------------- 
    6760 
    6861      CALL p4z_nano            ! nanophytoplankton 
    … …  
    8376      INTEGER  :: ji, jj, jk 
    8477      REAL(wp) :: zcompaph 
    85       REAL(wp) :: zfactfe,zfactch,zprcaca,zfracal 
    86       REAL(wp) :: ztortp,zrespp,zmortp 
     78      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 
     79      REAL(wp) :: ztortp , zrespp , zmortp , zstep 
    8780      CHARACTER (len=25) :: charout 
    8881      !!--------------------------------------------------------------------- 
    … …  
    9992               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    10093 
    101 !     Squared mortality of Phyto similar to a sedimentation term during 
    102 !     blooms (Doney et al. 1996) 
    103 !     ----------------------------------------------------------------- 
    104                zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk)   & 
    10594# if defined key_degrad 
    106                   &        * facvol(ji,jj,jk)     & 
     95               zstep =  xstep * facvol(ji,jj,jk)   
     96# else 
     97               zstep =  xstep   
    10798# endif 
    108                   &        * zcompaph * trn(ji,jj,jk,jpphy) 
    109  
    110 !     Phytoplankton mortality. This mortality loss is slightly 
    111 !     increased when nutrients are limiting phytoplankton growth 
    112 !     as observed for instance in case of iron limitation. 
    113 !     ---------------------------------------------------------- 
    114                ztortp = mprat * zstep * trn(ji,jj,jk,jpphy)          & 
    115 # if defined key_degrad 
    116                   &          * facvol(ji,jj,jk)     & 
    117 # endif 
    118                   &   / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 
    119  
     99               !     Squared mortality of Phyto similar to a sedimentation term during 
     100               !     blooms (Doney et al. 1996) 
     101               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jpphy)  
     102 
     103               !     Phytoplankton mortality. This mortality loss is slightly 
     104               !     increased when nutrients are limiting phytoplankton growth 
     105               !     as observed for instance in case of iron limitation. 
     106               ztortp = mprat * xstep * trn(ji,jj,jk,jpphy) / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 
    120107 
    121108               zmortp = zrespp + ztortp 
    … …  
    169156      INTEGER  ::  ji, jj, jk 
    170157      REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi 
    171       REAL(wp) ::  zrespp2, ztortp2, zmortp2 
     158      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep 
    172159      CHARACTER (len=25) :: charout 
    173160  
    … …  
    175162 
    176163 
    177 !    Aggregation term for diatoms is increased in case of nutrient 
    178 !    stress as observed in reality. The stressed cells become more 
    179 !    sticky and coagulate to sink quickly out of the euphotic zone 
    180 !     ------------------------------------------------------------ 
     164      !    Aggregation term for diatoms is increased in case of nutrient 
     165      !    stress as observed in reality. The stressed cells become more 
     166      !    sticky and coagulate to sink quickly out of the euphotic zone 
     167      !     ------------------------------------------------------------ 
    181168 
    182169      DO jk = 1, jpkm1 
    … …  
    186173               zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. ) 
    187174 
    188 !    Aggregation term for diatoms is increased in case of nutrient 
    189 !    stress as observed in reality. The stressed cells become more 
    190 !    sticky and coagulate to sink quickly out of the euphotic zone 
    191 !     ------------------------------------------------------------ 
    192  
     175               !    Aggregation term for diatoms is increased in case of nutrient 
     176               !    stress as observed in reality. The stressed cells become more 
     177               !    sticky and coagulate to sink quickly out of the euphotic zone 
     178               !     ------------------------------------------------------------ 
     179 
     180# if defined key_degrad 
     181               zstep =  xstep * facvol(ji,jj,jk)   
     182# else 
     183               zstep =  xstep   
     184# endif 
     185               !  Phytoplankton respiration  
     186               !     ------------------------ 
    193187               zrespp2  = 1.e6 * zstep * (  wchl + wchld * ( 1.- xlimdia(ji,jj,jk) )  )    & 
    194 # if defined key_degrad 
    195                   &       * facvol(ji,jj,jk)       & 
    196 # endif 
    197188                  &       * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 
    198                                                                                 
    199  
    200 !     Phytoplankton mortality.  
    201 !     ------------------------ 
    202                ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)     & 
    203 # if defined key_degrad 
    204                   &        * facvol(ji,jj,jk)       & 
    205 # endif 
    206                   &      / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
    207  
    208                 zmortp2 = zrespp2 + ztortp2 
    209  
    210 !   Update the arrays tra which contains the biological sources and sinks 
    211 !   --------------------------------------------------------------------- 
     189 
     190               !     Phytoplankton mortality.  
     191               !     ------------------------ 
     192               ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi  
     193 
     194               zmortp2 = zrespp2 + ztortp2 
     195 
     196               !   Update the arrays tra which contains the biological sources and sinks 
     197               !   --------------------------------------------------------------------- 
    212198               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    213199               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2038 r2104  
    2222   PRIVATE 
    2323 
    24    PUBLIC   p4z_opt   ! called in p4zbio.F90 module 
     24   PUBLIC   p4z_opt        ! called in p4zbio.F90 module 
     25   PUBLIC   p4z_opt_init   ! called in trcsms_pisces.F90 module 
    2526 
    2627   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etot, enano, ediat   !: PAR for phyto, nano and diat  
    … …  
    4344CONTAINS 
    4445 
    45    SUBROUTINE p4z_opt(kt, jnt) 
     46   SUBROUTINE p4z_opt( kt, jnt ) 
    4647      !!--------------------------------------------------------------------- 
    4748      !!                     ***  ROUTINE p4z_opt  *** 
    … …  
    6364 
    6465 
    65       !                                        !* tabulated attenuation coef.  
    66       IF( kt * jnt == nittrc000 ) THEN 
    67          !                                ! level of light extinction 
    68          nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 
    69          IF(lwp) THEN 
    70            WRITE(numout,*) 
    71            WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
    72          ENDIF 
    73 !!         CALL trc_oce_rgb( xkrgb )     ! tabulated attenuation coefficients 
    74          CALL trc_oce_rgb_read( xkrgb )     ! tabulated attenuation coefficients 
    75          etot (:,:,:) = 0.e0 
    76          enano(:,:,:) = 0.e0 
    77          ediat(:,:,:) = 0.e0 
    78          IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 
    79       ENDIF 
    80  
    81  
    82 !     Initialisation of variables used to compute PAR 
    83 !     ----------------------------------------------- 
     66      !     Initialisation of variables used to compute PAR 
     67      !     ----------------------------------------------- 
    8468      ze1 (:,:,jpk) = 0.e0 
    8569      ze2 (:,:,jpk) = 0.e0 
    … …  
    242226   END SUBROUTINE p4z_opt 
    243227 
     228   SUBROUTINE p4z_opt_init 
     229      !!---------------------------------------------------------------------- 
     230      !!                  ***  ROUTINE p4z_opt_init  *** 
     231      !! 
     232      !! ** Purpose :   Initialization of tabulated attenuation coef 
     233      !! 
     234      !! 
     235      !!---------------------------------------------------------------------- 
     236 
     237      !                                ! level of light extinction 
     238      nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 
     239      IF(lwp) THEN 
     240        WRITE(numout,*) 
     241        WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
     242      ENDIF 
     243!!      CALL trc_oce_rgb( xkrgb )     ! tabulated attenuation coefficients 
     244      CALL trc_oce_rgb_read( xkrgb )     ! tabulated attenuation coefficients 
     245      etot (:,:,:) = 0.e0 
     246      enano(:,:,:) = 0.e0 
     247      ediat(:,:,:) = 0.e0 
     248      IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 
     249      !  
     250   END SUBROUTINE p4z_opt_init 
    244251#else 
    245252   !!---------------------------------------------------------------------- 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2082 r2104  
    2727   PRIVATE 
    2828 
    29    PUBLIC   p4z_prod    ! called in p4zbio.F90 
     29   PUBLIC   p4z_prod         ! called in p4zbio.F90 
     30   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90 
    3031 
    3132   !! * Shared module variables 
    … …  
    4748      texcret                    ,  &  !: 1 - excret  
    4849      texcret2                   ,  &  !: 1 - excret2         
    49       rpis180                    ,  &  !: rpi / 180 
    5050      tpp                              !: Total primary production 
    5151 
    … …  
    7878      REAL(wp) ::   zmxltst, zmxlday, zlim1 
    7979      REAL(wp) ::   zpislopen  , zpislope2n 
    80       REAL(wp) ::   zrum, zcodel, zargu, zvol 
     80      REAL(wp) ::   zrum, zcodel, zargu, zval, zvol 
    8181#if defined key_diatrc 
    8282      REAL(wp) ::   zrfact2 
    … …  
    9191      !!--------------------------------------------------------------------- 
    9292 
    93  
    94       IF( ( kt * jnt ) == nittrc000  )   CALL p4z_prod_init      ! Initialization (first time-step only) 
    95  
    96  
    9793      zprorca (:,:,:) = 0.0 
    9894      zprorcad(:,:,:) = 0.0 
    … …  
    125121         zrum = FLOAT( nday_year - 80 ) / 365. 
    126122      ENDIF 
    127       zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rpis180 * 23.5 )  ) 
     123      zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  ) 
    128124 
    129125      ! day length in hours 
    … …  
    131127      DO jj = 1, jpj 
    132128         DO ji = 1, jpi 
    133             zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rpis180 ) 
     129            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    134130            zargu = MAX( -1., MIN(  1., zargu ) ) 
    135             zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rpis180 / 15. ) 
     131            zval  = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     132            IF( zval < 1.e0 )   zval = 24. 
     133            zstrn(ji,jj) = 24. / zval 
    136134         END DO 
    137135      END DO 
    … …  
    227225      END DO 
    228226 
    229  
    230       WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    231       zstrn(:,:) = 24. / zstrn(:,:) 
    232227 
    233228!CDIR NOVERRCHK 
    … …  
    396391      !! 
    397392      !! ** Method  :   Read the nampisprod namelist and check the parameters 
    398       !!      called at the first timestep (nittrc000) 
     393      !!      called at the first timestep (nit000) 
    399394      !! 
    400395      !! ** input   :   Namelist nampisprod 
    … …  
    426421      nspyr  = INT( nyear_len(1) * rday / rdt ) 
    427422 
    428       rpis180   = rpi / 180. 
    429423      texcret   = 1.0 - excret 
    430424      texcret2  = 1.0 - excret2 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r2082 r2104  
    2727   PRIVATE 
    2828 
    29    PUBLIC   p4z_rem    ! called in p4zbio.F90 
     29   PUBLIC   p4z_rem         ! called in p4zbio.F90 
     30   PUBLIC   p4z_rem_init    ! called in trcsms_pisces.F90 
    3031 
    3132   !! * Shared module variables 
    … …  
    4142     &                   denitr                     !: denitrification array 
    4243 
    43    REAL(wp) ::   & 
    44      xstep            !: Time step duration for biology 
    4544 
    4645   !!* Substitution 
    … …  
    5453CONTAINS 
    5554 
    56    SUBROUTINE p4z_rem(kt, jnt) 
     55   SUBROUTINE p4z_rem( kt ) 
    5756      !!--------------------------------------------------------------------- 
    5857      !!                     ***  ROUTINE p4z_rem  *** 
    … …  
    6261      !! ** Method  : - ??? 
    6362      !!--------------------------------------------------------------------- 
    64       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     63      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6564      INTEGER  ::   ji, jj, jk 
    6665      REAL(wp) ::   zremip, zremik , zlam1b 
    6766      REAL(wp) ::   zkeq  , zfeequi, zsiremin 
    68       REAL(wp) ::   zsatur, zsatur2, znusil 
     67      REAL(wp) ::   zsatur, zsatur1, zsatur2, zsatur22, znusil 
     68      REAL(wp) ::   ztem1, ztem2 
    6969      REAL(wp) ::   zbactfer, zorem, zorem2, zofer 
    7070      REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe 
    … …  
    7272      REAL(wp) ::   zofer2, zdenom, zdenom2 
    7373#endif 
    74       REAL(wp) ::   zlamfac, zonitr 
     74      REAL(wp) ::   zlamfac, zonitr, zstep 
    7575      REAL(wp), DIMENSION(jpi,jpj)     ::   ztempbac 
    7676      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur, zolimi 
    … …  
    7878 
    7979      !!--------------------------------------------------------------------- 
    80  
    81  
    82       IF( ( kt * jnt ) == nittrc000  )  THEN 
    83          CALL p4z_rem_init                ! Initialization (first time-step only) 
    84          xstep = rfact2 / rday            ! Time step duration for the biology 
    85          nitrfac(:,:,:) = 0.0 
    86          denitr (:,:,:) = 0.0   
    87       ENDIF 
    8880 
    8981 
    … …  
    9486       ztempbac(:,:)   = 0.0 
    9587 
    96 !      Computation of the mean phytoplankton concentration as 
    97 !      a crude estimate of the bacterial biomass 
    98 !      -------------------------------------------------- 
     88      !  Computation of the mean phytoplankton concentration as 
     89      !  a crude estimate of the bacterial biomass 
     90      !   -------------------------------------------------- 
    9991 
    10092      DO jk = 1, jpkm1 
    … …  
    114106         DO jj = 1, jpj 
    115107            DO ji = 1, jpi 
    116  
    117 !    DENITRIFICATION FACTOR COMPUTED FROM O2 LEVELS 
    118 !    ---------------------------------------------- 
    119  
     108               ! denitrification factor computed from O2 levels 
    120109               nitrfac(ji,jj,jk) = MAX(  0.e0, 0.4 * ( 6.e-6  - trn(ji,jj,jk,jpoxy) )    & 
    121110                  &                                / ( oxymin + trn(ji,jj,jk,jpoxy) )  ) 
    122             END DO 
    123          END DO 
    124       END DO 
    125  
    126       nitrfac(:,:,:) = MIN( 1., nitrfac(:,:,:) ) 
    127  
    128  
    129       DO jk = 1, jpkm1 
    130          DO jj = 1, jpj 
    131             DO ji = 1, jpi 
    132  
    133 !     DOC ammonification. Depends on depth, phytoplankton biomass 
    134 !     and a limitation term which is supposed to be a parameterization 
    135 !     of the bacterial activity.  
    136 !     ---------------------------------------------------------------- 
    137                zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk)         & 
     111               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 
     112            END DO 
     113         END DO 
     114      END DO 
     115 
     116      DO jk = 1, jpkm1 
     117         DO jj = 1, jpj 
     118            DO ji = 1, jpi 
    138119# if defined key_degrad 
    139                   &            * facvol(ji,jj,jk)              & 
     120               zstep = xstep * facvol(ji,jj,jk) 
     121# else 
     122               zstep = xstep 
    140123# endif 
    141                   &            * zdepbac(ji,jj,jk) 
     124               ! DOC ammonification. Depends on depth, phytoplankton biomass 
     125               !     and a limitation term which is supposed to be a parameterization 
     126               !     of the bacterial activity.  
     127               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    142128               zremik = MAX( zremik, 5.5e-4 * xstep ) 
    143129 
    144 !     Ammonification in oxic waters with oxygen consumption 
    145 !     ----------------------------------------------------- 
     130               !     Ammonification in oxic waters with oxygen consumption 
     131               !     ----------------------------------------------------- 
    146132               zolimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,  & 
    147133                  &                    zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  )  
    148134 
    149 !     Ammonification in suboxic waters with denitrification 
    150 !     ------------------------------------------------------- 
     135               !     Ammonification in suboxic waters with denitrification 
     136               !     ------------------------------------------------------- 
    151137               denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    152138                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  ) 
    … …  
    167153         DO jj = 1, jpj 
    168154            DO ji = 1, jpi 
    169  
    170 !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
    171 !    below 2 umol/L. Inhibited at strong light  
    172 !    ---------------------------------------------------------- 
    173                zonitr  = nitrif * xstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) )     & 
    174155# if defined key_degrad 
    175                   &      * facvol(ji,jj,jk)              & 
     156               zstep = xstep * facvol(ji,jj,jk) 
     157# else 
     158               zstep = xstep 
    176159# endif 
    177                   &      * ( 1.- nitrfac(ji,jj,jk) ) 
    178  
    179 ! 
    180 !   Update of the tracers trends 
    181 !   ---------------------------- 
    182  
    183               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
    184               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
    185               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    186               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
     160               !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
     161               !    below 2 umol/L. Inhibited at strong light  
     162               !    ---------------------------------------------------------- 
     163               zonitr  = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
     164 
     165               !   Update of the tracers trends 
     166               !   ---------------------------- 
     167 
     168               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
     169               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
     170               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
     171               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
    187172 
    188173            END DO 
    … …  
    200185            DO ji = 1, jpi 
    201186 
    202 !    Bacterial uptake of iron. No iron is available in DOC. So 
    203 !    Bacteries are obliged to take up iron from the water. Some 
    204 !    studies (especially at Papa) have shown this uptake to be 
    205 !    significant 
    206 !    ---------------------------------------------------------- 
     187               !    Bacterial uptake of iron. No iron is available in DOC. So 
     188               !    Bacteries are obliged to take up iron from the water. Some 
     189               !    studies (especially at Papa) have shown this uptake to be significant 
     190               !    ---------------------------------------------------------- 
    207191               zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           & 
    208                   &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))**2           & 
     192                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
     193                  &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
    209194                  &                  / ( xkgraz2 + zdepbac(ji,jj,jk) )                    & 
    210195                  &                  * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
    … …  
    216201               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer 
    217202#endif 
    218  
    219203            END DO 
    220204         END DO 
    … …  
    230214         DO jj = 1, jpj 
    231215            DO ji = 1, jpi 
    232  
    233 !    POC disaggregation by turbulence and bacterial activity.  
    234 !    ------------------------------------------------------------- 
    235                zremip = xremip * xstep * tgfunc(ji,jj,jk)   & 
    236216# if defined key_degrad 
    237                   &            * facvol(ji,jj,jk)              & 
     217               zstep = xstep * facvol(ji,jj,jk) 
     218# else 
     219               zstep = xstep 
    238220# endif 
    239                   &            * ( 1.- 0.5 * nitrfac(ji,jj,jk) ) 
    240  
    241 !    POC disaggregation rate is reduced in anoxic zone as shown by 
    242 !    sediment traps data. In oxic area, the exponent of the martin s 
    243 !    law is around -0.87. In anoxic zone, it is around -0.35. This 
    244 !    means a disaggregation constant about 0.5 the value in oxic zones 
    245 !    ----------------------------------------------------------------- 
     221               !    POC disaggregation by turbulence and bacterial activity.  
     222               !    ------------------------------------------------------------- 
     223               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) )  
     224 
     225               !    POC disaggregation rate is reduced in anoxic zone as shown by 
     226               !    sediment traps data. In oxic area, the exponent of the martin s 
     227               !    law is around -0.87. In anoxic zone, it is around -0.35. This 
     228               !    means a disaggregation constant about 0.5 the value in oxic zones 
     229               !    ----------------------------------------------------------------- 
    246230               zorem  = zremip * trn(ji,jj,jk,jppoc) 
    247231               zofer  = zremip * trn(ji,jj,jk,jpsfe) 
    … …  
    253237#endif 
    254238 
    255 !  Update the appropriate tracers trends 
    256 !  ------------------------------------- 
     239               !  Update the appropriate tracers trends 
     240               !  ------------------------------------- 
    257241 
    258242               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
    … …  
    282266         DO jj = 1, jpj 
    283267            DO ji = 1, jpi 
    284  
    285 !     Remineralization rate of BSi depedant on T and saturation 
    286 !     --------------------------------------------------------- 
    287                zsatur  = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
    288                zsatur  = MAX( rtrn, zsatur ) 
    289                zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 
    290                znusil  = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9 
    291 #    if defined key_degrad 
    292                zsiremin = xsirem * xstep * znusil * facvol(ji,jj,jk) 
     268# if defined key_degrad 
     269               zstep = xstep * facvol(ji,jj,jk) 
    293270# else 
    294                zsiremin = xsirem * xstep * znusil 
    295 #    endif 
    296                zosil = zsiremin * trn(ji,jj,jk,jpdsi) 
     271               zstep = xstep 
     272# endif 
     273               !     Remineralization rate of BSi depedant on T and saturation 
     274               !     --------------------------------------------------------- 
     275               zsatur   = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
     276               zsatur   = MAX( rtrn, zsatur ) 
     277               ztem1    = ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) 
     278               ztem2    = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.) 
     279               zsatur1  = zsatur * ztem1 
     280               zsatur2  = zsatur * ztem2 * ztem2 * ztem2 * ztem2 
     281               zsatur22 = zsatur2 * zsatur2 
     282               znusil   = 0.225  * zsatur1 + 0.775 * zsatur22 * zsatur22 * zsatur22 * zsatur22 * zsatur2 
     283               zsiremin = xsirem * zstep * znusil 
     284               zosil    = zsiremin * trn(ji,jj,jk,jpdsi) 
    297285 
    298286               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 
    299287               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
    300  
    301288               ! 
    302289            END DO 
    … …  
    317304!CDIR NOVERRCHK 
    318305            DO ji = 1, jpi 
    319 ! 
    320 !      Compute de different ratios for scavenging of iron 
    321 !      -------------------------------------------------- 
     306# if defined key_degrad 
     307               zstep = xstep * facvol(ji,jj,jk) 
     308# else 
     309               zstep = xstep 
     310# endif 
     311               !  Compute de different ratios for scavenging of iron 
     312               !  -------------------------------------------------- 
    322313 
    323314#if  defined key_kriest 
    324                 zdenom1 = trn(ji,jj,jk,jppoc) / & 
     315               zdenom1 = trn(ji,jj,jk,jppoc) / & 
    325316           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    326317#else 
    327                 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
     318               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
    328319           &            + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    329320 
    330                 zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
    331                 zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
    332 #endif 
    333  
    334  
    335 !     scavenging rate of iron. this scavenging rate depends on the 
    336 !     load in particles on which they are adsorbed. The 
    337 !     parameterization has been taken from studies on Th 
    338 !     ------------------------------------------------------------ 
     321               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
     322               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
     323#endif 
     324               !  scavenging rate of iron. this scavenging rate depends on the load in particles 
     325               !  on which they are adsorbed. The  parameterization has been taken from studies on Th 
     326               !     ------------------------------------------------------------ 
    339327               zkeq = fekeq(ji,jj,jk) 
    340328               zfeequi = ( -( 1. + zfesatur(ji,jj,jk) * zkeq - zkeq * trn(ji,jj,jk,jpfer) )               & 
    … …  
    349337                  &                      + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpdsi)  ) * 1.e6 
    350338#endif 
    351  
    352 # if defined key_degrad 
    353                zscave = zfeequi * zlam1b * xstep  * facvol(ji,jj,jk) 
    354 # else 
    355                zscave = zfeequi * zlam1b * xstep 
    356 # endif 
    357  
    358 !  Increased scavenging for very high iron concentrations 
    359 !  found near the coasts due to increased lithogenic particles 
    360 !  and let s say it unknown processes (precipitation, ...) 
    361 !  ----------------------------------------------------------- 
     339               zscave = zfeequi * zlam1b * zstep 
     340 
     341               !  Increased scavenging for very high iron concentrations 
     342               !  found near the coasts due to increased lithogenic particles 
     343               !  and let s say it unknown processes (precipitation, ...) 
     344               !  ----------------------------------------------------------- 
    362345               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    363346               zlamfac = MIN( 1.  , zlamfac ) 
    … …  
    374357#endif 
    375358 
    376 # if defined key_degrad 
    377                zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk) 
    378 # else 
    379                zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    380 # endif 
     359               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    381360 
    382361               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 
    … …  
    400379       ENDIF 
    401380 
    402 !     Update the arrays TRA which contain the biological sources and sinks 
    403 !     -------------------------------------------------------------------- 
     381       !     Update the arrays TRA which contain the biological sources and sinks 
     382       !     -------------------------------------------------------------------- 
    404383 
    405384      DO jk = 1, jpkm1 
    … …  
    452431      ENDIF 
    453432 
     433      nitrfac(:,:,:) = 0.0 
     434      denitr (:,:,:) = 0.0   
     435 
    454436   END SUBROUTINE p4z_rem_init 
    455  
    456  
    457  
    458  
    459437 
    460438#else 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r2082 r2104  
    3434 
    3535   PUBLIC   p4z_sed    
     36   PUBLIC   p4z_sed_init    
    3637 
    3738   !! * Shared module variables 
    … …  
    9091#endif 
    9192      REAL(wp) ::   zconctmp , zdenitot  , znitrpottot 
    92       REAL(wp) ::   zlim, zconctmp2, zstep, zfact 
     93      REAL(wp) ::   zlim, zconctmp2, zfact, zrivalk 
    9394      REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep 
    9495      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep 
    … …  
    102103      !!--------------------------------------------------------------------- 
    103104 
    104  
    105       IF( ( kt * jnt ) == nittrc000   )   CALL p4z_sed_init      ! Initialization (first time-step only) 
    106       IF( (jnt == 1) .and. ( ln_dustfer ) )  CALL p4z_sbc( kt ) 
    107  
    108       zstep = rfact2 / rday      ! Time step duration for the biology 
     105      IF( ( jnt == 1 ) .AND. ( ln_dustfer ) )  CALL p4z_sbc( kt ) 
    109106 
    110107      zirondep(:,:,:) = 0.e0          ! Initialisation of variables used to compute deposition 
    … …  
    192189         DO ji = 1, jpi 
    193190            ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    194             zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt)   & 
    195191# if ! defined key_kriest 
    196      &             * wscal (ji,jj,ikt) 
     192            zconctmp = trn(ji,jj,ikt,jpdsi) * xstep / fse3t(ji,jj,ikt) * wscal (ji,jj,ikt)  
    197193# else 
    198      &            * wsbio4(ji,jj,ikt) 
     194            zconctmp = trn(ji,jj,ikt,jpdsi) * xstep / fse3t(ji,jj,ikt) * wsbio4(ji,jj,ikt) 
    199195# endif 
    200196            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp 
    201197 
    202198#if ! defined key_sed 
    203             trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp   & 
    204             &      * ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) 
     199            zrivalk = ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) 
     200            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp  * zrivalk  
    205201#endif 
    206202         END DO 
    … …  
    210206         DO ji = 1, jpi 
    211207            ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    212             zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt) 
     208            zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * xstep / fse3t(ji,jj,ikt) 
    213209            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp 
    214  
    215210#if ! defined key_sed 
    216             trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp   & 
    217                &   * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) * 2.e0 
    218             trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp   & 
    219                &   * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) 
     211            zrivalk = ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) 
     212            trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp * zrivalk * 2.0 
     213            trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp * zrivalk  
    220214#endif 
    221215         END DO 
    … …  
    225219         DO ji = 1, jpi 
    226220            ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    227             zfact = zstep / fse3t(ji,jj,ikt) 
     221            zfact = xstep / fse3t(ji,jj,ikt) 
    228222# if ! defined key_kriest 
    229223            zconctmp  = trn(ji,jj,ikt,jpgoc) 
    … …  
    242236            zconctmp  = trn(ji,jj,ikt,jpnum) 
    243237            zconctmp2 = trn(ji,jj,ikt,jppoc) 
    244             trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum)   & 
    245             &      - zconctmp  * wsbio4(ji,jj,ikt) * zfact 
    246             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc)   & 
    247             &      - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 
     238            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - zconctmp  * wsbio4(ji,jj,ikt) * zfact  
     239            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact  
    248240#if ! defined key_sed 
    249             trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    & 
    250             &      + ( zconctmp2 * wsbio3(ji,jj,ikt) )   & 
    251             &      * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) 
     241            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + ( zconctmp2 * wsbio3(ji,jj,ikt) )   
     242            &                     * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) 
    252243#endif 
    253             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe)   & 
    254             &      - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 
    255  
     244            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact  
    256245# endif 
    257246         END DO 
    … …  
    383372      imois2 = nmonth 
    384373 
    385       ! 1. first call kt=nittrc000 
     374      ! 1. first call kt=nit000 
    386375      ! ----------------------- 
    387376 
    388       IF( kt == nittrc000 ) THEN 
     377      IF( kt == nit000 ) THEN 
    389378         ! initializations 
    390379         nflx1  = 0 
    … …  
    402391      ! ---------------- 
    403392 
    404       IF( kt == nittrc000 .OR. imois /= nflx1 ) THEN 
     393      IF( kt == nit000 .OR. imois /= nflx1 ) THEN 
    405394 
    406395         ! Calendar computation 
    … …  
    445434      !! 
    446435      !! ** Method  :   Read the files and compute the budget 
    447       !!      called at the first timestep (nittrc000) 
     436      !!      called at the first timestep (nit000) 
    448437      !! 
    449438      !! ** input   :   external netcdf files 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r2038 r2104  
    1919   PRIVATE 
    2020 
    21    PUBLIC   p4z_sink    ! called in p4zbio.F90 
     21   PUBLIC   p4z_sink         ! called in p4zbio.F90 
     22   PUBLIC   p4z_sink_init    ! called in trcsms_pisces.F90 
    2223 
    2324   !! * Shared module variables 
    … …  
    3132     sinkcal, sinksil,    &    !: CaCO3 and BSi sinking fluxes 
    3233     sinkfer                   !: Small BFe sinking flux 
    33  
    34    REAL(wp) ::   & 
    35      xstep , xstep2            !: Time step duration for biology 
    3634 
    3735   INTEGER  :: & 
    … …  
    106104      !!--------------------------------------------------------------------- 
    107105 
    108       IF( ( kt * jnt ) == nittrc000  )  THEN  
    109           CALL p4z_sink_init   ! Initialization (first time-step only) 
    110           xstep  = rfact2 / rday      ! Time step duration for biology 
    111           xstep2 = rfact2 /  2. 
    112       ENDIF 
    113  
    114 !     Initialisation of variables used to compute Sinking Speed 
    115 !     --------------------------------------------------------- 
     106      !     Initialisation of variables used to compute Sinking Speed 
     107      !     --------------------------------------------------------- 
    116108 
    117109       znum3d(:,:,:) = 0.e0 
    … …  
    120112       zval3 = 1. + xkr_eta 
    121113 
    122 !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
    123 !     ----------------------------------------------------------------- 
     114     !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
     115     !     ----------------------------------------------------------------- 
    124116 
    125117      DO jk = 1, jpkm1 
    … …  
    128120               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 
    129121                  znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp 
    130 ! -------------- To avoid sinking speed over 50 m/day ------- 
     122                  ! -------------- To avoid sinking speed over 50 m/day ------- 
    131123                  znum  = MIN( xnumm(jk), znum ) 
    132124                  znum  = MAX( 1.1      , znum ) 
    133125                  znum3d(ji,jj,jk) = znum 
    134 !------------------------------------------------------------ 
     126                  !------------------------------------------------------------ 
    135127                  zeps  = ( zval1 * znum - 1. )/ ( znum - 1. ) 
    136128                  zfm   = xkr_frac**( 1. - zeps ) 
    … …  
    150142      wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. ) 
    151143 
    152  
    153 !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    154 !   ----------------------------------------- 
     144      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
     145      !   ----------------------------------------- 
    155146 
    156147      sinking (:,:,:) = 0.e0 
    … …  
    160151      sinksil (:,:,:) = 0.e0 
    161152 
    162 !   Compute the sedimentation term using p4zsink2 for all 
    163 !   the sinking particles 
    164 !   ----------------------------------------------------- 
     153     !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
     154     !   ----------------------------------------------------- 
    165155 
    166156      CALL p4z_sink2( wsbio3, sinking , jppoc ) 
    … …  
    170160      CALL p4z_sink2( wscal , sinkcal , jpcal ) 
    171161 
    172 !  Exchange between organic matter compartments due to 
    173 !  coagulation/disaggregation 
    174 !  --------------------------------------------------- 
     162     !  Exchange between organic matter compartments due to coagulation/disaggregation 
     163     !  --------------------------------------------------- 
    175164 
    176165      zval1 = 1. + xkr_zeta 
    … …  
    185174 
    186175                  znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp 
    187 ! -------------- To avoid sinking speed over 50 m/day ------- 
     176                  !-------------- To avoid sinking speed over 50 m/day ------- 
    188177                  znum  = min(xnumm(jk),znum) 
    189178                  znum  = MAX( 1.1,znum) 
    190 !------------------------------------------------------------ 
     179                  !------------------------------------------------------------ 
    191180                  zeps  = ( zval1 * znum - 1.) / ( znum - 1.) 
    192181                  zdiv  = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 ) 
    … …  
    199188                  zsm   = xkr_frac**xkr_eta 
    200189 
    201 !    Part I : Coagulation dependant on turbulence 
    202 !    ---------------------------------------------- 
     190                  !    Part I : Coagulation dependant on turbulence 
     191                  !    ---------------------------------------------- 
    203192 
    204193                  zagg1 = ( 0.163 * trn(ji,jj,jk,jpnum)**2               & 
    … …  
    232221                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
    233222 
    234 !    Aggregation of small into large particles 
    235 !    Part II : Differential settling 
    236 !    ---------------------------------------------- 
     223                 !    Aggregation of small into large particles 
     224                 !    Part II : Differential settling 
     225                 !    ---------------------------------------------- 
    237226 
    238227                  zagg4 = (  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
    … …  
    261250                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
    262251 
    263 !     Aggregation of DOC to small particles 
    264 !     -------------------------------------- 
     252                  !     Aggregation of DOC to small particles 
     253                  !     -------------------------------------- 
    265254 
    266255                  zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               & 
    … …  
    473462      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    474463      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    475       REAL(wp) ::   zfact, zwsmax 
     464      REAL(wp) ::   zfact, zwsmax, zstep 
    476465#if defined key_diatrc 
    477466      REAL(wp) ::   zrfact2 
    … …  
    481470      !!--------------------------------------------------------------------- 
    482471 
    483       IF( ( kt * jnt ) == nittrc000  )  THEN 
    484           xstep  = rfact2 / rday      ! Timestep duration for biology 
    485           xstep2 = rfact2 /  2. 
    486       ENDIF 
    487  
    488 !    Sinking speeds of detritus is increased with depth as shown 
    489 !    by data and from the coagulation theory 
    490 !    ----------------------------------------------------------- 
     472      !    Sinking speeds of detritus is increased with depth as shown 
     473      !    by data and from the coagulation theory 
     474      !    ----------------------------------------------------------- 
    491475      DO jk = 1, jpkm1 
    492476         DO jj = 1, jpj 
    493477            DO ji=1,jpi 
    494                zfact = MAX( 0., fsdepw(ji,jj,jk+1)-hmld(ji,jj) ) / 4000. 
     478               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000. 
    495479               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    496480            END DO 
    … …  
    498482      END DO 
    499483 
    500 !      LIMIT THE VALUES OF THE SINKING SPEEDS  
    501 !      TO AVOID NUMERICAL INSTABILITIES 
    502  
     484      ! limit the values of the sinking speeds to avoid numerical instabilities   
    503485      wsbio3(:,:,:) = wsbio 
    504 ! 
    505 ! OA Below, this is garbage. the ideal would be to find a time-splitting 
    506 ! OA algorithm that does not increase the computing cost by too much 
    507 ! OA In ROMS, I have included a time-splitting procedure. But it is  
    508 ! OA too expensive as the loop is computed globally. Thus, a small e3t 
    509 ! OA at one place determines the number of subtimesteps globally 
    510 ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !! 
     486      ! 
     487      ! OA Below, this is garbage. the ideal would be to find a time-splitting  
     488      ! OA algorithm that does not increase the computing cost by too much 
     489      ! OA In ROMS, I have included a time-splitting procedure. But it is  
     490      ! OA too expensive as the loop is computed globally. Thus, a small e3t 
     491      ! OA at one place determines the number of subtimesteps globally 
     492      ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !! 
    511493 
    512494      DO jk = 1,jpkm1 
    … …  
    522504      wscal(:,:,:) = wsbio4(:,:,:) 
    523505 
    524 !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    525 !   ----------------------------------------- 
     506      !  Initializa to zero all the sinking arrays  
     507      !   ----------------------------------------- 
    526508 
    527509      sinking (:,:,:) = 0.e0 
    … …  
    532514      sinkfer2(:,:,:) = 0.e0 
    533515 
    534 !   Compute the sedimentation term using p4zsink2 for all 
    535 !   the sinking particles 
    536 !   ----------------------------------------------------- 
     516      !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
     517      !   ----------------------------------------------------- 
    537518 
    538519      CALL p4z_sink2( wsbio3, sinking , jppoc ) 
    … …  
    543524      CALL p4z_sink2( wscal , sinkcal , jpcal ) 
    544525 
    545 !  Exchange between organic matter compartments due to 
    546 !  coagulation/disaggregation 
    547 !  --------------------------------------------------- 
     526      !  Exchange between organic matter compartments due to coagulation/disaggregation 
     527      !  --------------------------------------------------- 
    548528 
    549529      DO jk = 1, jpkm1 
    550530         DO jj = 1, jpj 
    551531            DO ji = 1, jpi 
    552                zfact = xstep * xdiss(ji,jj,jk) 
     532# if defined key_degrad 
     533               zstep = xstep * facvol(ji,jj,jk) 
     534# else 
     535               zstep = xstep  
     536# endif 
     537               zfact = zstep * xdiss(ji,jj,jk) 
    553538               !  Part I : Coagulation dependent on turbulence 
    554 # if defined key_degrad 
    555                zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
    556                zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
    557 # else 
    558539               zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    559540               zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    560 # endif 
    561541 
    562542               ! Part II : Differential settling 
    563543 
    564544               !  Aggregation of small into large particles 
    565 # if defined key_degrad 
    566                zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
    567                zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
    568 # else 
    569                zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    570                zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    571 # endif 
     545               zagg3 = 0.66 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     546               zagg4 = 0.e0 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     547 
    572548               zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    573549               zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    574550 
    575551               ! Aggregation of DOC to small particles 
    576 #if defined key_degrad 
    577                zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )       & 
    578                   &      * facvol(ji,jj,jk)  * zfact * trn(ji,jj,jk,jpdoc) 
    579                zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc)   & 
    580                   &      * facvol(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
    581 #else 
    582                zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )    & 
    583                   &      *  zfact * trn(ji,jj,jk,jpdoc) 
     552               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) *  zfact * trn(ji,jj,jk,jpdoc)  
    584553               zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
    585 #endif 
     554 
    586555               !  Update the trends 
    587556               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 
    … …  
    623592   END SUBROUTINE p4z_sink 
    624593 
     594   SUBROUTINE p4z_sink_init 
     595      !!---------------------------------------------------------------------- 
     596      !!                  ***  ROUTINE p4z_sink_init  *** 
     597      !!---------------------------------------------------------------------- 
     598   END SUBROUTINE p4z_sink_init 
     599 
    625600#endif 
    626601 
    … …  
    641616      !! 
    642617      INTEGER  ::   ji, jj, jk, jn 
    643       REAL(wp) ::   zigma,zew,zign, zflx 
     618      REAL(wp) ::   zigma,zew,zign, zflx, zstep 
    644619      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztraz, zakz 
    645620      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwsink2 
    646621      !!--------------------------------------------------------------------- 
    647622 
     623 
     624      zstep = rfact2 / 2. 
    648625 
    649626      ztraz(:,:,:) = 0.e0 
    … …  
    693670            DO jj = 1, jpj       
    694671               DO ji = 1, jpi     
    695                   zigma = zwsink2(ji,jj,jk+1) * xstep2 / fse3w(ji,jj,jk+1) 
     672                  zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1) 
    696673                  zew   = zwsink2(ji,jj,jk+1) 
    697                   psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * xstep2 
     674                  psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 
    698675               END DO 
    699676            END DO 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r2038 r2104  
    2323   REAL(wp) ::   rfact , rfactr    !: ??? 
    2424   REAL(wp) ::   rfact2, rfact2r   !: ??? 
     25   REAL(wp) ::   xstep             !: Time step duration for biology 
    2526 
    2627   !!*  Biological parameters  

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r2038 r2104  
    145145   ! ----------------------- 
    146146#if  defined key_kriest 
    147       IF( jp_pisces /= 23) THEN 
     147      IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' ) 
    148148#else 
    149       IF( jp_pisces /= 24) THEN 
     149      IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' ) 
    150150#endif 
    151           IF (lwp) THEN 
    152               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    153               WRITE (numout,*) ' =======   ============= ' 
    154               WRITE (numout,*)                               & 
    155               &   ' STOP, change jp_pisces',               & 
    156               &   ' in par_pisces.F90' 
    157           END IF 
    158           STOP 'TRC_CTL' 
    159       END IF 
    160151 
    161152   END SUBROUTINE trc_ctl_pisces 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    r2038 r2104  
    263263#if defined key_dtatrc 
    264264      ! Restore close seas values to initial data 
    265       CALL trc_dta( nittrc000 )  
     265      CALL trc_dta( nit000 )  
    266266      DO jn = 1, jptra 
    267267         IF( lutini(jn) ) THEN 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r2038 r2104  
    2222   USE p4zche          !  
    2323   USE p4zbio          !  
     24   USE p4zsink         !  
     25   USE p4zopt          !  
     26   USE p4zlim          !  
     27   USE p4zprod         ! 
     28   USE p4zmort         ! 
     29   USE p4zmicro        !  
     30   USE p4zmeso         !  
     31   USE p4zrem          !  
    2432   USE p4zsed          !  
    2533   USE p4zlys          !  
    … …  
    6169      !!--------------------------------------------------------------------- 
    6270 
    63       IF( kt == nittrc000  .AND. .NOT. ln_rsttr )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
     71      IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
    6472 
    6573      IF( ndayflxtr /= nday ) THEN      ! New days 
    … …  
    121129      REAL(wp) ::  ztmas, ztmas1 
    122130 
    123       ! Initialization of chemical variables of the carbon cycle 
    124       ! -------------------------------------------------------- 
    125       DO jk = 1, jpk 
    126          DO jj = 1, jpj 
    127             DO ji = 1, jpi 
    128                ztmas   = tmask(ji,jj,jk) 
    129                ztmas1  = 1. - tmask(ji,jj,jk) 
    130                zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    131                zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    132                zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    133                hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     131      IF( .NOT. ln_rsttr ) THEN 
     132         ! Initialization of chemical variables of the carbon cycle 
     133         ! -------------------------------------------------------- 
     134         DO jk = 1, jpk 
     135            DO jj = 1, jpj 
     136               DO ji = 1, jpi 
     137                  ztmas   = tmask(ji,jj,jk) 
     138                  ztmas1  = 1. - tmask(ji,jj,jk) 
     139                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     140                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
     141                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
     142                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     143               END DO 
    134144            END DO 
    135145         END DO 
    136       END DO 
     146         ! 
     147      END IF 
     148 
     149      ! Time step duration for biology 
     150      xstep = rfact2 / rday 
     151 
     152      CALL p4z_sink_init      ! vertical flux of particulate organic matter 
     153      CALL p4z_opt_init       ! Optic: PAR in the water column 
     154      CALL p4z_lim_init       ! co-limitations by the various nutrients 
     155      CALL p4z_prod_init      ! phytoplankton growth rate over the global ocean.  
     156      CALL p4z_rem_init       ! remineralisation 
     157      CALL p4z_mort_init      ! phytoplankton mortality 
     158      CALL p4z_micro_init     ! microzooplankton 
     159      CALL p4z_meso_init      ! mesozooplankton 
     160      CALL p4z_sed_init       ! sedimentation 
     161      CALL p4z_lys_init       ! calcite saturation 
     162      CALL p4z_flx_init       ! gas exchange 
    137163 
    138164   END SUBROUTINE trc_sms_pisces_init 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/sed.F90

    r2082 r2104  
    3838   USE trc, ONLY :  & 
    3939      trn        , & !: tracer  
    40       nittrc000  , & !: 1st time step of tracer model 
    4140      nwritetrc      !: outputs frequency of tracer model 
    4241 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/sedini.F90

    r1581 r2104  
    443443 
    444444      dtsed = rdt 
     445      nitsed000 = nit000 
     446      nitsedend = nitend 
    445447#if ! defined key_sed_off 
    446       nitsed000 = nittrc000 
    447       nitsedend = nitend 
    448448      nwrised   = nwritetrc 
    449449#else 
    450       nitsed000 = nit000 
    451       nitsedend = nitend 
    452450      nwrised   = nwrite 
    453451#endif 

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

    r2085 r2104  
    66   !! History :   1.0  !  2004-03  (C. Ethe)  original code 
    77   !!             2.0  !  2007-12 (C. Ethe, G. Madec)  rewritting 
    8    !!---------------------------------------------------------------------- 
    9    !! NEMO/TOP 2.0,  LOCEAN-IPSL (2007) 
    10    !! $Id$ 
    11    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    128   !!---------------------------------------------------------------------- 
    139#if defined key_top 
    … …  
    254250#endif 
    255251 
     252   !!---------------------------------------------------------------------- 
     253   !! NEMO/TOP 3.3,  LOCEAN-IPSL (2010) 
     254   !! $Id$ 
     255   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    256256   !!====================================================================== 
    257257END MODULE oce_trc 

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

    r2052 r2104  
    99   !!             1.0  !  2004-03  (C. Ethe) Free form and module 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    11    !!---------------------------------------------------------------------- 
    12    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    13    !! $Id$  
    14    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1511   !!---------------------------------------------------------------------- 
    1612   USE par_kind          ! kind parameters 
    … …  
    4137 
    4238   REAL(wp), PUBLIC  :: rtrn  = 1.e-15      !: truncation value      
     39 
     40   !!---------------------------------------------------------------------- 
     41   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     42   !! $Id$  
     43   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4344   !!====================================================================== 
    4445END MODULE par_trc 

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

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

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/top_substitute.h90

    r2052 r2104  
    22   !!                    ***  top_substitute.h90   *** 
    33   !!---------------------------------------------------------------------- 
    4    !! ** purpose : Statement function file: to be include in all routines 
    5    !!              concerning passive tracer model  
     4   !! ** purpose : Statement function file: to be include in all passive tracer modules 
    65   !!---------------------------------------------------------------------- 
    76   !! History :   1.0  !  2004-03 (C. Ethe) Original code 
    87   !!             2.0  !  2007-12 (C. Ethe, G. Madec) new architecture 
    98   !!---------------------------------------------------------------------- 
    10    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     9#  include "domzgr_substitute.h90" 
     10#  include "ldfeiv_substitute.h90" 
     11#  include "ldftra_substitute.h90" 
     12#  include "vectopt_loop_substitute.h90" 
     13   !!---------------------------------------------------------------------- 
     14   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
    1115   !! $Id$  
    1216   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    1317   !!---------------------------------------------------------------------- 
    14 ! ======================================================== 
    15 #include "domzgr_substitute.h90" 
    16 #include "ldfeiv_substitute.h90" 
    17 #include "ldftra_substitute.h90" 
    18 #include "vectopt_loop_substitute.h90" 

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

    r2082 r2104  
    44   !! Passive tracers   :  module for tracers defined 
    55   !!====================================================================== 
    6    !! History :    -   !  1996-01  (M. Levy)  Original code 
     6   !! History :   OPA  !  1996-01  (M. Levy)  Original code 
    77   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model 
    88   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD 
    9    !!             1.0  !  2004-03  (C. Ethe)  Free form and module 
    10    !!---------------------------------------------------------------------- 
    11    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    12    !! $Id$  
    13    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     9   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module 
    1410   !!---------------------------------------------------------------------- 
    1511#if defined key_top 
    … …  
    3834   !! passive tracers fields (before,now,after) 
    3935   !! -------------------------------------------------- 
    40    REAL(wp), PUBLIC ::   trai                         !: initial total tracer 
    41    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol  !: masked grid volume  
    42    REAL(wp), PUBLIC ::   areatot                      !: total volume  
     36   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol   !: volume correction -degrad option-  
     37   REAL(wp), PUBLIC ::   trai                          !: initial total tracer 
     38   REAL(wp), PUBLIC ::   areatot                       !: total volume  
    4339 
    4440   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trn   !: traceur concentration for actual time step 
    … …  
    4642   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trb   !: traceur concentration for before time step 
    4743 
    48 #if ! defined key_zco 
    4944   !! interpolated gradient 
    5045   !!--------------------------------------------------   
    5146   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtru   !: horizontal gradient at u-points at bottom ocean level 
    5247   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtrv   !: horizontal gradient at v-points at bottom ocean level 
    53 #endif 
    5448    
    5549   !! passive tracers restart (input and output) 
    5650   !! ------------------------------------------   
    57    LOGICAL , PUBLIC  ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist) 
    58    LOGICAL , PUBLIC  ::  lrst_trc      !: logical to control the trc restart write 
    59    INTEGER , PUBLIC  ::  nutwrs        !: output FILE for passive tracers restart 
    60    INTEGER , PUBLIC  ::  nutrst        !: logical unit for restart FILE for passive tracers 
    61    INTEGER , PUBLIC  ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr. 
    62    CHARACTER(len=50) ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
    63    CHARACTER(len=50) ::  cn_trcrst_out !: suffix of pass. tracer restart name (output) 
     51   LOGICAL , PUBLIC          ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist) 
     52   LOGICAL , PUBLIC          ::  lrst_trc      !: logical to control the trc restart write 
     53   INTEGER , PUBLIC          ::  nn_dttrc      !: frequency of step on passive tracers 
     54   INTEGER , PUBLIC          ::  nutwrs        !: output FILE for passive tracers restart 
     55   INTEGER , PUBLIC          ::  nutrst        !: logical unit for restart FILE for passive tracers 
     56   INTEGER , PUBLIC          ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr. 
     57   CHARACTER(len=50), PUBLIC ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
     58   CHARACTER(len=50), PUBLIC ::  cn_trcrst_out !: suffix of pass. tracer restart name (output) 
    6459    
    6560   !! information for outputs 
    … …  
    7065   !! additional 2D/3D outputs namelist 
    7166   !! -------------------------------------------------- 
    72    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d   !: 2d output field name 
    73    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u   !: 2d output field unit    
    74    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d   !: 3d output field name 
    75    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u   !: 3d output field unit 
    76    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l   !: 2d output field long name 
    77    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l   !: 3d output field long name 
     67   INTEGER , PUBLIC                               ::   nwritedia   !: frequency of additional arrays outputs(namelist) 
     68   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d      !: 2d output field name 
     69   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u      !: 2d output field unit    
     70   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d      !: 3d output field name 
     71   CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u      !: 3d output field unit 
     72   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l      !: 2d output field long name 
     73   CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l      !: 3d output field long name 
    7874 
    79    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d   !:  additional 2d outputs   
    80    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d   !:  additional 3d outputs   
     75   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d    !:  additional 2d outputs   
     76   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d    !:  additional 3d outputs   
    8177    
    82    INTEGER , PUBLIC ::   nwritedia     !: frequency of additional arrays outputs(namelist) 
    8378# endif 
    8479 
    8580#if defined key_diabio || defined key_trdmld_trc 
    86    CHARACTER(len=8),  DIMENSION(jpdiabio) ::   ctrbio   !: biological trends name      (NAMELIST) 
    87    CHARACTER(len=20), DIMENSION(jpdiabio) ::   ctrbiu   !: biological trends unit      (NAMELIST) 
    88    CHARACTER(len=80), DIMENSION(jpdiabio) ::   ctrbil   !: biological trends long name (NAMELIST) 
    89    INTEGER ::   nwritebio   !: time step frequency for biological outputs (NAMELIST) 
     81   !                                                              !!*  namtop_XXX namelist * 
     82   INTEGER , PUBLIC                               ::   nwritebio   !: time step frequency for biological outputs  
     83   CHARACTER(len=8 ), PUBLIC, DIMENSION(jpdiabio) ::   ctrbio      !: biological trends name       
     84   CHARACTER(len=20), PUBLIC, DIMENSION(jpdiabio) ::   ctrbiu      !: biological trends unit    
     85   CHARACTER(len=80), PUBLIC, DIMENSION(jpdiabio) ::   ctrbil      !: biological trends long name 
    9086#endif 
    9187# if defined key_diabio 
    9288   !! Biological trends 
    9389   !! ----------------- 
    94    REAL(wp), DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends 
     90   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends 
    9591# endif 
    9692 
    … …  
    108104#endif 
    109105 
     106   !!---------------------------------------------------------------------- 
     107   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     108   !! $Id$  
     109   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    110110   !!====================================================================== 
    111111END MODULE trc 

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

    r2038 r2104  
    44   !! TOP :   Output of passive tracers 
    55   !!====================================================================== 
    6    !! History :    -   !  1995-01 (M. Levy)  Original code 
     6   !! History :   OPA  !  1995-01 (M. Levy)  Original code 
    77   !!              -   !  1998-01 (C. Levy) NETCDF format using ioipsl interface 
    88   !!              -   !  1999-01 (M.A. Foujols) adapted for passive tracer 
    99   !!              -   !  1999-09 (M.A. Foujols) split into three parts 
    10    !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     10   !!   NEMO      1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
    1111   !!                  !  2008-05 (C. Ethe re-organization) 
    1212   !!---------------------------------------------------------------------- 
    … …  
    3232   PRIVATE 
    3333 
    34    PUBLIC trc_dia       
     34   PUBLIC   trc_dia   ! called by XXX module  
    3535 
    3636   INTEGER  ::   nit5      !: id for tracer output file 
    … …  
    5656#  include "top_substitute.h90" 
    5757   !!---------------------------------------------------------------------- 
    58    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     58   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
    5959   !! $Id$  
    6060   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6161   !!---------------------------------------------------------------------- 
    62  
    6362CONTAINS 
    6463 
    … …  
    7271      INTEGER               :: kindic 
    7372      !!--------------------------------------------------------------------- 
    74        
     73      ! 
    7574      CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration 
    7675      CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays 
    7776      CALL trcdib_wr( kt, kindic )      ! outputs for biological trends 
    78  
    7977      ! 
    8078   END SUBROUTINE trc_dia 
     79 
    8180 
    8281   SUBROUTINE trcdit_wr( kt, kindic ) 
    … …  
    108107      CHARACTER (len=80) :: cltral 
    109108      REAL(wp) :: zsto, zout, zdt 
    110       INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod 
     109      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    111110      !!---------------------------------------------------------------------- 
    112111 
    … …  
    138137 
    139138      ! define time axis 
    140       itmod = kt - nittrc000 + 1 
     139      itmod = kt - nit000 + 1 
    141140      it    = kt 
     141      iiter = ( nit000 - 1 ) / nn_dttrc 
    142142 
    143143      ! Define NETCDF files and fields at beginning of first time step 
    … …  
    146146      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 
    147147       
    148       IF( kt == nittrc000 ) THEN 
     148      IF( kt == nit000 ) THEN 
    149149 
    150150         ! Compute julian date from starting date of the run 
    … …  
    152152         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    153153         IF(lwp)WRITE(numout,*)' '   
    154          IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         & 
     154         IF(lwp)WRITE(numout,*)' Date 0 used :', nit000                         & 
    155155            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   & 
    156156            &                 ,'Julian day : ', zjulian   
    … …  
    176176         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     & 
    177177            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
    178             &          nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
     178            &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
    179179 
    180180         ! Vertical grid for tracer : gdept 
    … …  
    250250      CHARACTER (len=80) ::   cltral 
    251251      INTEGER  ::   jl 
    252       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
     252      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    253253      REAL(wp) ::   zsto, zout, zdt 
    254254      !!---------------------------------------------------------------------- 
    … …  
    281281 
    282282      ! define time axis 
    283       itmod = kt - nittrc000 + 1 
     283      itmod = kt - nit000 + 1 
    284284      it    = kt 
     285      iiter = ( nit000 - 1 ) / nn_dttrc 
    285286 
    286287      ! 1. Define NETCDF files and fields at beginning of first time step 
    … …  
    289290      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 
    290291 
    291       IF( kt == nittrc000 ) THEN 
     292      IF( kt == nit000 ) THEN 
    292293 
    293294         ! Define the NETCDF files for additional arrays : 2D or 3D 
    … …  
    302303         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             & 
    303304            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    304             &          nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
     305            &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
    305306 
    306307         ! Vertical grid for 2d and 3d arrays 
    … …  
    367368 
    368369# else 
    369  
    370370   SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine 
    371371      INTEGER, INTENT ( in ) :: kt, kindic 
    372372   END SUBROUTINE trcdii_wr 
    373  
    374373# endif 
    375374 
    … …  
    392391      !!        IF kindic >0, output of fields before the time step loop 
    393392      !!---------------------------------------------------------------------- 
    394       !! 
    395393      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    396394      INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
    … …  
    401399      CHARACTER (len=80) ::   cltral 
    402400      INTEGER  ::   ji, jj, jk, jl 
    403       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
     401      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 
    404402      REAL(wp) ::   zsto, zout, zdt 
    405403      !!---------------------------------------------------------------------- 
    … …  
    433431 
    434432      ! define time axis 
    435       itmod = kt - nittrc000 + 1 
     433      itmod = kt - nit000 + 1 
    436434      it    = kt 
     435      iiter = ( nit000 - 1 ) / nn_dttrc 
    437436 
    438437      ! Define NETCDF files and fields at beginning of first time step 
    … …  
    441440      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 
    442441 
    443       IF( kt == nittrc000 ) THEN 
     442      IF( kt == nit000 ) THEN 
    444443 
    445444         ! Define the NETCDF files for biological trends 
    … …  
    450449         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      & 
    451450            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
    452             &    nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
     451            &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
    453452         ! Vertical grid for biological trends 
    454453         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb) 
    … …  
    510509      INTEGER, INTENT(in) :: kt 
    511510   END SUBROUTINE trc_dia    
    512  
    513511#endif 
    514512 

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

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

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

    r2087 r2104  
    4141    !! * Substitutions 
    4242#  include "domzgr_substitute.h90" 
    43    !!---------------------------------------------------------------------- 
    44    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    45    !! $Id$  
    46    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    47    !!---------------------------------------------------------------------- 
    4843   
    4944CONTAINS 
    … …  
    123118# if defined key_dtatrc 
    124119         ! Initialization of tracer from a file that may also be used for damping 
    125          CALL trc_dta( nittrc000 ) 
     120         CALL trc_dta( nit000 ) 
    126121         DO jn = 1, jptra 
    127122            IF( lutini(jn) )   trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required 
    … …  
    138133       
    139134      IF( ln_zps .AND. .NOT. lk_trc_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    140       &                     CALL zps_hde( nittrc000, jptra, trb, gtru, gtrv )       ! tracers at the bottom ocean level 
     135      &                     CALL zps_hde( nit000, jptra, trb, gtru, gtrv )       ! tracers at the bottom ocean level 
    141136 
    142137 
    … …  
    181176#endif 
    182177 
     178   !!---------------------------------------------------------------------- 
     179   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     180   !! $Id$  
     181   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    183182   !!====================================================================== 
    184183END MODULE trcini 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcnam.F90

    r2038 r2104  
    102102      READ  ( numnat, namtrc ) 
    103103 
    104       !!Chris  computes the first time step of tracer model 
    105       nittrc000 = nit000 + nn_dttrc - 1 
    106  
    107104      DO jn = 1, jptra 
    108105         ctrcnm(jn) = sn_tracer(jn)%clsname 
    … …  
    118115         WRITE(numout,*) ' Namelist : namtrc' 
    119116         WRITE(numout,*) '    time step freq. for pass. trac. nn_dttrc             = ', nn_dttrc 
    120          WRITE(numout,*) '    1st time step for pass. trac. nittrc000              = ', nittrc000 
    121117         WRITE(numout,*) '    frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc   
    122118         WRITE(numout,*) '    restart LOGICAL for passive tr. ln_rsttr             = ', ln_rsttr 
    … …  
    200196#endif 
    201197 
     198   !!---------------------------------------------------------------------- 
     199   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     200   !! $Id: $  
     201   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    202202   !!====================================================================== 
    203203END MODULE  trcnam 

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

    r2038 r2104  
    4747   !! * Substitutions 
    4848#  include "top_substitute.h90" 
    49    !!---------------------------------------------------------------------- 
    50    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    51    !! $Id$  
    52    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    53    !!---------------------------------------------------------------------- 
    5449    
    5550CONTAINS 
    … …  
    128123      ! Time domain : restart 
    129124      ! --------------------- 
    130       CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar 
     125      CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    131126 
    132127      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   iarak0 = 1 
    … …  
    222217      !! 
    223218      !!   According to namelist parameter nrstdt, 
    224       !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary). 
     219      !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary). 
    225220      !!       nn_rsttr = 1  we verify that nit000 is equal to the last 
    226221      !!                   time step of previous run + 1. 
    … …  
    251246            WRITE(numout,*) ' *** restart option' 
    252247            SELECT CASE ( nn_rsttr ) 
    253             CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 
     248            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000' 
    254249            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
    255250            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
    … …  
    258253         ENDIF 
    259254         ! Control of date  
    260          IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
     255         IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
    261256            &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
    262257            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    … …  
    269264         ELSE 
    270265            ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    271             adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
     266            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
    272267            ! note this is wrong if time step has changed during run 
    273268         ENDIF 
    … …  
    369364#endif 
    370365 
     366   !!---------------------------------------------------------------------- 
     367   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     368   !! $Id$  
     369   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    371370   !!====================================================================== 
    372371END MODULE trcrst 

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

    r2038 r2104  
    2828 
    2929   !!---------------------------------------------------------------------- 
    30    !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     30   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
    3131   !! $Id$  
    3232   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcstp.F90

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

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcwri.F90

    r2038 r2104  
    2828   !! * Substitutions 
    2929#  include "top_substitute.h90" 
    30    !!---------------------------------------------------------------------- 
    31    !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
    32    !! $Id: trcdia.F90 1450 2009-05-15 14:12:12Z cetlod $  
    33    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    3530 
    3631CONTAINS 
    … …  
    6863  
    6964#if defined key_offline 
    70       IF( kt == nittrc000 ) THEN 
     65      IF( kt == nit000 ) THEN 
    7166        ! WRITE root name in date.file for use by postpro 
    7267         IF(lwp) THEN 
    … …  
    9893#endif 
    9994 
     95   !!---------------------------------------------------------------------- 
     96   !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010)  
     97   !! $Id: $  
     98   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    10099   !!====================================================================== 
    101100END MODULE trcwri 
Note: See TracChangeset for help on using the changeset viewer.