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 for branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA – NEMO

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/OPA_SRC/TRA
Files:
25 edited

Legend:

Unmodified
Added
Removed

  • 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   !!====================================================================== 
Note: See TracChangeset for help on using the changeset viewer.