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

Changeset 2392


Ignore:
Timestamp:
2010-11-15T22:20:05+01:00 (13 years ago)
Author:
gm
Message:

v3.3beta: Cross Land Advection (ticket #127) full rewriting + MPP bug corrections

Location:
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC
Files:
2 deleted
18 edited

Legend:

Unmodified
Added
Removed

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r2287 r2392  
    55   !!                          assimilation 
    66   !!====================================================================== 
     7   !! History :       ! 2007-03  (M. Martin)  Met Office version 
     8   !!                 ! 2007-04  (A. Weaver)  calc_date original code 
     9   !!                 ! 2007-04  (A. Weaver)  Merge with OPAVAR/NEMOVAR 
     10   !!   NEMO     3.3  ! 2010-05  (D. Lea)  Update to work with NEMO v3.2 
     11   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init  
     12   !!---------------------------------------------------------------------- 
    713 
    814   !!---------------------------------------------------------------------- 
    … …  
    1521   !!   ssh_asm_inc  : Apply the SSH increment 
    1622   !!---------------------------------------------------------------------- 
    17    !! * Modules used    
    18    USE par_kind, ONLY : &       ! Precision variables 
    19       & wp 
    20    USE in_out_manager, ONLY : & ! I/O manager  
    21       & lwp,      & 
    22       & numnam,   & 
    23       & numout,   & 
    24       & ctl_warn, & 
    25       & ctl_stop, & 
    26       & nit000,   & 
    27       & nstop,    & 
    28       & ln_rstart 
    29    USE par_oce, ONLY : & ! Ocean space and time domain variables 
    30       & jpi,  &  
    31       & jpj,  & 
    32       & jpk,  & 
    33       & jpkm1 
    34    USE dom_oce, ONLY : & ! Ocean space and time domain 
    35       & rdt,    & 
    36       & n_cla,  & 
    37       & neuler, & 
    38       & ln_zps, & 
    39       & tmask,  & 
    40       & umask,  & 
    41       & vmask 
     23   USE in_out_manager   ! I/O manager 
     24   USE par_oce          ! Ocean space and time domain variables 
     25   USE dom_oce          ! Ocean space and time domain 
     26   USE oce              ! Dynamics and active tracers defined in memory 
     27   USE divcur           ! Horizontal divergence and relative vorticity 
     28   USE eosbn2           ! Equation of state - in situ and potential density 
     29   USE zpshde           ! Partial step : Horizontal Derivative 
     30   USE iom              ! Library to read input files 
     31   USE asmpar           ! Parameters for the assmilation interface 
    4232#if defined key_c1d 
    43    USE c1d, ONLY : &    ! 1D initialization 
    44       & lk_c1d 
     33   USE c1d, ONLY :   lk_c1d    ! 1D initialization 
    4534#endif 
    46    USE oce, ONLY : &      ! Dynamics and active tracers defined in memory 
    47       & ub, un, ua,    & 
    48       & vb, vn, va,    & 
    49       & tsb, tsn, tsa, & 
    50       & sshb, sshn,    & 
    51       & rhd, rhop,     & 
    52       & rotb, rotn,    & 
    53       & hdivb, hdivn,  & 
    54       & gtsu, gru,     & 
    55       & gtsv, grv  
    56    USE divcur, ONLY : &   ! Horizontal divergence and relative vorticity 
    57       & div_cur 
    58    USE cla_div, ONLY : &  ! Specific update of the horizontal divergence 
    59       & div_cla           ! (specific to ORCA_R2) 
    60    USE eosbn2, ONLY : &   ! Equation of state - in situ and potential density 
    61       & eos 
    62    USE zpshde, ONLY : &   ! Partial step : Horizontal Derivative 
    63       & zps_hde 
    64 !   USE phycst, ONLY : &   ! Calendar parameters 
    65 !      & rjjss   
    66    USE iom                ! Library to read input files 
    67    USE asmpar             ! Parameters for the assmilation interface 
    68    USE dom_oce, ONLY : & 
    69       & ndastp 
    70 !   USE daymod, ONLY : & 
    71 !      & nmonth_len         ! length of month in days 
    72 !      & nbiss, & 
    73 !      & nobis, & 
    74   
    7535 
    7636   IMPLICIT NONE 
    77  
    78    !! * Routine accessibility 
    7937   PRIVATE 
    80    PUBLIC asm_inc_init, & !: Initialize the increment arrays and IAU weights 
    81       &   calc_date,    & !: Compute the calendar date YYYYMMDD on a given step 
    82       &   tra_asm_inc,  & !: Apply the tracer (T and S) increments 
    83       &   dyn_asm_inc,  & !: Apply the dynamic (u and v) increments 
    84       &   ssh_asm_inc     !: Apply the SSH increment 
    85  
    86    !! * Private Module variables 
    87    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE :: & 
    88       & t_bkg,    &       !: Background temperature  
    89       & s_bkg,    &       !: Background salinity 
    90       & u_bkg,    &       !: Background u-component velocity 
    91       & v_bkg,    &       !: Background v-component velocity 
    92       & t_bkginc, &       !: Increment to the background temperature 
    93       & s_bkginc, &       !: Increment to the background salinity 
    94       & u_bkginc, &       !: Increment to the u-component velocity  
    95       & v_bkginc          !: Increment to the v-component velocity  
    96           
    97    REAL(wp), PRIVATE, DIMENSION(:,:), ALLOCATABLE :: & 
    98       & ssh_bkg,   &      !: Background sea surface height 
    99       & ssh_bkginc        !: Increment to the background sea surface height 
    100  
    101    REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 
    102       & wgtiau            !: IAU weights for each time step 
    103  
    104    !! * Shared Module variables 
    105    LOGICAL, PUBLIC, PARAMETER :: & 
     38    
     39   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights 
     40   PUBLIC   calc_date      !: Compute the calendar date YYYYMMDD on a given step 
     41   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments 
     42   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments 
     43   PUBLIC   ssh_asm_inc    !: Apply the SSH increment 
     44 
    10645#if defined key_asminc 
    107       & lk_asminc = .TRUE.   !: Logical switch for assimilation increment interface 
     46    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .TRUE.   !: Logical switch for assimilation increment interface 
    10847#else 
    109       & lk_asminc = .FALSE.  !: No assimilation increments 
     48    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE.  !: No assimilation increments 
    11049#endif 
    111  
    11250   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields 
    11351   LOGICAL, PUBLIC :: ln_trjwri = .FALSE. !: No output of the state trajectory fields 
    … …  
    11957   LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check 
    12058 
    121    REAL, PUBLIC :: salfixmin   !: Ensure that the salinity is larger than  
    122    !                           !: this  value if (ln_salfix) 
     59   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkg   , s_bkg      !: Background temperature and salinity 
     60   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkg   , v_bkg      !: Background u- & v- velocity components 
     61   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkginc, s_bkginc   !: Increment to the background T & S 
     62   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   u_bkginc, v_bkginc   !: Increment to the u- & v-components  
     63   REAL(wp), PUBLIC, DIMENSION(:)    , ALLOCATABLE ::   wgtiau               !: IAU weights for each time step 
    12364#if defined key_asminc 
    124    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: & 
    125       & ssh_iau           !: IAU-weighted sea surface height increment 
     65   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   ssh_iau           !: IAU-weighted sea surface height increment 
    12666#endif 
    127  
    128    INTEGER, PUBLIC :: nitbkg     !: Time step of the background state used in the Jb term 
    129                                  !: (relative to the cycle interval [0,nitend-nit000-1]) 
    130    INTEGER, PUBLIC :: nitdin     !: Time step of the background state for direct initialization 
    131                                  !: (relative to the cycle interval [0,nitend-nit000-1]) 
    132    INTEGER, PUBLIC :: nitiaustr  !: Time step of the start of the IAU interval  
    133                                  !: (relative to the cycle interval [0,nitend-nit000-1]) 
    134    INTEGER, PUBLIC :: nitiaufin  !: Time step of the end of the IAU interval  
    135                                  !: (relative to the cycle interval [0,nitend-nit000-1]) 
    136    INTEGER, PUBLIC :: niaufn     !: Type of IAU weighing function 
    137                                  !:   0 = Constant weighting 
    138                                  !:   1 = Linear hat-like, centred in middle of IAU interval  
     67   !                                !!! time steps relative to the cycle interval [0,nitend-nit000-1] 
     68   INTEGER , PUBLIC ::   nitbkg      !: Time step of the background state used in the Jb term 
     69   INTEGER , PUBLIC ::   nitdin      !: Time step of the background state for direct initialization 
     70   INTEGER , PUBLIC ::   nitiaustr   !: Time step of the start of the IAU interval  
     71   INTEGER , PUBLIC ::   nitiaufin   !: Time step of the end of the IAU interval 
     72   !  
     73   INTEGER , PUBLIC ::   niaufn      !: Type of IAU weighing function: = 0   Constant weighting 
     74   !                                 !: = 1   Linear hat-like, centred in middle of IAU interval  
     75   REAL(wp), PUBLIC ::   salfixmin   !: Ensure that the salinity is larger than this  value if (ln_salfix) 
     76 
     77   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment 
    13978 
    14079   !!---------------------------------------------------------------------- 
    14180   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    14281   !! $Id$ 
    143    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     82   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    14483   !!---------------------------------------------------------------------- 
    145  
    14684CONTAINS 
    14785 
    … …  
    15593      !! 
    15694      !! ** Action  :  
    157       !! 
    158       !! History : 
    159       !!        !  07-03  (M. Martin) Met Office version 
    160       !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR 
    161       !!---------------------------------------------------------------------- 
    162  
    163       IMPLICIT NONE 
    164  
    165       !! * Modules used 
    166       NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri, & 
    167          &                 ln_trainc, ln_dyninc, ln_sshinc, & 
    168          &                 ln_asmdin, ln_asmiau, & 
    169          &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 
    170          &                 nittrjfrq, ln_salfix, salfixmin 
    171  
    172       !! * Local declarations 
     95      !!---------------------------------------------------------------------- 
    17396      INTEGER :: jt 
    174  
    17597      INTEGER :: imid 
    17698      INTEGER :: inum 
    … …  
    190112      REAL(wp) :: zdate_bkg    ! Date in background state file for DI 
    191113      REAL(wp) :: zdate_inc    ! Time axis in increments file 
     114      !! 
     115      NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri,                           & 
     116         &                 ln_trainc, ln_dyninc, ln_sshinc,                & 
     117         &                 ln_asmdin, ln_asmiau,                           & 
     118         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   & 
     119         &                 nittrjfrq, ln_salfix, salfixmin 
     120      !!---------------------------------------------------------------------- 
    192121 
    193122      !----------------------------------------------------------------------- 
    … …  
    220149         WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :' 
    221150         WRITE(numout,*) '~~~~~~~~~~~~' 
    222          WRITE(numout,*) '          Namelist namasm : set assimilation increment parameters' 
    223          WRITE(numout,*) '             Logical switch for writing out background state         ', & 
    224             &            ' ln_bkgwri = ', ln_bkgwri 
    225          WRITE(numout,*) '             Logical switch for writing out state trajectory         ', & 
    226             &            ' ln_trjwri = ', ln_trjwri 
    227          WRITE(numout,*) '             Logical switch for applying tracer increments           ', & 
    228             &            ' ln_trainc = ', ln_trainc 
    229          WRITE(numout,*) '             Logical switch for applying velocity increments         ', & 
    230             &            ' ln_dyninc = ', ln_dyninc 
    231          WRITE(numout,*) '             Logical switch for applying SSH increments              ', & 
    232             &            ' ln_sshinc = ', ln_sshinc 
    233          WRITE(numout,*) '             Logical switch for Direct Initialization (DI)           ', & 
    234             &            ' ln_asmdin = ', ln_asmdin 
    235          WRITE(numout,*) '             Logical switch for Incremental Analysis Updating (IAU)  ', & 
    236             &            ' ln_asmiau = ', ln_asmiau 
    237          WRITE(numout,*) '             Timestep of background in [0,nitend-nit000-1]           ', & 
    238             &            '    nitbkg = ', nitbkg 
    239          WRITE(numout,*) '             Timestep of background for DI in [0,nitend-nit000-1]    ', & 
    240             &            '    nitdin = ', nitdin 
    241          WRITE(numout,*) '             Timestep of start of IAU interval in [0,nitend-nit000-1]', & 
    242             &            ' nitiaustr = ', nitiaustr 
    243          WRITE(numout,*) '             Timestep of end of IAU interval in [0,nitend-nit000-1]  ', & 
    244             &            ' nitiaufin = ', nitiaufin 
    245          WRITE(numout,*) '             Type of IAU weighting function                          ', & 
    246             &            '    niaufn = ', niaufn 
    247          WRITE(numout,*) '             Frequency of trajectory output for 4D-VAR               ', & 
    248             &            ' nittrjfrq = ', nittrjfrq 
    249          WRITE(numout,*) '             Logical switch for ensuring that the sa > salfixmin     ', & 
    250             &            ' ln_salfix = ', ln_salfix 
    251          WRITE(numout,*) '             Minimum salinity after applying the increments          ', & 
    252             &            ' salfixmin = ', salfixmin 
     151         WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters' 
     152         WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri 
     153         WRITE(numout,*) '      Logical switch for writing out state trajectory          ln_trjwri = ', ln_trjwri 
     154         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc 
     155         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc 
     156         WRITE(numout,*) '      Logical switch for applying SSH increments               ln_sshinc = ', ln_sshinc 
     157         WRITE(numout,*) '      Logical switch for Direct Initialization (DI)            ln_asmdin = ', ln_asmdin 
     158         WRITE(numout,*) '      Logical switch for Incremental Analysis Updating (IAU)   ln_asmiau = ', ln_asmiau 
     159         WRITE(numout,*) '      Timestep of background in [0,nitend-nit000-1]            nitbkg    = ', nitbkg 
     160         WRITE(numout,*) '      Timestep of background for DI in [0,nitend-nit000-1]     nitdin    = ', nitdin 
     161         WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr 
     162         WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin 
     163         WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn 
     164         WRITE(numout,*) '      Frequency of trajectory output for 4D-VAR                nittrjfrq = ', nittrjfrq 
     165         WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix 
     166         WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin 
    253167      ENDIF 
    254168 
    … …  
    565479 
    566480      ENDIF 
    567  
     481      ! 
    568482   END SUBROUTINE asm_inc_init 
     483 
    569484 
    570485   SUBROUTINE calc_date( kit000, kt, kdate0, kdate ) 
    … …  
    577492      !! 
    578493      !! ** Action  :  
    579       !! 
    580       !! History : 
    581       !!        !  07-04  (A. Weaver)  
    582       !!        !  10-05  (D. Lea)        Update to work with NEMO vn3.2 
    583       !!---------------------------------------------------------------------- 
    584  
    585       IMPLICIT NONE 
    586  
    587       !! * Arguments 
    588  
     494      !!---------------------------------------------------------------------- 
    589495      INTEGER, INTENT(IN) :: kit000  ! Initial time step 
    590496      INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000 
    591497      INTEGER, INTENT(IN) :: kdate0  ! Initial date 
    592498      INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0 
    593  
    594       !! * Local declarations 
    595  
     499      ! 
    596500      INTEGER :: iyea0    ! Initial year 
    597501      INTEGER :: imon0    ! Initial month 
    … …  
    648552         idaycnt = idaycnt + 1 
    649553      END DO 
    650  
     554      ! 
    651555      kdate = iyea * 10000 + imon * 100 + iday 
    652  
     556      ! 
    653557   END SUBROUTINE 
     558 
    654559 
    655560   SUBROUTINE calc_month_len( iyear, imonth_len ) 
    … …  
    660565      !! 
    661566      !! ** Method  :  
    662       !! 
    663       !! ** Action  :  
    664       !! 
    665       !! History : 
    666       !!        !  10-05  (D. Lea)   New routine based on day_init  
    667       !!---------------------------------------------------------------------- 
    668  
     567      !!---------------------------------------------------------------------- 
    669568      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    670569      INTEGER :: iyear         !: year 
    671  
     570      !!---------------------------------------------------------------------- 
     571      ! 
    672572      ! length of the month of the current year (from nleapy, read in namelist) 
    673573      IF ( nleapy < 2 ) THEN  
    … …  
    681581         imonth_len(:) = nleapy   ! all months with nleapy days per year 
    682582      ENDIF 
    683  
     583      ! 
    684584   END SUBROUTINE 
     585 
    685586 
    686587   SUBROUTINE tra_asm_inc( kt ) 
    … …  
    693594      !! 
    694595      !! ** Action  :  
    695       !! 
    696       !! History : 
    697       !!        !  07-03  (M. Martin) Met Office version 
    698       !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR 
    699       !!---------------------------------------------------------------------- 
    700  
    701       IMPLICIT NONE 
    702  
    703       !! * Arguments 
     596      !!---------------------------------------------------------------------- 
    704597      INTEGER, INTENT(IN) :: kt               ! Current time step 
    705  
    706       !! * Local declarations 
     598      ! 
    707599      INTEGER :: ji,jj,jk 
    708600      INTEGER :: it 
    709601      REAL(wp) :: zincwgt  ! IAU weight for current time step 
     602      !!---------------------------------------------------------------------- 
    710603 
    711604      IF ( ln_asmiau ) THEN 
    … …  
    793686            DEALLOCATE( s_bkg    ) 
    794687         ENDIF 
    795           
    796       ENDIF 
    797  
     688         !   
     689      ENDIF 
     690      ! 
    798691   END SUBROUTINE tra_asm_inc 
     692 
    799693 
    800694   SUBROUTINE dyn_asm_inc( kt ) 
    … …  
    807701      !! 
    808702      !! ** Action  :  
    809       !! 
    810       !! History : 
    811       !!        !  07-03  (M. Martin) Met Office version 
    812       !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR 
    813       !!---------------------------------------------------------------------- 
    814  
    815       IMPLICIT NONE 
    816  
    817       !! * Arguments 
     703      !!---------------------------------------------------------------------- 
    818704      INTEGER, INTENT(IN) :: kt   ! Current time step 
    819  
    820       !! * Local declarations 
     705      ! 
    821706      INTEGER :: jk 
    822707      INTEGER :: it 
    823708      REAL(wp) :: zincwgt  ! IAU weight for current time step 
     709      !!---------------------------------------------------------------------- 
    824710 
    825711      IF ( ln_asmiau ) THEN 
    … …  
    871757            vb(:,:,:) = vn(:,:,:) 
    872758  
    873             CALL div_cur( kt )                  ! Compute divergence and curl for now fields 
    874             IF( n_cla == 1 ) CALL div_cla( kt ) ! Cross Land Advection (Update Hor. divergence) 
     759            CALL div_cur( kt )            ! Compute divergence and curl for now fields 
    875760 
    876761            rotb (:,:,:) = rotn (:,:,:)   ! Update before fields 
    … …  
    881766            DEALLOCATE( u_bkginc ) 
    882767            DEALLOCATE( v_bkginc ) 
    883  
    884          ENDIF 
    885  
    886       ENDIF 
    887  
     768         ENDIF 
     769         ! 
     770      ENDIF 
     771      ! 
    888772   END SUBROUTINE dyn_asm_inc 
     773 
    889774 
    890775   SUBROUTINE ssh_asm_inc( kt ) 
    … …  
    897782      !! 
    898783      !! ** Action  :  
    899       !! 
    900       !! History : 
    901       !!        !  07-03  (M. Martin) Met Office version 
    902       !!        !  07-04  (A. Weaver) Merge with OPAVAR/NEMOVAR 
    903       !!---------------------------------------------------------------------- 
    904  
    905       IMPLICIT NONE 
    906  
    907       !! * Arguments 
     784      !!---------------------------------------------------------------------- 
    908785      INTEGER, INTENT(IN) :: kt   ! Current time step 
    909  
    910       !! * Local declarations 
     786      ! 
    911787      INTEGER :: it 
    912788      REAL(wp) :: zincwgt  ! IAU weight for current time step 
     789      !!---------------------------------------------------------------------- 
    913790 
    914791      IF ( ln_asmiau ) THEN 
    … …  
    960837 
    961838         ENDIF 
    962  
    963       ENDIF 
    964  
     839         ! 
     840      ENDIF 
     841      ! 
    965842   END SUBROUTINE ssh_asm_inc 
    966843 
     844   !!====================================================================== 
    967845END MODULE asminc 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2304 r2392  
    5555   !                                         !!* Namelist namcla : cross land advection 
    5656   INTEGER, PUBLIC ::   nn_cla = 0            !: =1 cross land advection for exchanges through some straits (ORCA2) 
    57  
    58    !                                          ! old non-DOCTOR names still used in the model 
    59    INTEGER, PUBLIC ::   n_cla = 0             !: =1 cross land advection for exchanges through some straits (ORCA2) 
    6057 
    6158   !!---------------------------------------------------------------------- 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r2382 r2392  
    243243      ENDIF 
    244244 
    245       n_cla = nn_cla                ! conversion DOCTOR names into model names (this should disappear soon) 
    246  
    247       IF( lk_mpp_rep .AND. n_cla /= 0 )   CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' ) 
    248       ! 
    249  
    250245#if defined key_netcdf4 
    251246      !                             ! NetCDF 4 case   ("key_netcdf4" defined) 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r2380 r2392  
    44   !! Ocean initialization : domain initialization 
    55   !!============================================================================== 
    6    !! History :       !  88-03  (G. Madec) 
    7    !!                 !  91-11  (G. Madec) 
    8    !!                 !  92-06  (M. Imbard) 
    9    !!                 !  96-01  (G. Madec)  terrain following coordinates 
    10    !!                 !  97-02  (G. Madec)  print mesh informations 
    11    !!                 !  99-11  (M. Imbard) NetCDF format with IO-IPSL 
    12    !!                 !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb 
    13    !!                 !  01-09  (M. Levy)  eel config: grid in km, beta-plane 
    14    !!            8.5  !  02-08  (G. Madec)  F90: Free form and module, namelist 
    15    !!            9.0  !  04-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh) 
    16    !!                           use of parameters in par_CONFIG-Rxx.h90, not in namelist 
    17    !!                 !  04-05  (A. Koch-Larrouy) Add Gyre configuration  
     6   !! History :  OPA  ! 1988-03  (G. Madec) Original code 
     7   !!            7.0  ! 1996-01  (G. Madec)  terrain following coordinates 
     8   !!            8.0  ! 1997-02  (G. Madec)  print mesh informations 
     9   !!            8.1  ! 1999-11  (M. Imbard) NetCDF format with IO-IPSL 
     10   !!            8.2  ! 2000-08  (D. Ludicone) Reduced section at Bab el Mandeb 
     11   !!             -   ! 2001-09  (M. Levy)  eel config: grid in km, beta-plane 
     12   !!  NEMO      1.0  ! 2002-08  (G. Madec)  F90: Free form and module, namelist 
     13   !!             -   ! 2004-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh) 
     14   !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist 
     15   !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration  
    1816   !!---------------------------------------------------------------------- 
    1917 
    2018   !!---------------------------------------------------------------------- 
    21    !!   dom_hgr        : initialize the horizontal mesh  
    22    !!   hgr_read       : read "coordinate" NetCDF file  
     19   !!   dom_hgr       : initialize the horizontal mesh  
     20   !!   hgr_read      : read "coordinate" NetCDF file  
    2321   !!---------------------------------------------------------------------- 
    24    !! * Modules used 
    25    USE dom_oce         ! ocean space and time domain 
    26    USE phycst          ! physical constants 
    27    USE in_out_manager  ! I/O manager 
    28    USE lib_mpp 
     22   USE dom_oce        ! ocean space and time domain 
     23   USE phycst         ! physical constants 
     24   USE in_out_manager ! I/O manager 
     25   USE lib_mpp        ! MPP library 
    2926 
    3027   IMPLICIT NONE 
    3128   PRIVATE 
    3229 
    33    !! * Module variables 
    34    REAL(wp) ::   glam0, gphi0           ! variables corresponding to parameters 
    35       !                                 ! ppglam0 ppgphi0 set in par_oce 
    36  
    37    !! * Routine accessibility 
    38    PUBLIC dom_hgr        ! called by domain.F90 
     30   REAL(wp) ::   glam0, gphi0   ! variables corresponding to parameters ppglam0 ppgphi0 set in par_oce 
     31 
     32   PUBLIC   dom_hgr   ! called by domain.F90 
     33 
    3934   !!---------------------------------------------------------------------- 
    4035   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4136   !! $Id$  
    42    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     37   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4338   !!---------------------------------------------------------------------- 
    44  
    4539CONTAINS 
    4640 
    … …  
    10094      !!                Madec, Imbard, 1996, Clim. Dyn. 
    10195      !!---------------------------------------------------------------------- 
    102       INTEGER  ::   ji, jj              ! dummy loop indices 
    103       INTEGER  ::   ii0, ii1, ij0, ij1  ! temporary integers 
    104       INTEGER  ::   ijeq                ! index of equator T point (used in case 4) 
    105       REAL(wp) ::   & 
    106          zti, zui, zvi, zfi,         &  ! temporary scalars 
    107          ztj, zuj, zvj, zfj,         &  ! 
    108          zphi0, zbeta, znorme,       &  ! 
    109          zarg, zf0, zminff, zmaxff 
    110       REAL(wp) ::   & 
    111          zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg,   & 
    112          zphi1, zsin_alpha, zim05, zjm05 
     96      INTEGER  ::   ji, jj               ! dummy loop indices 
     97      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers 
     98      INTEGER  ::   ijeq                 ! index of equator T point (used in case 4) 
     99      REAL(wp) ::   zti, zui, zvi, zfi   ! local scalars 
     100      REAL(wp) ::   ztj, zuj, zvj, zfj   !   -      - 
     101      REAL(wp) ::   zphi0, zbeta, znorme ! 
     102      REAL(wp) ::   zarg, zf0, zminff, zmaxff 
     103      REAL(wp) ::   zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg 
     104      REAL(wp) ::   zphi1, zsin_alpha, zim05, zjm05 
    113105      !!---------------------------------------------------------------------- 
    114106 
    … …  
    138130         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    139131            !                                             ! ===================== 
    140             IF( n_cla == 0 ) THEN 
     132            IF( nn_cla == 0 ) THEN 
    141133               ! 
    142134               ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u = 20 km) 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r2380 r2392  
    55   !!====================================================================== 
    66   !! History :  OPA  ! 1987-07  (G. Madec)  Original code 
    7    !!             -   ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon) 
    8    !!             -   ! 1996-01  (G. Madec)  suppression of common work arrays 
     7   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon) 
     8   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays 
    99   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask and sup- 
    1010   !!                 !                      pression of the double computation of bmask 
    11    !!             -   ! 1997-02  (G. Madec)  mesh information put in domhgr.F 
    12    !!             -   ! 1997-07  (G. Madec)  modification of mbathy and fmask 
     11   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F 
     12   !!            8.1  ! 1997-07  (G. Madec)  modification of mbathy and fmask 
    1313   !!             -   ! 1998-05  (G. Roullet)  free surface 
    14    !!             -   ! 2000-03  (G. Madec)  no slip accurate 
     14   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate 
    1515   !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries 
    1616   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module 
    … …  
    4444   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    4545   !! $Id$  
    46    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    47    !!---------------------------------------------------------------------- 
    48  
     46   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     47   !!---------------------------------------------------------------------- 
    4948CONTAINS 
    5049    
    … …  
    132131      ENDIF 
    133132 
    134       IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral free-slip ' 
     133      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  free-slip ' 
    135134      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  no-slip ' 
    136135      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  partial-slip ' 
    … …  
    308307      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration 
    309308         !                                                 ! Increased lateral friction near of some straits 
    310          IF( n_cla == 0 ) THEN 
     309         IF( nn_cla == 0 ) THEN 
    311310            !                                ! Gibraltar strait  : partial slip (fmask=0.5) 
    312311            ij0 = 101   ;   ij1 = 101 
    … …  
    322321            ! 
    323322         ENDIF 
    324  
    325323         !                                ! Danish straits  : strong slip (fmask > 2) 
    326324! We keep this as an example but it is instable in this case  
    … …  
    331329         ! 
    332330      ENDIF 
    333             !                                               ! ===================== 
    334          IF( cp_cfg == "orca" .AND. jp_cfg .eq. 1 ) THEN    ! ORCA R1 configuration 
    335             !                                               ! ===================== 
    336  
    337             ii0 = 283   ;   ii1 = 284        ! Gibraltar Strait  
    338             ij0 = 200   ;   ij1 = 200   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2.0   
    339             IF(lwp) WRITE(numout,*) 
    340             IF(lwp) WRITE(numout,*) '             orca_r1: Gibraltar : ' 
    341  
    342             ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait  
    343             ij0 = 208   ;   ij1 = 208   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2.0   
    344             IF(lwp) WRITE(numout,*) 
    345             IF(lwp) WRITE(numout,*) '             orca_r1: Bhosporus : ' 
    346  
    347             ii0 =  48   ;   ii1 =  48        ! Makassar Strait (Top)  
    348             ij0 = 149   ;   ij1 = 150   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  3.0   
    349             IF(lwp) WRITE(numout,*) 
    350             IF(lwp) WRITE(numout,*) '             orca_r1: Makassar (Top) : ' 
    351  
    352             ii0 =  44   ;   ii1 =  44        ! Lombok Strait  
    353             ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2.0   
    354             IF(lwp) WRITE(numout,*) 
    355             IF(lwp) WRITE(numout,*) '             orca_r1: Lombok : ' 
    356  
    357             ii0 =  53   ;   ii1 =  53        ! Ombai Strait  
    358             ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0   
    359             IF(lwp) WRITE(numout,*) 
    360             IF(lwp) WRITE(numout,*) '             orca_r1: Ombai : ' 
    361  
    362             ii0 =  56   ;   ii1 =  56        ! Timor Passage  
    363             ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0   
    364             IF(lwp) WRITE(numout,*) 
    365             IF(lwp) WRITE(numout,*) '             orca_r1: ' 
    366  
    367             ii0 =  58   ;   ii1 =  58        ! West Halmahera Strait  
    368             ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0   
    369             IF(lwp) WRITE(numout,*) 
    370             IF(lwp) WRITE(numout,*) '             orca_r1: West Halmahera : ' 
    371  
    372             ii0 =  55   ;   ii1 =  55        ! East Halmahera Strait  
    373             ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0   
    374             IF(lwp) WRITE(numout,*) 
    375             IF(lwp) WRITE(numout,*) '             orca_r1: East Halmahera : ' 
    376  
    377             ! 
    378             ! 
    379          ENDIF 
     331      ! 
     332      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration 
     333         !                                                 ! Increased lateral friction near of some straits 
     334         IF(lwp) WRITE(numout,*) 
     335         IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : ' 
     336         IF(lwp) WRITE(numout,*) '      Gibraltar ' 
     337         ii0 = 283   ;   ii1 = 284        ! Gibraltar Strait  
     338         ij0 = 200   ;   ij1 = 200   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2.0   
     339 
     340         IF(lwp) WRITE(numout,*) '      Bhosporus ' 
     341         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait  
     342         ij0 = 208   ;   ij1 = 208   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2.0   
     343 
     344         IF(lwp) WRITE(numout,*) '      Makassar (Top) ' 
     345         ii0 =  48   ;   ii1 =  48        ! Makassar Strait (Top)  
     346         ij0 = 149   ;   ij1 = 150   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  3.0   
     347 
     348         IF(lwp) WRITE(numout,*) '      Lombok ' 
     349         ii0 =  44   ;   ii1 =  44        ! Lombok Strait  
     350         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2.0   
     351 
     352         IF(lwp) WRITE(numout,*) '      Ombai ' 
     353         ii0 =  53   ;   ii1 =  53        ! Ombai Strait  
     354         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0   
     355 
     356         IF(lwp) WRITE(numout,*) '      Timor Passage ' 
     357         ii0 =  56   ;   ii1 =  56        ! Timor Passage  
     358         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2.0   
     359 
     360         IF(lwp) WRITE(numout,*) '      West Halmahera ' 
     361         ii0 =  58   ;   ii1 =  58        ! West Halmahera Strait  
     362         ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0   
     363 
     364         IF(lwp) WRITE(numout,*) '      East Halmahera ' 
     365         ii0 =  55   ;   ii1 =  55        ! East Halmahera Strait  
     366         ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3.0   
     367         ! 
     368      ENDIF 
    380369      ! 
    381370      CALL lbc_lnk( fmask, 'F', 1. )      ! Lateral boundary conditions on fmask 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r2380 r2392  
    412412            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    413413               !                                             ! ===================== 
    414                IF( n_cla == 0 ) THEN 
    415                   ! 
     414               IF( nn_cla == 0 ) THEN 
    416415                  ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open  
    417416                  ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995) 
    … …  
    422421                  END DO 
    423422                  IF(lwp) WRITE(numout,*) 
    424                   IF(lwp) WRITE(numout,*) '             orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 
     423                  IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 
    425424                  ! 
    426425                  ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open 
    … …  
    432431                  END DO 
    433432                  IF(lwp) WRITE(numout,*) 
    434                   IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0 
    435                   ! 
     433                  IF(lwp) WRITE(numout,*) '      orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0 
    436434               ENDIF 
    437435               ! 
    … …  
    443441            CALL iom_get ( inum, jpdom_data, 'Bathymetry', bathy ) 
    444442            CALL iom_close (inum) 
    445 !                                                            ! ===================== 
     443            !                                                ! ===================== 
    446444            IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    447                ii0 = 142   ;   ii1 = 142                     ! Close Halmera Strait   
    448                ij0 =  51   ;   ij1 =  53                     ! ===================== 
    449                DO ji = mi0(ii0), mi1(ii1) 
     445               ii0 = 142   ;   ii1 = 142                     ! ===================== 
     446               ij0 =  51   ;   ij1 =  53                      
     447               DO ji = mi0(ii0), mi1(ii1)                    ! Close Halmera Strait 
    450448                  DO jj = mj0(ij0), mj1(ij1) 
    451449                     bathy(ji,jj) = 0.0  
    … …  
    453451               END DO 
    454452               IF(lwp) WRITE(numout,*) 
    455                IF(lwp) WRITE(numout,*) '             orca_r1: Halmera strait closed at i=',ii0,' j=',ij0,'->',ij1 
     453               IF(lwp) WRITE(numout,*) '      orca_r1: Halmera strait closed at i=',ii0,' j=',ij0,'->',ij1 
    456454            ENDIF 
    457455            !                                                ! ===================== 
    458456            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    459457               !                                             ! ===================== 
    460               IF( n_cla == 0 ) THEN 
    461                  ! 
    462                  ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open  
    463                  ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995) 
     458              IF( nn_cla == 0 ) THEN 
     459                 ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open  
     460                 ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995) 
    464461                 DO ji = mi0(ii0), mi1(ii1) 
    465462                    DO jj = mj0(ij0), mj1(ij1) 
    … …  
    468465                 END DO 
    469466                 IF(lwp) WRITE(numout,*) 
    470                  IF(lwp) WRITE(numout,*) '             orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 
     467                 IF(lwp) WRITE(numout,*) '      orca_r2: Gibraltar strait open at i=',ii0,' j=',ij0 
    471468                 ! 
    472                  ii0 = 160   ;   ii1 = 160                  ! Bab el mandeb Strait open 
    473                  ij0 = 88    ;   ij1 = 88                   ! (Thomson, Ocean Modelling, 1995) 
     469                 ii0 = 160   ;   ii1 = 160                   ! Bab el mandeb Strait open 
     470                 ij0 = 88    ;   ij1 = 88                    ! (Thomson, Ocean Modelling, 1995) 
    474471                 DO ji = mi0(ii0), mi1(ii1) 
    475472                    DO jj = mj0(ij0), mj1(ij1) 
    … …  
    479476                 IF(lwp) WRITE(numout,*) 
    480477                 IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb strait open at i=',ii0,' j=',ij0 
    481                  ! 
    482478              ENDIF 
    483479              ! 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA/dtasal.F90

    r2287 r2392  
    44   !! Ocean data  :  read ocean salinity data from monthly atlas data 
    55   !!===================================================================== 
     6   !! History :  OPA  ! 1991-03  ()  Original code 
     7   !!             -   ! 1992-07  (M. Imbard) 
     8   !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT  
     9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module  
     10   !!            3.3  ! 2010-10  (C. Bricaud, S. Masson)  use of fldread 
     11   !!---------------------------------------------------------------------- 
    612#if defined key_dtasal   ||   defined key_esopa 
    713   !!---------------------------------------------------------------------- 
    … …  
    1016   !!   dta_sal      : read ocean salinity data 
    1117   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1318   USE oce             ! ocean dynamics and tracers 
    1419   USE dom_oce         ! ocean space and time domain 
    … …  
    2328   PRIVATE 
    2429 
    25    !! * Routine accessibility 
    26    PUBLIC dta_sal   ! called by step.F90 and inidta.F90 
     30   PUBLIC   dta_sal   ! called by step.F90 and inidta.F90 
    2731    
    28    !! * Shared module variables 
    2932   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    !: salinity data flag 
    3033   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   s_dta    !: salinity data at given time-step 
    3134 
    32    !! * Module variables 
    3335   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal       ! structure of input SST (file informations, fields read) 
    3436 
    … …  
    3840   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3941   !! $Id$  
    40    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     43   !!---------------------------------------------------------------------- 
    4344CONTAINS 
    44  
    45    !!---------------------------------------------------------------------- 
    46    !!   Default option:                                         NetCDF file 
    47    !!---------------------------------------------------------------------- 
    4845 
    4946   SUBROUTINE dta_sal( kt ) 
    … …  
    5451      !!              
    5552      !! ** Method  : - Read on unit numsdt the monthly salinity data interpo- 
    56       !!     lated onto the model grid. 
     53      !!                lated onto the model grid. 
    5754      !!              - At each time step, a linear interpolation is applied 
    58       !!     between two monthly values. 
    59       !! 
    60       !! History : 
    61       !!        !  91-03  ()  Original code 
    62       !!        !  92-07  (M. Imbard) 
    63       !!   9.0  !  02-06  (G. Madec)  F90: Free form and module  
     55      !!                between two monthly values. 
    6456      !!---------------------------------------------------------------------- 
    6557      INTEGER, INTENT(in) ::   kt             ! ocean time step 
    66        
     58      ! 
    6759      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies 
    6860      INTEGER ::   ik, ierror                     ! temporary integers 
    … …  
    7163#endif 
    7264      REAL(wp)::   zl 
    73        
    7465#if defined key_orca_lev10 
    7566      INTEGER ::   ikr, ikw, ikt, jjk  
    … …  
    8071      TYPE(FLD_N)              :: sn_sal 
    8172      LOGICAL , SAVE           :: linit_sal = .FALSE. 
     73      !! 
     74      NAMELIST/namdta_sal/   cn_dir, sn_sal 
    8275      !!---------------------------------------------------------------------- 
    83       NAMELIST/namdta_sal/cn_dir,sn_sal 
    8476      
    8577      ! 1. Initialization 
    … …  
    9183         cn_dir = './'             ! directory in which the model is executed 
    9284         ! ... default values (NB: frequency positive => hours, negative => months) 
    93          !            !   file    ! frequency !  variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    94          !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    95          sn_sal = FLD_N( 'salinity',  -1.  ,  'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''         ) 
    96  
    97          REWIND ( numnam )         ! ... read in namlist namdta_sal  
     85         !            !   file    ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     86         !            !   name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     87         sn_sal = FLD_N( 'salinity',  -1.     ,'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''         ) 
     88 
     89         REWIND ( numnam )         ! read in namlist namdta_sal  
    9890         READ( numnam, namdta_sal )  
    9991 
    … …  
    115107         IF( sn_sal%ln_tint )   ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 
    116108#endif 
    117          ! fill sf_sal with sn_sal and control print 
     109         !                         ! fill sf_sal with sn_sal and control print 
    118110         CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) 
    119111         linit_sal = .TRUE.         
    … …  
    132124 
    133125#if defined key_tradmp 
    134       IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
    135     
    136          !                                        ! ======================= 
    137          !                                        !  ORCA_R2 configuration 
    138          !                                        ! ======================= 
     126      IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN     !  ORCA_R2 configuration 
     127         ! 
    139128         ij0 = 101   ;   ij1 = 109 
    140129         ii0 = 141   ;   ii1 = 155    
    … …  
    147136            END DO 
    148137         END DO 
    149  
    150          IF( n_cla == 1 ) THEN  
     138         ! 
     139         IF( nn_cla == 1 ) THEN  
    151140            !                                         ! New salinity profile at Gibraltar 
    152141            il0 = 138   ;   il1 = 138    
    … …  
    230219         !                                  ! Mask 
    231220         s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:) 
    232          s_dta(:,:,jpk) = 0.  
     221         s_dta(:,:,jpk) = 0.e0 
    233222         IF( ln_zps ) THEN               ! z-coord. partial steps 
    234223            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    … …  
    254243         CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    255244      ENDIF 
    256  
     245      ! 
    257246   END SUBROUTINE dta_sal 
    258247 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DTA/dtatem.F90

    r2287 r2392  
    44   !! Ocean data  :  read ocean temperature data from monthly atlas data 
    55   !!===================================================================== 
     6   !! History :  OPA  ! 1991-03  ()  Original code 
     7   !!             -   ! 1992-07  (M. Imbard) 
     8   !!            8.0  ! 1999-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT  
     9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module  
     10   !!            3.3  ! 2010-10  (C. Bricaud, S. Masson)  use of fldread 
     11   !!---------------------------------------------------------------------- 
    612#if defined key_dtatem   ||   defined key_esopa 
    713   !!---------------------------------------------------------------------- 
    … …  
    1016   !!   dta_tem      : read ocean temperature data 
    1117   !!---l------------------------------------------------------------------- 
    12    !! * Modules used 
    1318   USE oce             ! ocean dynamics and tracers 
    1419   USE dom_oce         ! ocean space and time domain 
    … …  
    2227   PRIVATE 
    2328 
    24    !! * Routine accessibility 
    25    PUBLIC dta_tem   ! called by step.F90 and inidta.F90 
    26  
    27    !! * Shared module variables 
     29   PUBLIC   dta_tem    ! called by step.F90 and inidta.F90 
     30 
    2831   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag 
    2932   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  t_dta    !: temperature data at given time-step 
    3033 
    31    !! * Module variables 
    3234   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read) 
    3335 
    … …  
    3739   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3840   !! $Id$  
    39    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    40    !!---------------------------------------------------------------------- 
    41  
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     42   !!---------------------------------------------------------------------- 
    4243CONTAINS 
    43  
    44    !!---------------------------------------------------------------------- 
    45    !!   Default case                                            NetCDF file 
    46    !!---------------------------------------------------------------------- 
    4744 
    4845   SUBROUTINE dta_tem( kt ) 
    … …  
    6259      !! 
    6360      !! ** Action  :   define t_dta array at time-step kt 
    64       !! 
    65       !! History : 
    66       !!        !  91-03  ()  Original code 
    67       !!        !  92-07  (M. Imbard) 
    68       !!        !  99-10  (M.A. Foujols, M. Imbard)  NetCDF FORMAT  
    69       !!   8.5  !  02-09  (G. Madec)  F90: Free form and module 
    7061      !!---------------------------------------------------------------------- 
    7162      INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
    72  
     63      ! 
    7364      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies 
    7465      INTEGER ::   ik, ierror                     ! temporary integers 
    … …  
    8576      TYPE(FLD_N)              ::   sn_tem 
    8677      LOGICAL , SAVE           ::   linit_tem = .FALSE. 
     78      !! 
     79      NAMELIST/namdta_tem/   cn_dir, sn_tem 
    8780      !!---------------------------------------------------------------------- 
    88       NAMELIST/namdta_tem/cn_dir,sn_tem 
    8981  
    9082      ! 1. Initialization  
    … …  
    9688         cn_dir = './'       ! directory in which the model is executed 
    9789         ! ... default values (NB: frequency positive => hours, negative => months) 
    98          !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  ! 
    99          !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    100          sn_tem = FLD_N( 'temperature',  -1.  ,  'votemper',  .false.   , .true.  ,  'yearly'  , ''       , ''         ) 
    101  
    102          REWIND( numnam )         ! ... read in namlist namdta_tem  
     90         !            !   file    ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
     91         !            !   name    !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
     92         sn_tem = FLD_N( 'temperature',  -1.  , 'votemper',  .false.   , .true.  ,  'yearly'   , ''       , ''       ) 
     93 
     94         REWIND( numnam )          ! read in namlist namdta_tem  
    10395         READ( numnam, namdta_tem )  
    10496 
    … …  
    120112         IF( sn_tem%ln_tint )   ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 
    121113#endif 
    122          ! fill sf_tem with sn_tem and control print 
     114         !                         ! fill sf_tem with sn_tem and control print 
    123115         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 
    124116         linit_tem = .TRUE. 
    … …  
    138130          
    139131#if defined key_tradmp 
    140       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 
    141          !                                        ! ======================= 
    142          !                                        !  ORCA_R2 configuration 
    143          !                                        ! =======================  
     132      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN      !  ORCA_R2 configuration 
     133         ! 
    144134         ij0 = 101   ;   ij1 = 109 
    145135         ii0 = 141   ;   ii1 = 155 
    … …  
    151141            END DO 
    152142         END DO 
    153              
    154          IF( n_cla == 1 ) THEN  
     143         ! 
     144         IF( nn_cla == 1 ) THEN  
    155145            !                                         ! New temperature profile at Gibraltar 
    156146            il0 = 138   ;   il1 = 138 
    … …  
    175165               END DO 
    176166            END DO 
    177             ! 
    178167         ELSE 
    179168            !                                         ! Reduced temperature at Red Sea 
    … …  
    251240                     t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1) 
    252241                  ENDIF 
    253             END DO 
    254          END DO 
    255       ENDIF 
    256  
    257    ENDIF 
    258           
    259    IF( lwp .AND. kt == nit000 ) THEN 
    260       WRITE(numout,*) ' temperature Levitus ' 
    261       WRITE(numout,*) 
    262       WRITE(numout,*)'  level = 1' 
    263       CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    264       WRITE(numout,*)'  level = ', jpk/2 
    265       CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    266       WRITE(numout,*)'  level = ', jpkm1 
    267       CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    268    ENDIF 
    269  
     242               END DO 
     243            END DO 
     244         ENDIF 
     245         ! 
     246      ENDIF 
     247          
     248      IF( lwp .AND. kt == nit000 ) THEN 
     249         WRITE(numout,*) ' temperature Levitus ' 
     250         WRITE(numout,*) 
     251         WRITE(numout,*)'  level = 1' 
     252         CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     253         WRITE(numout,*)'  level = ', jpk/2 
     254         CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     255         WRITE(numout,*)'  level = ', jpkm1 
     256         CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     257      ENDIF 
     258      ! 
    270259   END SUBROUTINE dta_tem 
    271260 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2287 r2392  
    44   !! Ocean diagnostic variable : horizontal divergence and relative vorticity 
    55   !!============================================================================== 
     6   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code 
     7   !!            4.0  ! 1991-11  (G. Madec) 
     8   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions 
     9   !!            7.0  ! 1996-01  (G. Madec)  s-coordinates 
     10   !!            8.0  ! 1997-06  (G. Madec)  lateral boundary cond., lbc 
     11   !!            8.1  ! 1997-08  (J.M. Molines)  Open boundaries 
     12   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate 
     13   !!  NEMO      1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90 
     14   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries 
     15   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90 
     16   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries 
     17   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module 
     18   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here 
     19   !!---------------------------------------------------------------------- 
    620 
    721   !!---------------------------------------------------------------------- 
    … …  
    923   !!                vorticity fields 
    1024   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1225   USE oce             ! ocean dynamics and tracers 
    1326   USE dom_oce         ! ocean space and time domain 
     27   USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean 
     28   USE sbcrnf          ! river runoff  
     29   USE obc_oce         ! ocean lateral open boundary condition 
     30   USE cla             ! cross land advection             (cla_div routine) 
    1431   USE in_out_manager  ! I/O manager 
    15    USE obc_oce         ! ocean lateral open boundary condition 
    1632   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    17    USE sbcrnf         ! river runoff  
    18    USE sbc_oce, ONLY : ln_rnf   ! surface boundary condition: ocean 
    1933 
    2034   IMPLICIT NONE 
    2135   PRIVATE 
    2236 
    23    !! * Accessibility 
    24    PUBLIC div_cur    ! routine called by step.F90 and istate.F90 
     37   PUBLIC   div_cur    ! routine called by step.F90 and istate.F90 
    2538 
    2639   !! * Substitutions 
    … …  
    3043   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3144   !! $Id$  
    32    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    33    !!---------------------------------------------------------------------- 
    34  
     45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     46   !!---------------------------------------------------------------------- 
    3547CONTAINS 
    3648 
    … …  
    4860      !!      vorticity at before and now time-step 
    4961      !! 
    50       !! ** Method  :  
    51       !!      I.  divergence : 
     62      !! ** Method  : I.  divergence : 
    5263      !!         - save the divergence computed at the previous time-step 
    5364      !!      (note that the Asselin filter has not been applied on hdivb) 
    5465      !!         - compute the now divergence given by : 
    5566      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
    56       !!      above expression 
    57       !!         - apply lateral boundary conditions on hdivn  
    58       !!      II. vorticity : 
     67      !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla)  
     68      !!              II. vorticity : 
    5969      !!         - save the curl computed at the previous time-step 
    6070      !!            rotb = rotn 
    … …  
    6272      !!         - compute the now curl in tensorial formalism: 
    6373      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 
    64       !!         - apply lateral boundary conditions on rotn through a call 
    65       !!      of lbc_lnk routine. 
    6674      !!         - Coastal boundary condition: 'key_noslip_accurate' defined, 
    6775      !!      the no-slip boundary condition is computed using Schchepetkin 
    … …  
    6977      !!      For example, along east coast, the one-sided finite difference 
    7078      !!      approximation used for di[v] is: 
    71       !!         di[e2v vn] =  1/(e1f*e2f) 
    72       !!                    * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) ) 
     79      !!         di[e2v vn] =  1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) ) 
    7380      !! 
    7481      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence 
    7582      !!              - update rotb , rotn , the before & now rel. vorticity 
    76       !! 
    77       !! History : 
    78       !!   8.2  !  00-03  (G. Madec)  no slip accurate 
    79       !!   9.0  !  03-08  (G. Madec)  merged of cur and div, free form, F90 
    80       !!        !  05-01  (J. Chanut, A. Sellar) unstructured open boundaries 
    81       !! NEMO 3.3  !  2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module 
    82       !!---------------------------------------------------------------------- 
    83       !! * Arguments 
     83      !!---------------------------------------------------------------------- 
    8484      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    85        
    86       !! * Local declarations 
     85      ! 
    8786      INTEGER ::   ji, jj, jk     ! dummy loop indices 
    8887      INTEGER ::   ii, ij, jl     ! temporary integer 
    … …  
    102101      DO jk = 1, jpkm1                                 ! Horizontal slab 
    103102         !                                             ! =============== 
    104  
     103         ! 
    105104         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays 
    106105         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays 
    107  
     106         ! 
    108107         !                                             ! -------- 
    109108         ! Horizontal divergence                       !   div 
    … …  
    198197            DO ji = 1, fs_jpim1   ! vector opt. 
    199198               rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      & 
    200                                  - zwu(ji  ,jj+1) + zwu(ji,jj)  )   & 
    201                               * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 
     199                  &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) ) 
    202200            END DO 
    203201         END DO 
    … …  
    228226               * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 
    229227         END DO 
    230  
    231228         !                                             ! =============== 
    232229      END DO                                           !   End of slab 
    233230      !                                                ! =============== 
    234231 
    235       IF( ln_rnf )  CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     232      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     233      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (Update Hor. divergence) 
    236234       
    237235      ! 4. Lateral boundary conditions on hdivn and rotn 
    238236      ! ---------------------------------=======---====== 
    239       CALL lbc_lnk( hdivn, 'T', 1. )     ! T-point, no sign change 
    240       CALL lbc_lnk( rotn , 'F', 1. )     ! F-point, no sign change 
    241  
     237      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change) 
     238      ! 
    242239   END SUBROUTINE div_cur 
    243240    
    … …  
    259256      !!      - compute the now divergence given by : 
    260257      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
    261       !!      above expression 
    262       !!      - apply lateral boundary conditions on hdivn  
     258      !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla)  
    263259      !!              - Relavtive Vorticity : 
    264260      !!      - save the curl computed at the previous time-step (rotb = rotn) 
    … …  
    266262      !!      - compute the now curl in tensorial formalism: 
    267263      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] ) 
    268       !!      - apply lateral boundary conditions on rotn through a call to 
    269       !!      routine lbc_lnk routine. 
    270264      !!      Note: Coastal boundary condition: lateral friction set through 
    271265      !!      the value of fmask along the coast (see dommsk.F90) and shlat 
    … …  
    274268      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence 
    275269      !!              - update rotb , rotn , the before & now rel. vorticity 
    276       !! 
    277       !! History : 
    278       !!   1.0  !  87-06  (P. Andrich, D. L Hostis)  Original code 
    279       !!   4.0  !  91-11  (G. Madec) 
    280       !!   6.0  !  93-03  (M. Guyon)  symetrical conditions 
    281       !!   7.0  !  96-01  (G. Madec)  s-coordinates 
    282       !!   8.0  !  97-06  (G. Madec)  lateral boundary cond., lbc 
    283       !!   8.1  !  97-08  (J.M. Molines)  Open boundaries 
    284       !!   9.0  !  02-09  (G. Madec, E. Durand)  Free form, F90 
    285       !!        !  05-01  (J. Chanut) Unstructured open boundaries 
    286       !!---------------------------------------------------------------------- 
    287       !! * Arguments 
     270      !!---------------------------------------------------------------------- 
    288271      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    289        
    290       !! * Local declarations 
     272      ! 
    291273      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
    292274      REAL(wp) ::  zraur, zdep 
    … …  
    302284      DO jk = 1, jpkm1                                 ! Horizontal slab 
    303285         !                                             ! =============== 
    304  
     286         ! 
    305287         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays 
    306288         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays 
    307  
     289         ! 
    308290         !                                             ! -------- 
    309291         ! Horizontal divergence                       !   div  
    … …  
    312294            DO ji = fs_2, fs_jpim1   ! vector opt. 
    313295               hdivn(ji,jj,jk) =   & 
    314                   (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       & 
    315                    + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    & 
     296                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       & 
     297                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    & 
    316298                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    317299            END DO   
    … …  
    349331      !                                                ! =============== 
    350332 
    351       IF( ln_rnf )  CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     333      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     334      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field) 
    352335 
    353336      ! 4. Lateral boundary conditions on hdivn and rotn 
    354337      ! ---------------------------------=======---====== 
    355       CALL lbc_lnk( hdivn, 'T', 1. )       ! T-point, no sign change 
    356       CALL lbc_lnk( rotn , 'F', 1. )       ! F-point, no sign change 
    357  
     338      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )     ! lateral boundary cond. (no sign change) 
     339      ! 
    358340   END SUBROUTINE div_cur 
    359341    

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r2338 r2392  
    164164      !                        ! Control of timestep choice 
    165165      IF( lk_dynspg_ts .OR. lk_dynspg_exp ) THEN 
    166          IF( n_cla == 1 )   & 
    167            &   CALL ctl_stop( ' Crossland advection not implemented for this free surface formulation ' ) 
     166         IF( nn_cla == 1 )   CALL ctl_stop( 'Crossland advection not implemented for this free surface formulation' ) 
    168167      ENDIF 
    169168 
    170       !                        ! Control of momentum forulation 
     169      !                        ! Control of momentum formulation 
    171170      IF( lk_dynspg_ts .AND. lk_vvl ) THEN 
    172          IF( .NOT. ln_dynadv_vec )   & 
    173            &   CALL ctl_stop( ' Flux formulae not implemented for this free surface formulation ' ) 
     171         IF( .NOT.ln_dynadv_vec )   CALL ctl_stop( 'Flux form not implemented for this free surface formulation' ) 
    174172      ENDIF 
    175173 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2305 r2392  
    3939   USE bdydyn          ! Unstructured open boundaries condition (bdy_dyn routine)  
    4040   USE bdyvol          ! Unstructured open boundaries condition (bdy_vol routine) 
    41    USE cla_dynspg      ! cross land advection 
     41   USE cla             ! cross land advection 
    4242   USE in_out_manager  ! I/O manager 
    4343   USE lib_mpp         ! distributed memory computing library 
    … …  
    199199      CALL Agrif_dyn( kt )    ! Update velocities on each coarse/fine interfaces  
    200200#endif 
    201 #if defined key_orca_r2 
    202       IF( n_cla == 1 )   CALL dyn_spg_cla( kt )      ! Cross Land Advection (update (ua,va)) 
    203 #endif 
     201      IF( nn_cla == 1 )   CALL cla_dynspg( kt )      ! Cross Land Advection (update (ua,va)) 
    204202 
    205203      ! compute the next vertically averaged velocity (effect of the additional force not included) 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2287 r2392  
    1919   USE domvvl          ! Variable volume 
    2020   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    21    USE cla_div         ! cross land: hor. divergence      (div_cla routine) 
    2221   USE iom             ! I/O library 
    2322   USE restart         ! only for lrst_oce 
    … …  
    147146      ENDIF 
    148147      ! 
    149  
    150                          CALL div_cur( kt )           ! Horizontal divergence & Relative vorticity 
    151       IF( n_cla == 1 )   CALL div_cla( kt )           ! Cross Land Advection (Update Hor. divergence) 
    152  
     148      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity 
     149      ! 
    153150      z2dt = 2. * rdt                                 ! set time step size (Euler/Leapfrog) 
    154151      IF( neuler == 0 .AND. kt == nit000 )   z2dt =rdt 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r2287 r2392  
    2121   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine) 
    2222   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
     23   USE cla             ! cross land advection      (cla_traadv     routine) 
    2324   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    2425   USE in_out_manager  ! I/O manager 
    … …  
    2930   PRIVATE 
    3031 
    31    PUBLIC   tra_adv         ! routine called by step module 
    32    PUBLIC   tra_adv_init    ! routine called by opa module 
     32   PUBLIC   tra_adv        ! routine called by step module 
     33   PUBLIC   tra_adv_init   ! routine called by opa module 
    3334  
    34    !                                                   !!* Namelist namtra_adv * 
    35    LOGICAL ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag 
    36    LOGICAL ::   ln_traadv_tvd    = .FALSE.      ! TVD scheme flag 
    37    LOGICAL ::   ln_traadv_muscl  = .FALSE.      ! MUSCL scheme flag 
    38    LOGICAL ::   ln_traadv_muscl2 = .FALSE.      ! MUSCL2 scheme flag 
    39    LOGICAL ::   ln_traadv_ubs    = .FALSE.      ! UBS scheme flag 
    40    LOGICAL ::   ln_traadv_qck    = .FALSE.      ! QUICKEST scheme flag 
     35   !                                        !!* Namelist namtra_adv * 
     36   LOGICAL ::   ln_traadv_cen2   = .TRUE.    ! 2nd order centered scheme flag 
     37   LOGICAL ::   ln_traadv_tvd    = .FALSE.   ! TVD scheme flag 
     38   LOGICAL ::   ln_traadv_muscl  = .FALSE.   ! MUSCL scheme flag 
     39   LOGICAL ::   ln_traadv_muscl2 = .FALSE.   ! MUSCL2 scheme flag 
     40   LOGICAL ::   ln_traadv_ubs    = .FALSE.   ! UBS scheme flag 
     41   LOGICAL ::   ln_traadv_qck    = .FALSE.   ! QUICKEST scheme flag 
    4142 
    4243   INTEGER ::   nadv   ! choice of the type of advection scheme 
    4344 
    44    REAL(wp), DIMENSION(jpk) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    45       !                                ! except at nit000 (=rdttra) if neuler=0 
     45   REAL(wp), DIMENSION(jpk) ::   r2dt   ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
    4646 
    4747   !! * Substitutions 
    … …  
    5151   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5252   !! $Id$ 
    53    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     53   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5454   !!---------------------------------------------------------------------- 
    55  
    5655CONTAINS 
    5756 
    … …  
    6564      !!---------------------------------------------------------------------- 
    6665      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    67       !! 
     66      ! 
    6867      INTEGER ::   jk   ! dummy loop index 
    6968      REAL(wp), DIMENSION(jpi,jpj,jpk)   ::  zun, zvn, zwn   ! 3D workspace: effective transport 
    … …  
    7574         r2dt(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog) 
    7675      ENDIF 
     76      ! 
     77      IF( nn_cla == 1 )   CALL cla_traadv( kt )       !==  Cross Land Advection  ==! (hor. advection) 
     78      ! 
    7779      !                                               !==  effective transport  ==! 
    7880      DO jk = 1, jpkm1 
    … …  
    8486      ! 
    8587      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   & 
    86          &                  CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )      ! add the eiv transport (if necessary) 
     88         &              CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )          ! add the eiv transport (if necessary) 
    8789      ! 
    8890      CALL iom_put( "uoce_eff", zun )                                         ! output effective transport       
    … …  
    9799      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
    98100      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
    99  
    100101      ! 
    101102      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    … …  
    118119         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               & 
    119120            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    120          ! 
    121121      END SELECT 
    122  
     122      ! 
    123123      !                                              ! print mean trends (used for debugging) 
    124124      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    … …  
    137137      INTEGER ::   ioptio 
    138138      !! 
    139       NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,    & 
    140          &                 ln_traadv_muscl, ln_traadv_muscl2, & 
     139      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     & 
     140         &                 ln_traadv_muscl, ln_traadv_muscl2,  & 
    141141         &                 ln_traadv_ubs  , ln_traadv_qck 
    142142      !!---------------------------------------------------------------------- 
    … …  
    156156         WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs 
    157157         WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck    = ', ln_traadv_qck 
    158     ENDIF 
     158      ENDIF 
    159159 
    160160      ioptio = 0                      ! Parameter control 
    … …  
    168168 
    169169      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' ) 
    170  
    171       IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 )   & 
    172          &                CALL ctl_stop( 'cross-land advection only with 2nd order advection scheme' ) 
    173170 
    174171      !                              ! Set nadv 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r2364 r2392  
    757757      END IF 
    758758 
    759       IF( ( lk_trdmld ) .AND. ( n_cla == 1 ) ) THEN 
     759      IF( ( lk_trdmld ) .AND. ( nn_cla == 1 ) ) THEN 
    760760         WRITE(numout,cform_war) 
    761761         WRITE(numout,*) '                You set n_cla = 1. Note that the Mixed-Layer diagnostics  ' 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/cla.F90

    r2287 r2392  
    11MODULE cla 
    2    !!============================================================================== 
    3    !!                         ***  MODULE  cla  *** 
    4    !! Cross Land Advection : parameterize ocean exchanges through straits by a 
    5    !!                        specified advection across land. 
    6    !!============================================================================== 
     2   !!====================================================================== 
     3   !!                    ***  MODULE  cla  *** 
     4   !! Cross Land Advection : specific update of the horizontal divergence, 
     5   !!                        tracer trends and after velocity 
     6   !! 
     7   !!                 ---   Specific to ORCA_R2   --- 
     8   !! 
     9   !!====================================================================== 
     10   !! History :  1.0  ! 2002-11 (A. Bozec)  Original code 
     11   !!            3.2  ! 2009-07 (G. Madec)  merge cla, cla_div, tra_cla, cla_dynspg 
     12   !!                 !                     and correct a mpp bug reported by A.R. Porter 
     13   !!---------------------------------------------------------------------- 
    714#if defined key_orca_r2 
    815   !!---------------------------------------------------------------------- 
    9    !!   'key_orca_r2'   :                             ORCA R2 configuration 
     16   !!   'key_orca_r2'                                 global ocean model R2 
    1017   !!---------------------------------------------------------------------- 
    11    !!   tra_cla           : update the tracer trend with the horizontal  
    12    !!                       and vertical advection trends at straits 
    13    !!   tra_bab_el_mandeb :  
    14    !!   tra_gibraltar     : 
    15    !!   tra_hormuz        : 
    16    !!   tra_cla_init      : 
     18   !!   cla_div           : update of horizontal divergence at cla straits 
     19   !!   tra_cla           : update of tracers at cla straits 
     20   !!   cla_dynspg        : update of after horizontal velocities at cla straits 
     21   !!   cla_init          : initialisation - control check 
     22   !!   cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait 
     23   !!   cla_gibraltar     : cross land advection for Gibraltar strait 
     24   !!   cla_hormuz        : cross land advection for Hormuz strait 
    1725   !!---------------------------------------------------------------------- 
    18    !! * Modules used 
    19    USE oce             ! ocean dynamics and tracers variables 
    20    USE dom_oce         ! ocean space and time domain variables  
    21    USE sbc_oce         ! surface boundary condition: ocean 
    22    USE in_out_manager  ! I/O manager 
    23    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    24    USE lib_mpp         ! distributed memory computing 
     26   USE oce            ! ocean dynamics and tracers 
     27   USE dom_oce        ! ocean space and time domain 
     28   USE sbc_oce        ! surface boundary condition: ocean 
     29   USE dynspg_oce     ! ocean dynamics: surface pressure gradient variables 
     30   USE in_out_manager ! I/O manager 
     31   USE lib_mpp        ! distributed memory computing library 
     32   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    2533 
    2634   IMPLICIT NONE 
    2735   PRIVATE 
    28  
    29    !! * Routine accessibility 
    30    PUBLIC tra_cla        ! routine called by step.F90 
    31    PUBLIC tra_cla_init   ! routine called by opa.F90 
    32  
    33    !! * Modules variables    
    34    REAL(wp) :: zempmed, zempred 
    35  
    36    REAL(wp) :: zisw_rs, zurw_rs, zbrw_rs          ! Imposed transport Red Sea  
    37    REAL(wp) :: zisw_ms, zmrw_ms, zurw_ms, zbrw_ms ! Imposed transport Med Sea  
    38    REAL(wp) :: zisw_pg, zbrw_pg                   ! Imposed transport Persic Gulf  
    39  
    40    REAL(wp), DIMENSION(jpk) ::   & 
    41       zu1_rs_i, zu2_rs_i, zu3_rs_i,              &  ! Red Sea velocities 
    42       zu1_ms_i, zu2_ms_i, zu3_ms_i,              &  ! Mediterranean Sea velocities 
    43       zu_pg                                         ! Persic Gulf velocities 
    44    REAL(wp), DIMENSION (jpk) :: zthor, zshor        ! Temperature, salinity Hormuz  
     36    
     37   PUBLIC   cla_init     ! routine called by opa.F90 
     38   PUBLIC   cla_div      ! routine called by divcur.F90 
     39   PUBLIC   cla_traadv   ! routine called by traadv.F90 
     40   PUBLIC   cla_dynspg   ! routine called by dynspg_flt.F90 
     41 
     42   INTEGER  ::   nbab, ngib, nhor   ! presence or not of required grid-point on local domain 
     43   !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits 
     44    
     45   !                                                              !!! profile of hdiv for some straits 
     46   REAL(wp), DIMENSION (jpk) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(172,101) 
     47   REAL(wp), DIMENSION (jpk) ::   hdiv_139_102                     ! Gibraltar     strait, fixed part only            (i,j)=(139,102) 
     48   REAL(wp), DIMENSION (jpk) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     strait, fixed & time evolving part (i,j)=(141,102) 
     49   REAL(wp), DIMENSION (jpk) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(161,88) 
     50   REAL(wp), DIMENSION (jpk) ::   hdiv_161_87                      ! Bab-el-Mandeb strait, fixed part only            (i,j)=(161,87) 
     51   REAL(wp), DIMENSION (jpk) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb strait, fixed & time evolving part (i,j)=(160,89) 
     52   REAL(wp), DIMENSION (jpk) ::   hdiv_172_94                      ! Hormuz        strait, fixed part only            (i,j)=(172, 94) 
     53 
     54   REAL(wp), DIMENSION (jpk) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in the Hormuz strait 
    4555    
    4656   !! * Substitutions 
    4757#  include "domzgr_substitute.h90" 
    48 #  include "vectopt_loop_substitute.h90" 
    4958   !!---------------------------------------------------------------------- 
    5059   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5160   !! $Id$ 
    52    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     61   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5362   !!---------------------------------------------------------------------- 
    54  
    5563CONTAINS 
    5664 
    57    SUBROUTINE tra_cla( kt ) 
     65   SUBROUTINE cla_div( kt ) 
     66      !!---------------------------------------------------------------------- 
     67      !!                 ***  ROUTINE div_cla  *** 
     68      !! 
     69      !! ** Purpose :   update the horizontal divergence of the velocity field 
     70      !!              at some straits ( Gibraltar, Bab el Mandeb and Hormuz ). 
     71      !! 
     72      !! ** Method  : - first time-step: initialisation of cla 
     73      !!              - all   time-step: using imposed transport at each strait,  
     74      !!              the now horizontal divergence is updated 
     75      !! 
     76      !! ** Action  :   phdivn   updted now horizontal divergence at cla straits 
     77      !!---------------------------------------------------------------------- 
     78      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     79      !!---------------------------------------------------------------------- 
     80      !      
     81      IF( kt == nit000 ) THEN 
     82         ! 
     83         CALL cla_init                                        ! control check  
     84         ! 
     85         IF(lwp) WRITE(numout,*) 
     86         IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv ' 
     87         IF(lwp) WRITE(numout,*) '~~~~~~~~' 
     88         ! 
     89         IF( nbab == 1 )   CALL cla_bab_el_mandeb('ini')    ! Bab el Mandeb ( Red Sea - Indian ocean ) 
     90         IF( ngib == 1 )   CALL cla_gibraltar    ('ini')    ! Gibraltar strait (Med Sea - Atlantic ocean) 
     91         IF( nhor == 1 )   CALL cla_hormuz       ('ini')    ! Hormuz Strait ( Persian Gulf - Indian ocean ) 
     92         ! 
     93      ENDIF                            
     94      ! 
     95      IF( nbab == 1    )   CALL cla_bab_el_mandeb('div')    ! Bab el Mandeb ( Red Sea - Indian ocean ) 
     96      IF( ngib == 1    )   CALL cla_gibraltar    ('div')    ! Gibraltar strait (Med Sea - Atlantic ocean) 
     97      IF( nhor == 1    )   CALL cla_hormuz       ('div')    ! Hormuz Strait ( Persian Gulf - Indian ocean ) 
     98      ! 
     99!!gm  lbc useless here, no? 
     100!!gm      CALL lbc_lnk( hdivn, 'T', 1. )                    ! Lateral boundary conditions on hdivn 
     101      ! 
     102   END SUBROUTINE cla_div 
     103    
     104    
     105   SUBROUTINE cla_traadv( kt ) 
    58106      !!---------------------------------------------------------------------- 
    59107      !!                 ***  ROUTINE tra_cla  *** 
    … …  
    63111      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ). 
    64112      !! 
    65       !! ** Method  :   ... 
    66       !!         Add this trend now to the general trend of tracer (ta,sa): 
    67       !!            (ta,sa) = (ta,sa) + ( zta , zsa ) 
    68       !! 
    69       !! ** Action  :   update (ta,sa) with the now advective tracer trends 
    70       !! 
    71       !! History : 
    72       !!        !         (A. Bozec)  original code   
    73       !!   8.5  !  02-11  (A. Bozec)  F90: Free form and module 
    74       !!---------------------------------------------------------------------- 
    75       !! * Arguments 
     113      !! ** Method  :   using both imposed transport at each strait and T & S 
     114      !!              budget, the now tracer trends is updated 
     115      !! 
     116      !! ** Action  :   (ta,sa)   updated now tracer trends at cla straits 
     117      !!---------------------------------------------------------------------- 
    76118      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    77119      !!---------------------------------------------------------------------- 
    78   
    79       ! Bab el Mandeb strait horizontal advection 
    80  
    81       CALL tra_bab_el_mandeb  
    82  
    83       ! Gibraltar strait horizontal advection 
    84  
    85       CALL tra_gibraltar 
    86  
    87       ! Hormuz Strait ( persian Gulf) horizontal advection 
    88  
    89       CALL tra_hormuz  
    90  
    91    END SUBROUTINE tra_cla 
    92  
    93  
    94    SUBROUTINE tra_bab_el_mandeb 
     120      ! 
     121      IF( kt == nit000 ) THEN  
     122         IF(lwp) WRITE(numout,*) 
     123         IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers ' 
     124         IF(lwp) WRITE(numout,*) '~~~~~~~~' 
     125      ENDIF 
     126      ! 
     127      IF( nbab == 1    )   CALL cla_bab_el_mandeb('tra')      ! Bab el Mandeb strait 
     128      IF( ngib == 1    )   CALL cla_gibraltar    ('tra')      ! Gibraltar strait 
     129      IF( nhor == 1    )   CALL cla_hormuz       ('tra')      ! Hormuz Strait ( Persian Gulf) 
     130      ! 
     131   END SUBROUTINE cla_traadv 
     132 
     133    
     134   SUBROUTINE cla_dynspg( kt ) 
     135      !!---------------------------------------------------------------------- 
     136      !!                 ***  ROUTINE cla_dynspg  *** 
     137      !!                    
     138      !! ** Purpose :   Update the after velocity at some straits  
     139      !!              (Bab el Mandeb, Gibraltar, Hormuz). 
     140      !! 
     141      !! ** Method  :   required to compute the filtered surface pressure gradient  
     142      !! 
     143      !! ** Action  :   (ua,va)   after velocity at the cla straits 
     144      !!---------------------------------------------------------------------- 
     145      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
     146      !!---------------------------------------------------------------------- 
     147      ! 
     148      IF( kt == nit000 ) THEN  
     149         IF(lwp) WRITE(numout,*) 
     150         IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) ' 
     151         IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     152      ENDIF 
     153      ! 
     154      IF( nbab == 1    )   CALL cla_bab_el_mandeb('spg')      ! Bab el Mandeb strait 
     155      IF( ngib == 1    )   CALL cla_gibraltar    ('spg')      ! Gibraltar strait 
     156      IF( nhor == 1    )   CALL cla_hormuz       ('spg')      ! Hormuz Strait ( Persian Gulf) 
     157      ! 
     158!!gm lbc is needed here, not? 
     159!!gm      CALL lbc_lnk( hdivn, 'U', -1. )   ;   CALL lbc_lnk( hdivn, 'V', -1. )      ! Lateral boundary conditions  
     160      ! 
     161   END SUBROUTINE cla_dynspg 
     162 
     163 
     164   SUBROUTINE cla_init 
     165      !! ------------------------------------------------------------------- 
     166      !!                   ***  ROUTINE cla_init  *** 
     167      !!            
     168      !! ** Purpose :   control check for mpp computation   
     169      !! 
     170      !! ** Method  : - All the strait grid-points must be inside one of the  
     171      !!              local domain interior for the cla advection to work 
     172      !!              properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ). 
     173      !!              Define the corresponding indicators (nbab, ngib, nhor) 
     174      !!              - The profiles of cross-land fluxes are currently hard 
     175      !!              coded for L31 levels. Stop if jpk/=31 
     176      !! 
     177      !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not 
    95178      !!--------------------------------------------------------------------- 
    96       !!             ***  ROUTINE tra_bab_el_mandeb  *** 
    97       !! 
    98       !! ** Purpose :   Update the horizontal advective trend of tracers 
    99       !!      correction in Bab el Mandeb strait and 
    100       !!      add it to the general trend of tracer equations. 
     179      REAL(wp) ::   ztemp 
     180      !!--------------------------------------------------------------------- 
     181      ! 
     182      IF(lwp) WRITE(numout,*) 
     183      IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation ' 
     184      IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
     185      ! 
     186      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' ) 
     187      ! 
     188      IF( lk_vvl    )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' ) 
     189      ! 
     190      IF( jpk /= 31 )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' ) 
     191      ! 
     192      !                                        _|_______|_______|_ 
     193      !                                     89  |       |///////|   
     194      !                                        _|_______|_______|_ 
     195      ! ------------------------ !          88  |///////|       |  
     196      !   Bab el Mandeb strait   !             _|_______|_______|_ 
     197      ! ------------------------ !          87  |///////|       |  
     198      !                                        _|_______|_______|_ 
     199      !                                         |  160  |  161  |   
     200      ! 
     201      ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the 
     202      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1) 
     203      nbab = 0 
     204      IF(  ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND.    &  !* (161,89), (161,88) and (161,88) on the local pocessor 
     205         & ( 1 <= mi0(160) .AND. mi1(161) <= jpi )       )    nbab = 1  
     206      ! 
     207      ! test if there is no local domain that includes all required grid-points 
     208      ztemp = REAL( nbab ) 
     209      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value 
     210      IF( ztemp == 0 ) THEN                     ! Only 2 points in each direction, this should never be a problem 
     211         CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' ) 
     212      ENDIF 
     213      !                                        ___________________________ 
     214      ! ------------------------ !         102  |       |///////|       | 
     215      !     Gibraltar strait     !             _|_______|_______|_______|_ 
     216      ! ------------------------ !         101  |       |///////|       | 
     217      !                                        _|_______|_______|_______|_  
     218      !                                         |  139  |  140  |  141  | 
     219      ! 
     220      ! The 6 Gibraltar grid-points must be inside one of the interior of the 
     221      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1) 
     222      ngib = 0 
     223      IF(  ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND.    &  !* (139:141,101:102) on the local pocessor 
     224         & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 )       )    ngib = 1  
     225      ! 
     226      ! test if there is no local domain that includes all required grid-points 
     227      ztemp = REAL( ngib ) 
     228      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value 
     229      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting 
     230           CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' ) 
     231      ENDIF 
     232      !                                        _______________ 
     233      ! ------------------------ !          94  |/////|     |  
     234      !       Hormuz strait      !             _|_____|_____|_ 
     235      ! ------------------------ !                171   172      
     236      !            
     237      ! The 2 Hormuz grid-points must be inside one of the interior of the 
     238      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1) 
     239      nhor = 0 
     240      IF(    2 <= mj0( 94) .AND. mj1( 94) <= jpjm1  .AND.  &  
     241         &   2 <= mi0(171) .AND. mi1(172) <= jpim1         )   nhor = 1  
     242      ! 
     243      ! test if there is no local domain that includes all required grid-points 
     244      ztemp = REAL( nhor ) 
     245      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value 
     246      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting 
     247           CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' ) 
     248      ENDIF 
     249      ! 
     250   END SUBROUTINE cla_init 
     251 
     252 
     253   SUBROUTINE cla_bab_el_mandeb( cd_td ) 
     254      !!---------------------------------------------------------------------- 
     255      !!                ***  ROUTINE cla_bab_el_mandeb  *** 
     256      !!        
     257      !! ** Purpose :   update the now horizontal divergence, the tracer tendancy 
     258      !!              and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean). 
     259      !! 
     260      !! ** Method  :   compute the exchanges at each side of the strait : 
     261      !! 
     262      !!       surf. zio_flow 
     263      !! (+ balance of emp) /\  |\\\\\\\\\\\| 
     264      !!                    ||  |\\\\\\\\\\\|   
     265      !!    deep zio_flow   ||  |\\\\\\\\\\\|   
     266      !!            |  ||   ||  |\\\\\\\\\\\|   
     267      !!        89  |  ||   ||  |\\\\\\\\\\\|   
     268      !!            |__\/_v_||__|____________  
     269      !!            !\\\\\\\\\\\|          surf. zio_flow 
     270      !!            |\\\\\\\\\\\|<===    (+ balance of emp) 
     271      !!            |\\\\\\\\\\\u 
     272      !!        88  |\\\\\\\\\\\|<---      deep  zrecirc (upper+deep at 2 different levels) 
     273      !!            |___________|__________    
     274      !!            !\\\\\\\\\\\|          
     275      !!            |\\\\\\\\\\\| ---\     deep  zrecirc (upper+deep)  
     276      !!        87  !\\\\\\\\\\\u ===/   + deep  zio_flow   (all at the same level) 
     277      !!            !\\\\\\\\\\\|   
     278      !!            !___________|__________  
     279      !!                160         161 
     280      !! 
     281      !!---------------------------------------------------------------------- 
     282      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence 
     283      !                                         ! ='tra' update the tracers 
     284      !                                         ! ='spg' update after velocity 
     285      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     286      REAL(wp) ::   zemp_red     ! temporary scalar 
     287      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot 
     288      !!--------------------------------------------------------------------- 
     289      ! 
     290      SELECT CASE( cd_td )  
     291      !                     ! ---------------- ! 
     292      CASE( 'ini' )         !  initialisation  !  
     293         !                  ! ---------------- !  
     294         !                                    
     295         zio_flow    = 0.4e6                       ! imposed in/out flow 
     296         zrecirc_upp = 0.2e6                       ! imposed upper recirculation water 
     297         zrecirc_bot = 0.5e6                       ! imposed bottom  recirculation water 
     298 
     299         hdiv_161_88(:) = 0.e0                     ! (161,88) Gulf of Aden side, north point 
     300         hdiv_161_87(:) = 0.e0                     ! (161,87) Gulf of Aden side, south point 
     301         hdiv_160_89(:) = 0.e0                     ! (160,89) Red sea side 
     302 
     303         DO jj = mj0(88), mj1(88)              !** profile of hdiv at (161,88)   (Gulf of Aden side, north point) 
     304            DO ji = mi0(161), mi1(161)         !------------------------------ 
     305               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0) 
     306                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     307               END DO 
     308               !                                   ! recirculation water   (Ind -> Red)   (div >0) 
     309               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) ) 
     310               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) ) 
     311            END DO 
     312         END DO 
     313         ! 
     314         DO jj = mj0(87), mj1(87)              !** profile of hdiv at (161,88)   (Gulf of Aden side, south point) 
     315            DO ji = mi0(161), mi1(161)         !------------------------------ 
     316               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0) 
     317               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) ) 
     318            END DO 
     319         END DO 
     320         ! 
     321         DO jj = mj0(89), mj1(89)              !** profile of hdiv at (161,88)   (Red sea side) 
     322            DO ji = mi0(160), mi1(160)         !------------------------------ 
     323               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0) 
     324                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     325               END DO 
     326               !                                   ! deep    outflow   (Red -> Ind)   (div >0) 
     327               hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) ) 
     328            END DO 
     329         END DO 
     330         !                  ! ---------------- ! 
     331      CASE( 'div' )         !   update hdivn   ! (call by divcur module) 
     332         !                  ! ---------=====-- !  
     333         !                                     !** emp on the Red Sea   (div >0)  
     334         zemp_red = 0.e0                       !--------------------- 
     335         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea 
     336            DO ji = mi0(148), mi1(160)  
     337               zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
     338            END DO 
     339         END DO 
     340         IF( lk_mpp )   CALL mpp_sum( zemp_red )   ! sum with other processors value 
     341         zemp_red = zemp_red * 1.e-3               ! convert in m3 
     342         ! 
     343         !                                     !** Correct hdivn (including emp adjustment) 
     344         !                                     !------------------------------------------- 
     345         DO jj = mj0(88), mj1(88)                  !* profile of hdiv at (161,88)   (Gulf of Aden side, north point) 
     346            DO ji = mi0(161), mi1(161)  
     347               hdiv_161_88_kt(:) = hdiv_161_88(:) 
     348               DO jk = 1, 8                              ! increase the inflow from the Indian   (div >0)  
     349                  hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     350               END DO 
     351               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:) 
     352            END DO 
     353         END DO 
     354         DO jj = mj0(87), mj1(87)                  !* profile of divergence at (161,87)   (Gulf of Aden side, south point) 
     355            DO ji = mi0(161), mi1(161)  
     356               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:) 
     357            END DO 
     358         END DO 
     359         DO jj = mj0(89), mj1(89)                  !* profile of divergence at (160,89)   (Red sea side) 
     360            DO ji = mi0(160), mi1(160)  
     361               hdiv_160_89_kt(:) = hdiv_160_89(:) 
     362               DO jk = 1, 18                              ! increase the inflow from the Indian   (div <0)  
     363                  hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) ) 
     364               END DO 
     365               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:) 
     366            END DO 
     367         END DO 
     368         !                  ! ---------------- ! 
     369      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module) 
     370         !                  ! --------=======- ! 
     371         ! 
     372         DO jj = mj0(88), mj1(88)              !** (161,88)   (Gulf of Aden side, north point) 
     373            DO ji = mi0(161), mi1(161)  
     374               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden) 
     375                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_161_88_kt(jk) * tn(ji,jj,jk) 
     376                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_161_88_kt(jk) * sn(ji,jj,jk) 
     377               END DO 
     378            END DO 
     379         END DO 
     380         DO jj = mj0(87), mj1(87)              !** (161,87)   (Gulf of Aden side, south point) 
     381            DO ji = mi0(161), mi1(161)  
     382               jk =  21                                 ! deep outflow + recirulation (combined flux) 
     383               ta(ji,jj,jk) = ta(ji,jj,jk) + hdiv_161_88(20) * tn(ji  ,jj+1,20)   &  ! upper recirculation from Gulf of Aden 
     384                  &                        + hdiv_161_88(21) * tn(ji  ,jj+1,21)   &  ! deep  recirculation from Gulf of Aden 
     385                  &                        + hdiv_160_89(16) * tn(ji-1,jj+2,16)      ! deep inflow from Red sea 
     386               sa(ji,jj,jk) = sa(ji,jj,jk) + hdiv_161_88(20) * sn(ji  ,jj+1,20)   & 
     387                  &                        + hdiv_161_88(21) * sn(ji  ,jj+1,21)   & 
     388                  &                        + hdiv_160_89(16) * sn(ji-1,jj+2,16)    
     389            END DO 
     390         END DO 
     391         DO jj = mj0(89), mj1(89)              !** (161,88)   (Red sea side) 
     392            DO ji = mi0(160), mi1(160) 
     393               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden) 
     394                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_160_89_kt(jk) * tn(ji+1,jj-1,jk) 
     395                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_160_89_kt(jk) * sn(ji+1,jj-1,jk) 
     396               END DO 
     397               !                                        ! deep    outflow (from Red sea) 
     398               ta(ji,jj,16) = ta(ji,jj,16) - hdiv_160_89(jk) * tn(ji,jj,jk) 
     399               sa(ji,jj,16) = sa(ji,jj,16) - hdiv_160_89(jk) * sn(ji,jj,jk) 
     400            END DO 
     401         END DO 
     402         ! 
     403         !                  ! ---------------- ! 
     404      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module) 
     405         !                  ! --------=======- ! 
     406         ! at this stage, (ua,va) are the after velocity, not the tendancy 
     407         ! compute the velocity from the divergence at T-point 
     408         ! 
     409         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point) 
     410            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point)  
     411               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   & 
     412                  &                              * e2u(ji,jj) * fse3u(ji,jj,:) 
     413            END DO 
     414         END DO 
     415         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point) 
     416            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point)  
     417               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   & 
     418                  &                           * e2u(ji,jj) * fse3u(ji,jj,:) 
     419            END DO 
     420         END DO 
     421         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side) 
     422            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point) 
     423               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   & 
     424                  &                              * e1v(ji,jj) * fse3v(ji,jj,:) 
     425            END DO 
     426         END DO 
     427      END SELECT 
     428      ! 
     429   END SUBROUTINE cla_bab_el_mandeb 
     430    
     431 
     432   SUBROUTINE cla_gibraltar( cd_td ) 
     433      !! ------------------------------------------------------------------- 
     434      !!                 ***  ROUTINE cla_gibraltar  *** 
     435      !!         
     436      !! ** Purpose :   update the now horizontal divergence, the tracer  
     437      !!              tendancyand the after velocity in vicinity of Gibraltar  
     438      !!              strait ( Persian Gulf - Indian ocean ). 
    101439      !! 
    102440      !! ** Method : 
    103       !!     We impose transport at Bab el Mandeb and knowing T and S in 
    104       !!     surface and depth at each side of the  strait, we deduce T and S 
    105       !!     of the deep outflow of the Red Sea in the Indian ocean .  
    106       !!                                          | 
    107       !!            |/ \|            N          |\ /| 
    108       !!            |_|_|______      |          |___|______ 
    109       !!        88  |   |<-       W - - E    88 |   |<- 
    110       !!        87  |___|______      |       87 |___|->____ 
    111       !!             160 161         S           160 161  
    112       !!       horizontal view                horizontal view 
    113       !!          surface                        depth 
    114       !!     
    115       !!     The horizontal advection is evaluated by a second order cen- 
    116       !!     tered scheme using now fields (leap-frog scheme). In specific 
    117       !!     areas (vicinity of major river mouths, some straits, or tn 
    118       !!     approaching the freezing point) it is mixed with an upstream  
    119       !!     scheme for stability reasons.  
    120       !! 
    121       !!         C A U T I O N : the trend saved is the centered trend only. 
    122       !!      It doesn't take into account the upstream part of the scheme. 
    123       !! 
    124       !! ** history : 
    125       !!           !  02-11  (A. Bozec) Original code  
    126       !!      8.5  !  02-11  (A. Bozec) F90: Free form and module 
     441      !!                     _______________________             
     442      !!      deep  zio_flow /====|///////|====> surf. zio_flow 
     443      !!    + deep  zrecirc  \----|///////|     (+balance of emp) 
     444      !! 102                      u///////u 
     445      !!      mid.  recicul    <--|///////|<==== deep  zio_flow 
     446      !!                     _____|_______|_____   
     447      !!      surf. zio_flow ====>|///////|        
     448      !!    (+balance of emp)     |///////| 
     449      !! 101                      u///////|              
     450      !!      mid.  recicul    -->|///////|               Caution: zrecirc split into  
     451      !!      deep  zrecirc  ---->|///////|                  upper & bottom recirculation 
     452      !!                   _______|_______|_______  
     453      !!                     139     140     141   
     454      !! 
    127455      !!--------------------------------------------------------------------- 
    128       !! * Local declarations 
    129       INTEGER ::  ji, jj, jk               ! dummy loop indices 
    130       REAL(wp) :: zsu, zvt 
    131       REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4 
    132       REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4 
    133       REAL(wp) :: zt, zs 
    134       REAL(wp) :: zwei 
    135       REAL(wp), DIMENSION (jpk) ::  zu1_rs, zu2_rs, zu3_rs 
     456      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence 
     457      !                                         ! ='tra' update the tracers 
     458      !                                         ! ='spg' update after velocity 
     459      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     460      REAL(wp) ::   zemp_med     ! temporary scalar 
     461      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot 
    136462      !!--------------------------------------------------------------------- 
    137  
    138       ! Initialization of vertical sum for T and S transport 
    139       ! ---------------------------------------------------- 
    140  
    141       zsumt  = 0.e0       ! East  Bab el Mandeb surface north point (T) 
    142       zsums  = 0.e0       ! East  Bab el Mandeb surface north point (S) 
    143       zsumt1 = 0.e0       ! East  Bab el Mandeb depth   south point (T) 
    144       zsums1 = 0.e0       ! East  Bab el Mandeb depth   south point (S) 
    145       zsumt2 = 0.e0       ! West  Bab el Mandeb surface             (T) 
    146       zsums2 = 0.e0       ! West  Bab el Mandeb surface             (S) 
    147       zsumt3 = 0.e0       ! West  Bab el Mandeb depth               (T) 
    148       zsums3 = 0.e0       ! West  Bab el Mandeb depth               (S) 
    149       zsumt4 = 0.e0       ! East  Bab el Mandeb depth   north point (T)  
    150       zsums4 = 0.e0       ! East  Bab el Mandeb depth   north point (S)  
    151        
    152       ! EMP of the Red Sea  
    153       ! ------------------ 
    154  
    155       zempred = 0.e0 
    156       zwei = 0.e0 
    157       DO jj = mj0(87), mj1(96) 
    158          DO ji = mi0(148), mi1(160) 
    159             zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj) 
    160             zempred = zempred + ( emp(ji,jj) - rnf(ji,jj) ) * zwei  
    161          END DO 
    162       END DO 
    163       IF( lk_mpp )   CALL mpp_sum( zempred )      ! sum with other processors value 
    164  
    165       ! convert in m3 
    166       zempred = zempred * 1.e-3 
    167  
    168       ! Velocity profile at each point 
    169       ! ------------------------------ 
    170  
    171       zu1_rs(:) = zu1_rs_i(:) 
    172       zu2_rs(:) = zu2_rs_i(:) 
    173       zu3_rs(:) = zu3_rs_i(:) 
    174  
    175       ! velocity profile at 161,88 East Bab el Mandeb North point  
    176       ! we imposed zisw_rs + EMP above the Red Sea  
    177       DO jk = 1, 8                                       
    178          DO jj = mj0(88), mj1(88)  
    179             DO ji = mi0(160), mi1(160)  
    180                zu1_rs(jk) = zu1_rs(jk) - ( zempred / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )      
    181             END DO 
    182          END DO 
    183       END DO 
    184  
    185       ! velocity profile at 161, 88 West Bab el Mandeb  
    186       ! we imposed zisw_rs + EMP above the Red Sea  
    187       DO jk = 1,  10                                      
    188          DO jj = mj0(88), mj1(88)  
    189             DO ji = mi0(160), mi1(160)  
    190                zu3_rs(jk) = zu3_rs(jk) + ( zempred / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) 
    191             END DO 
    192          END DO 
    193       END DO 
    194        
    195       ! Balance of temperature and salinity 
    196       ! ----------------------------------- 
    197  
    198       ! east Bab el Mandeb surface vertical sum of transport* S,T 
    199       DO jk =  1, 19 
    200          DO jj = mj0(88), mj1(88)  
    201             DO ji = mi0(161), mi1(161)  
    202                zsumt  = zsumt  + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)   
    203                zsums  = zsums  + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)  
    204             END DO 
    205          END DO 
    206       END DO 
    207  
    208       ! west Bab el Mandeb surface vertical sum of transport* S,T 
    209       DO jk =  1, 10 
    210          DO jj = mj0(88), mj1(88)  
    211             DO ji = mi0(161), mi1(161)  
    212                zsumt2 = zsumt2 + tn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk) 
    213                zsums2 = zsums2 + sn(ji,jj,jk) * e1v(ji-1,jj) * fse3v(ji-1,jj,jk) * zu3_rs(jk) 
    214             END DO 
    215          END DO 
    216       END DO 
    217  
    218       ! west Bab el Mandeb deeper 
    219       DO jj = mj0(89), mj1(89)  
    220          DO ji = mi0(160), mi1(160)  
    221             zsumt3 = tn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16) 
    222             zsums3 = sn(ji,jj,16) * e1v(ji,jj-1) * fse3v(ji,jj-1,16) * zu3_rs(16) 
    223          END DO 
    224       END DO 
    225  
    226       ! east  Bab el Mandeb deeper   
    227       DO jk =  20, 21 
    228          DO jj = mj0(88), mj1(88)  
    229             DO ji = mi0(161), mi1(161)  
    230                zsumt4 =  zsumt4 + tn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk) 
    231                zsums4 =  zsums4 + sn(ji,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * zu1_rs(jk)  
    232             END DO 
    233          END DO 
    234       END DO 
    235  
    236       ! Total transport   
    237       zsumt1 = -( zsumt3 + zsumt2 + zsumt + zsumt4 ) 
    238       zsums1 = -( zsums3 + zsums2 + zsums + zsums4 ) 
    239  
    240       ! Temperature and Salinity at East Bab el Mandeb, Level 21 
    241       DO jj = mj0(88), mj1(88)  
    242          DO ji = mi0(160), mi1(160)  
    243             zt = zsumt1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) ) 
    244             zs = zsums1 / ( zu2_rs(21) * e2u(ji,jj-1) * fse3u(ji,jj-1,21) ) 
    245          END DO 
    246       END DO 
    247        
    248       ! New Temperature and Salinity at East Bab el Mandeb 
    249       ! -------------------------------------------------- 
    250  
    251       ! north point   
    252       DO jk = 1, jpk 
    253          DO jj = mj0(88), mj1(88)  
    254             DO ji = mi0(161), mi1(161)  
    255                zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    256                zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk) 
    257                ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu1_rs(jk) * tn(ji,jj,jk) 
    258                sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu1_rs(jk) * sn(ji,jj,jk) 
    259             END DO 
    260          END DO 
    261       END DO 
    262  
    263       ! south point 
    264       jk =  21 
    265       DO jj = mj0(87), mj1(87)  
    266          DO ji = mi0(161), mi1(161)  
    267             zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    268             zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk) 
    269             ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu2_rs(jk) * zt 
    270             sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu2_rs(jk) * zs 
    271          END DO 
    272       END DO 
    273  
    274  
    275       ! New Temperature and Salinity at West Bab el Mandeb  
    276       ! -------------------------------------------------- 
    277  
    278       ! surface    
    279       DO jk = 1, 10 
    280          DO jj = mj0(89), mj1(89)  
    281             DO ji = mi0(160), mi1(160)  
    282                zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    283                zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk) 
    284                ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn(ji+1,jj-1,jk) 
    285                sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn(ji+1,jj-1,jk) 
    286             END DO 
    287          END DO 
    288       END DO 
    289       ! deeper 
    290       jk =  16 
    291       DO jj = mj0(89), mj1(89)  
    292          DO ji = mi0(160), mi1(160)  
    293             zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    294             zsu = e1v(ji,jj-1) * fse3v(ji,jj-1,jk) 
    295             ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * tn(ji,jj,jk) 
    296             sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu3_rs(jk) * sn(ji,jj,jk) 
    297          END DO 
    298       END DO 
    299  
    300    END SUBROUTINE tra_bab_el_mandeb 
    301  
    302  
    303    SUBROUTINE tra_gibraltar 
     463      ! 
     464      SELECT CASE( cd_td )  
     465      !                     ! ---------------- ! 
     466      CASE( 'ini' )         !  initialisation  !  
     467         !                  ! ---------------- !  
     468         !                                     !** initialization of the velocity 
     469         hdiv_139_101(:) = 0.e0                     !  139,101 (Atlantic side, south point) 
     470         hdiv_139_102(:) = 0.e0                     !  139,102 (Atlantic side, north point) 
     471         hdiv_141_102(:) = 0.e0                     !  141,102 (Med sea  side) 
     472             
     473         !                                     !** imposed transport 
     474         zio_flow    = 0.8e6                        ! inflow surface  water 
     475         zrecirc_mid = 0.7e6                        ! middle recirculation water 
     476         zrecirc_upp = 2.5e6                        ! upper  recirculation water 
     477         zrecirc_bot = 3.5e6                        ! bottom recirculation water 
     478         ! 
     479         DO jj = mj0(101), mj1(101)            !** profile of hdiv at 139,101 (Atlantic side, south point) 
     480            DO ji = mi0(139), mi1(139)         !----------------------------- 
     481               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0) 
     482                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     483               END DO 
     484               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)    
     485                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     486               END DO 
     487               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0) 
     488               hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     489               ! 
     490               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0) 
     491               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     492            END DO 
     493         END DO 
     494         DO jj = mj0(102), mj1(102)            !** profile of hdiv at 139,102 (Atlantic side, north point) 
     495            DO ji = mi0(139), mi1(139)         !----------------------------- 
     496               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)                 
     497                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     498               END DO 
     499               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0)  
     500               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     501            END DO 
     502         END DO 
     503         DO jj = mj0(102), mj1(102)            !** velocity profile at 141,102  (Med sea side) 
     504            DO ji = mi0(141), mi1(141)         !------------------------------ 
     505               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0) 
     506                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     507               END DO 
     508               !                                    ! deep    outflow toward the Atlantic    (div >0)  
     509               hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     510            END DO 
     511         END DO 
     512         !                  ! ---------------- ! 
     513      CASE( 'div' )         !   update hdivn   ! (call by divcur module) 
     514         !                  ! ---------=====-- !  
     515         !                                     !** emp on the Mediterranean Sea  (div >0)  
     516         zemp_med = 0.e0                       !------------------------------- 
     517         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea 
     518            DO ji = mi0(141),mi1(181) 
     519               zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)  
     520            END DO 
     521         END DO 
     522         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea  
     523            DO ji = mi0(148),mi1(148) 
     524               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
     525            END DO 
     526            DO ji = mi0(149),mi1(149) 
     527               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
     528            END DO 
     529         END DO 
     530         IF( lk_mpp )   CALL mpp_sum( zemp_med )    ! sum with other processors value 
     531         zemp_med = zemp_med * 1.e-3                ! convert in m3 
     532         ! 
     533         !                                     !** Correct hdivn (including emp adjustment) 
     534         !                                     !------------------------------------------- 
     535         DO jj = mj0(101), mj1(101)                 !* 139,101 (Atlantic side, south point) 
     536            DO ji = mi0(139), mi1(139)  
     537               hdiv_139_101_kt(:) = hdiv_139_101(:)       
     538               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0)  
     539                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     540               END DO 
     541               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:) 
     542            END DO 
     543         END DO 
     544         DO jj = mj0(102), mj1(102)                 !* 139,102 (Atlantic side, north point) 
     545            DO ji = mi0(139), mi1(139)  
     546               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:) 
     547            END DO 
     548         END DO 
     549         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side) 
     550            DO ji = mi0(141), mi1(141)  
     551               hdiv_141_102(:) = hdiv_141_102(:) 
     552               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0) 
     553                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     554               END DO 
     555               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:) 
     556            END DO 
     557         END DO 
     558         !                  ! ---------------- ! 
     559      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module) 
     560         !                  ! --------=======- ! 
     561         ! 
     562         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)   (div >0) 
     563            DO ji = mi0(139), mi1(139)  
     564               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)    
     565                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_101_kt(jk) * tn(ji,jj,jk) 
     566                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_101_kt(jk) * sn(ji,jj,jk) 
     567               END DO 
     568            END DO 
     569         END DO 
     570         ! 
     571         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)   (div <0) 
     572            DO ji = mi0(139), mi1(139)  
     573               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0) 
     574                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_102(jk) * tn(ji,jj-1,jk)  ! middle Atlantic recirculation 
     575                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_102(jk) * sn(ji,jj-1,jk) 
     576               END DO 
     577               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0) 
     578               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0) 
     579               ta(ji,jj,22) = ta(ji,jj,22) + hdiv_141_102(21) * tn(ji+2,jj  ,21)   &  ! deep Med flow   
     580                  &                        + hdiv_139_101(21) * tn(ji  ,jj-1,21)   &  ! upper  Atlantic recirculation   
     581                  &                        + hdiv_139_101(22) * tn(ji  ,jj-1,22)      ! bottom Atlantic recirculation   
     582               sa(ji,jj,22) = sa(ji,jj,22) + hdiv_141_102(21) * sn(ji+2,jj  ,21)   & 
     583                  &                        + hdiv_139_101(21) * sn(ji  ,jj-1,21)   & 
     584                  &                        + hdiv_139_101(22) * sn(ji  ,jj-1,22)  
     585            END DO 
     586         END DO 
     587         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)   (div <0) 
     588            DO ji = mi0(141), mi1(141)  
     589               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea 
     590                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_141_102_kt(jk) * tn(ji-2,jj-1,jk) 
     591                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_141_102_kt(jk) * sn(ji-2,jj-1,jk) 
     592               END DO 
     593               !                                         ! deeper flow from Med sea to Atlantic 
     594               ta(ji,jj,21) = ta(ji,jj,21) - hdiv_141_102(21) * tn(ji,jj,21) 
     595               sa(ji,jj,21) = sa(ji,jj,21) - hdiv_141_102(21) * sn(ji,jj,21) 
     596            END DO 
     597         END DO 
     598         !                  ! ---------------- ! 
     599      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module) 
     600         !                  ! --------=======- ! 
     601         ! at this stage, (ua,va) are the after velocity, not the tendancy 
     602         ! compute the velocity from the divergence at T-point 
     603         ! 
     604         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point) 
     605            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign 
     606               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   & 
     607                  &                             * e2u(ji,jj) * fse3u(ji,jj,:) 
     608            END DO 
     609         END DO 
     610         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point) 
     611            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign 
     612               ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   & 
     613                  &                          * e2u(ji,jj) * fse3u(ji,jj,:)    
     614            END DO 
     615         END DO 
     616         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point) 
     617            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign 
     618               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   & 
     619                  &                            * e2u(ji,jj) * fse3u(ji,jj,:) 
     620            END DO 
     621         END DO 
     622         ! 
     623      END SELECT 
     624      ! 
     625   END SUBROUTINE cla_gibraltar 
     626 
     627 
     628   SUBROUTINE cla_hormuz( cd_td ) 
     629      !! ------------------------------------------------------------------- 
     630      !!                   ***  ROUTINE div_hormuz  *** 
     631      !!               
     632      !! ** Purpose :   update the now horizontal divergence, the tracer  
     633      !!              tendancyand the after velocity in vicinity of Hormuz  
     634      !!              strait ( Persian Gulf - Indian ocean ). 
     635      !! 
     636      !! ** Method  :   Hormuz strait 
     637      !!            ______________    
     638      !!            |/////|<==      surface inflow 
     639      !!        94  |/////|      
     640      !!            |/////|==>      deep    outflow 
     641      !!            |_____|_______ 
     642      !!              171    172      
    304643      !!--------------------------------------------------------------------- 
    305       !!               ***  ROUTINE tra_gibraltar  *** 
    306       !! 
    307       !! ** Purpose : 
    308       !!        Update the horizontal advective trend of tracers (t & s) 
    309       !!        correction in Gibraltar  and 
    310       !!        add it to the general trend of tracer equations. 
    311       !! 
    312       !! ** Method : 
    313       !!      We impose transport at Gibraltar and knowing T and S in 
    314       !!      surface and deeper at each side of the strait, we deduce T and S 
    315       !!      of the outflow of the Mediterranean Sea in the Atlantic ocean . 
    316       !!                                 
    317       !!          ________________      N        ________________ 
    318       !! 102           |    |->         |           <-|    |<- 
    319       !! 101      ___->|____|_____   W - - E     ___->|____|_____ 
    320       !!           139   140  141       |         139   140  141 
    321       !!          horizontal view       S        horizontal view 
    322       !!            surface                          depth 
    323       !!         C A U T I O N : the trend saved is the centered trend only. 
    324       !!      It doesn't take into account the upstream part of the scheme. 
    325       !! 
    326       !! ** history : 
    327       !!           !  02-06  (A. Bozec) Original code  
    328       !!      8.5  !  02-11  (A. Bozec) F90: Free form and module 
     644      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='ini' initialisation 
     645      !!                                        ! ='div' update the divergence 
     646      !!                                        ! ='tra' update the tracers 
     647      !!                                        ! ='spg' update after velocity 
     648      !! 
     649      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     650      REAL(wp) ::   zio_flow     ! temporary scalar 
    329651      !!--------------------------------------------------------------------- 
    330       !! * Local declarations 
    331       INTEGER ::  ji, jj, jk               ! dummy loop indices 
    332       REAL(wp) :: zsu, zvt 
    333       REAL(wp) :: zsumt, zsumt1, zsumt2, zsumt3, zsumt4 
    334       REAL(wp) :: zsums, zsums1, zsums2, zsums3, zsums4 
    335       REAL(wp) :: zt, zs 
    336       REAL(wp) :: zwei 
    337       REAL(wp), DIMENSION (jpk) ::  zu1_ms, zu2_ms, zu3_ms 
    338       !!--------------------------------------------------------------------- 
    339        
    340       ! Initialization of vertical sum for T and S transport 
    341       ! ---------------------------------------------------- 
    342  
    343       zsumt  = 0.e0        ! West Gib. surface south point ( T ) 
    344       zsums  = 0.e0        ! West Gib. surface south point ( S ) 
    345       zsumt1 = 0.e0        ! East Gib. surface north point ( T ) 
    346       zsums1 = 0.e0        ! East Gib. surface north point ( S ) 
    347       zsumt2 = 0.e0        ! East Gib. depth   north point ( T ) 
    348       zsums2 = 0.e0        ! East Gib. depth   north point ( S ) 
    349       zsumt3 = 0.e0        ! West Gib. depth   south point ( T )  
    350       zsums3 = 0.e0        ! West Gib. depth   south point ( S )  
    351       zsumt4 = 0.e0        ! West Gib. depth   north point ( T )  
    352       zsums4 = 0.e0        ! West Gib. depth   north point ( S )  
    353        
    354       ! EMP of Mediterranean Sea  
    355       ! ------------------------ 
    356   
    357       zempmed = 0.e0 
    358       zwei = 0.e0 
    359       DO jj = mj0(96),mj1(110) 
    360          DO ji = mi0(141),mi1(181) 
    361             zwei    = tmask(ji,jj,1) * e1t(ji,jj) * e2t(ji,jj) 
    362             zempmed = zempmed + ( emp(ji,jj) - rnf(ji,jj) ) * zwei  
    363          END DO 
    364       END DO 
    365       IF( lk_mpp )   CALL mpp_sum( zempmed )      ! sum with other processors value 
    366  
    367  
    368       ! minus 2 points in Red Sea and 3 in Atlantic ocean 
    369       DO jj = mj0(96),mj1(96) 
    370          DO ji = mi0(148),mi1(148) 
    371             zempmed = zempmed  -  ( emp(ji  ,jj)-rnf(ji  ,jj) ) * tmask(ji  ,jj,1) * e1t(ji  ,jj) * e2t(ji  ,jj)   &  
    372                                -  ( emp(ji+1,jj)-rnf(ji+1,jj) ) * tmask(ji+1,jj,1) * e1t(ji+1,jj) * e2t(ji+1,jj)     
    373          END DO 
    374       END DO 
    375  
    376       ! convert in m3 
    377       zempmed = zempmed * 1.e-3 
    378  
    379       ! Velocity profile at each point 
    380       ! ------------------------------ 
    381  
    382       zu1_ms(:) = zu1_ms_i(:) 
    383       zu2_ms(:) = zu2_ms_i(:) 
    384       zu3_ms(:) = zu3_ms_i(:) 
    385  
    386       ! velocity profile at 139,101  South point + (emp-rnf) on surface  
    387       DO jk = 1, 14                       
    388          DO jj = mj0(102), mj1(102)  
    389             DO ji = mi0(140), mi1(140)  
    390                zu1_ms(jk) = zu1_ms(jk) + ( zempmed / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) )  
    391             END DO 
    392          END DO 
    393       END DO 
    394  
    395       ! profile at East Gibraltar     
    396       ! velocity profile at 141,102  + (emp-rnf) on surface  
    397       DO  jk = 1, 14                      
    398          DO jj = mj0(102), mj1(102)  
    399             DO ji = mi0(140), mi1(140)  
    400                zu3_ms(jk) = zu3_ms(jk) +  ( zempmed / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )  
    401             END DO 
    402          END DO 
    403       END DO 
    404       
    405       ! Balance of temperature and salinity 
    406       ! ----------------------------------- 
    407  
    408       ! west gibraltar surface vertical sum of transport* S,T 
    409       DO  jk =  1, 14  
    410          DO jj = mj0(101), mj1(101)  
    411             DO ji = mi0(139), mi1(139)  
    412                zsumt  = zsumt + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)   
    413                zsums  = zsums + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk)  
    414             END DO 
    415          END DO 
    416       END DO 
    417  
    418       ! east Gibraltar surface  vertical sum of transport* S,T 
    419       DO  jk =  1, 14  
    420          DO jj = mj0(101), mj1(101)  
    421             DO ji = mi0(139), mi1(139)  
    422                zsumt1 = zsumt1 + tn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk) 
    423                zsums1 = zsums1 + sn(ji, jj,jk) * e2u(ji+1, jj+1) * fse3u(ji+1, jj+1,jk) * zu3_ms(jk) 
    424             END DO 
    425          END DO 
    426       END DO 
    427  
    428       ! east Gibraltar deeper  vertical sum of transport* S,T 
    429       DO jj = mj0(102), mj1(102)  
    430          DO ji = mi0(141), mi1(141)  
    431             zsumt2 = tn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21) 
    432             zsums2 = sn(ji, jj,21) * e2u(ji-1, jj) * fse3u(ji-1, jj,21) * zu3_ms(21) 
    433          END DO 
    434       END DO 
    435        
    436       ! west Gibraltar deeper vertical sum of transport* S,T 
    437       DO  jk =  21, 22  
    438          DO jj = mj0(101), mj1(101)  
    439             DO ji = mi0(139), mi1(139)  
    440                zsumt3 = zsumt3 + tn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk) 
    441                zsums3 = zsums3 + sn(ji, jj,jk) * e2u(ji, jj) * fse3u(ji, jj,jk) * zu1_ms(jk) 
    442             END DO 
    443          END DO 
    444       END DO 
    445  
    446       ! Total transport = 0. 
    447       zsumt4 = zsumt2 + zsumt1 - zsumt - zsumt3 
    448       zsums4 = zsums2 + zsums1 - zsums - zsums3 
    449  
    450       ! Temperature and Salinity at West gibraltar , Level 22 
    451       DO jj = mj0(102), mj1(102)  
    452          DO ji = mi0(140), mi1(140)  
    453             zt = zsumt4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) ) 
    454             zs = zsums4 / ( zu2_ms(22) * e2u(ji-1, jj) * fse3u(ji-1, jj, 22) ) 
    455          END DO 
    456       END DO 
    457        
    458       ! New Temperature and Salinity trend at West Gibraltar 
    459       ! ---------------------------------------------------- 
    460  
    461       ! south point   
    462       DO jk = 1, 22 
    463          DO jj = mj0(101), mj1(101)  
    464             DO ji = mi0(139), mi1(139)  
    465                zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 
    466                zsu = e2u(ji, jj) * fse3u(ji, jj,jk) 
    467                ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu1_ms(jk) * tn(ji, jj,jk) 
    468                sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu1_ms(jk) * sn(ji, jj,jk) 
    469             END DO 
    470          END DO 
    471       END DO 
    472  
    473       ! north point  
    474       DO jk = 15, 20 
    475          DO jj = mj0(102), mj1(102)  
    476             DO ji = mi0(139), mi1(139)  
    477                zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 
    478                zsu = e2u(ji, jj) * fse3u(ji, jj,jk) 
    479                ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * tn(ji, jj-1,jk) 
    480                sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * sn(ji, jj-1,jk) 
    481             END DO 
    482          END DO 
    483       END DO 
    484  
    485       ! Gibraltar outflow, north point deeper 
    486       jk =  22 
    487       DO jj = mj0(102), mj1(102)  
    488          DO ji = mi0(139), mi1(139)  
    489             zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 
    490             zsu = e2u(ji, jj) * fse3u(ji, jj,jk) 
    491             ta(ji, jj,jk) = ta(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * zt 
    492             sa(ji, jj,jk) = sa(ji, jj,jk) - ( 1. / zvt ) * zsu * zu2_ms(jk) * zs 
    493          END DO 
    494       END DO 
    495  
    496  
    497       ! New Temperature and Salinity at East Gibraltar  
    498       ! ---------------------------------------------- 
    499  
    500       ! surface    
    501       DO jk = 1, 14 
    502          DO jj = mj0(102), mj1(102)  
    503             DO ji = mi0(141), mi1(141)  
    504                zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 
    505                zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk) 
    506                ta(ji, jj,jk) = ta(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn(ji-2, jj-1,jk) 
    507                sa(ji, jj,jk) = sa(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn(ji-2, jj-1,jk) 
    508             END DO 
    509          END DO 
    510       END DO 
    511       ! deeper 
    512       jk =  21 
    513       DO jj = mj0(102), mj1(102)  
    514          DO ji = mi0(141), mi1(141)  
    515             zvt = e1t(ji, jj) * e2t(ji, jj) * fse3t(ji, jj,jk) 
    516             zsu = e2u(ji-1, jj) * fse3u(ji-1, jj,jk) 
    517             ta(ji, jj,jk) = ta(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * tn(ji, jj,jk) 
    518             sa(ji, jj,jk) = sa(ji, jj,jk) + ( 1. / zvt ) * zsu * zu3_ms(jk) * sn(ji, jj,jk) 
    519          END DO 
    520       END DO 
    521  
    522    END SUBROUTINE tra_gibraltar 
    523  
    524  
    525    SUBROUTINE tra_hormuz 
    526       !!--------------------------------------------------------------------- 
    527       !!               ***  ROUTINE tra_hormuz  *** 
    528       !! 
    529       !! ** Purpose :   Update the horizontal advective trend of tracers 
    530       !!        correction in Hormuz. 
    531       !! 
    532       !! ** Method :   We impose transport at Hormuz . 
    533       !!                                 
    534       !! ** history : 
    535       !!           !  02-11  (A. Bozec) Original code  
    536       !!      8.5  !  02-11  (A. Bozec) F90: Free form and module 
    537       !!--------------------------------------------------------------------- 
    538       !! * Local declarations 
    539       INTEGER ::  ji, jj, jk              ! dummy loop indices 
    540       REAL(wp) :: zsu, zvt 
    541       !!--------------------------------------------------------------------- 
    542        
    543       ! New trend at Hormuz strait 
    544       ! -------------------------- 
    545       DO jk = 1, 8    
    546          DO jj = mj0(94), mj1(94)  
     652      ! 
     653      SELECT CASE( cd_td )  
     654      !                     ! ---------------- ! 
     655      CASE( 'ini' )         !  initialisation  !  
     656         !                  ! ---------------- !  
     657         !                                     !** profile of horizontal divergence due to cross-land advection 
     658         zio_flow  = 1.e6                          ! imposed in/out flow 
     659         ! 
     660         hdiv_172_94(:) = 0.e0          
     661         ! 
     662         DO jj = mj0(94), mj1(94)                  ! in/out flow at (i,j) = (172,94) 
    547663            DO ji = mi0(172), mi1(172)  
    548                zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    549                zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk) 
    550                ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * tn(ji,jj,jk)  
    551                sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * sn(ji,jj,jk)  
    552             END DO 
    553          END DO 
    554       END DO 
    555       DO jk = 16, 18 
    556          DO jj = mj0(94), mj1(94)  
     664               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0) 
     665                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     666               END DO 
     667               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0) 
     668                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     669               END DO 
     670            END DO 
     671         END DO 
     672         !                                     !** T & S profile in the Hormuz strait (use in deep outflow) 
     673         !      Temperature       and         Salinity 
     674         t_171_94_hor(:)  = 0.e0   ;   s_171_94_hor(:)  = 0.e0 
     675         t_171_94_hor(16) = 18.4   ;   s_171_94_hor(16) = 36.27 
     676         t_171_94_hor(17) = 17.8   ;   s_171_94_hor(17) = 36.4 
     677         t_171_94_hor(18) = 16.    ;   s_171_94_hor(18) = 36.27 
     678         ! 
     679         !                  ! ---------------- ! 
     680      CASE( 'div' )         !   update hdivn   ! (call by divcur module) 
     681         !                  ! ---------=====-- !  
     682         !                                    
     683         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side) 
    557684            DO ji = mi0(172), mi1(172)  
    558                zvt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    559                zsu = e2u(ji-1,jj) * fse3u(ji-1,jj,jk) 
    560                ta(ji,jj,jk) = ta(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * zthor(jk) 
    561                sa(ji,jj,jk) = sa(ji,jj,jk) + ( 1. / zvt ) * zsu * zu_pg(jk) * zshor(jk) 
    562             END DO 
    563          END DO 
    564       END DO 
    565  
    566    END SUBROUTINE tra_hormuz 
    567  
    568  
    569    SUBROUTINE tra_cla_init 
    570       !!--------------------------------------------------------------------- 
    571       !!               ***  ROUTINE tra_cla_init  *** 
    572       !! 
    573       !! ** Purpose :   Initialization of variables 
    574       !! 
    575       !! ** history : 
    576       !!      9.0  !  02-11  (A. Bozec) Original code 
    577       !!--------------------------------------------------------------------- 
    578       !! * Local declarations 
    579       INTEGER ::  ji, jj, jk              ! dummy loop indices 
    580       !!--------------------------------------------------------------------- 
    581  
    582       ! Control print 
    583       ! ------------- 
    584  
    585       IF(lwp) WRITE(numout,*) 
    586       IF(lwp) WRITE(numout,*) 'tra_cla_init : cross land advection on tracer ' 
    587       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    588  
    589       ! Initialization at Bab el Mandeb 
    590       ! ------------------------------- 
    591  
    592       ! imposed transport 
    593       zisw_rs = 0.4e6        ! inflow surface water 
    594       zurw_rs = 0.2e6        ! upper recirculation water 
    595 !!Alex      zbrw_rs = 1.2e6        ! bottom  recirculation water 
    596       zbrw_rs = 0.5e6        ! bottom  recirculation water 
    597  
    598       ! initialization of the velocity at Bab el Mandeb 
    599       zu1_rs_i(:) = 0.e0      ! velocity profile at 161,88 South point 
    600       zu2_rs_i(:) = 0.e0      ! velocity profile at 161,87 North point 
    601       zu3_rs_i(:) = 0.e0      ! velocity profile at 160,88 East  point 
    602  
    603       ! velocity profile at 161,88 East Bab el Mandeb North point  
    604       ! we imposed zisw_rs + EMP above the Red Sea  
    605       DO jk = 1, 8                                       
    606          DO jj = mj0(88), mj1(88)  
    607             DO ji = mi0(160), mi1(160)  
    608                zu1_rs_i(jk) = -( zisw_rs / 8. ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )      
    609             END DO 
    610          END DO 
    611       END DO 
    612  
    613       ! recirculation water  
    614       DO jj = mj0(88), mj1(88)  
    615          DO ji = mi0(160), mi1(160)  
    616             zu1_rs_i(20) = -(           zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,20) ) 
    617             zu1_rs_i(21) = -( zbrw_rs - zurw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) ) 
    618          END DO 
    619       END DO 
    620        
    621       ! velocity profile at 161,87 East Bab el Mandeb South point 
    622       DO jj = mj0(87), mj1(87)  
    623          DO ji = mi0(160), mi1(160)  
    624             zu2_rs_i(21) =  ( zbrw_rs + zisw_rs ) / ( e2u(ji,jj) * fse3u(ji,jj,21) ) 
    625          END DO 
    626       END DO 
    627  
    628       ! velocity profile at 161, 88 West Bab el Mandeb  
    629       ! we imposed zisw_rs + EMP above the Red Sea  
    630       DO jk = 1,  10                                      
    631          DO jj = mj0(88), mj1(88)  
    632             DO ji = mi0(160), mi1(160)  
    633                zu3_rs_i(jk) =  ( zisw_rs / 10. ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) 
    634             END DO 
    635          END DO 
    636       END DO 
    637  
    638       ! deeper 
    639       DO jj = mj0(88), mj1(88)  
    640          DO ji = mi0(160), mi1(160)  
    641             zu3_rs_i(16)  = - zisw_rs /( e1v(ji,jj) * fse3v(ji,jj,16) ) 
    642          END DO 
    643       END DO 
    644  
    645  
    646       ! Initialization at Gibraltar 
    647       ! --------------------------- 
    648  
    649       ! imposed transport 
    650       zisw_ms = 0.8e6         ! atlantic-mediterranean  water 
    651       zmrw_ms = 0.7e6         ! middle recirculation water 
    652       zurw_ms = 2.5e6         ! upper  recirculation water  
    653       zbrw_ms = 3.5e6         ! bottom recirculation water  
    654  
    655       ! initialization of the velocity 
    656       zu1_ms_i(:) = 0.e0       ! velocity profile at 139,101 South point 
    657       zu2_ms_i(:) = 0.e0       ! velocity profile at 139,102 North point 
    658       zu3_ms_i(:) = 0.e0       ! velocity profile at 141,102 East  point 
    659  
    660       ! velocity profile at 139,101  South point 
    661       DO jk = 1, 14                       
    662          DO jj = mj0(102), mj1(102)  
    663             DO ji = mi0(140), mi1(140)  
    664                zu1_ms_i(jk) = ( zisw_ms / 14. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk))  
    665             END DO 
    666          END DO 
    667       END DO 
    668  
    669       ! middle recirculation ( uncounting in the balance ) 
    670       DO jk = 15, 20                       
    671          DO jj = mj0(102), mj1(102)  
    672             DO ji = mi0(140), mi1(140)  
    673                zu1_ms_i(jk) = ( zmrw_ms / 6. ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,jk) )  
    674             END DO 
    675          END DO 
    676       END DO 
    677  
    678       DO jj = mj0(102), mj1(102)  
    679          DO ji = mi0(140), mi1(140)  
    680             zu1_ms_i(21) =  (           zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,21) ) 
    681             zu1_ms_i(22) =  ( zbrw_ms - zurw_ms ) / ( e2u(ji-1, jj-1) * fse3u(ji-1, jj-1,22) ) 
    682          END DO 
    683       END DO 
    684  
    685       ! velocity profile at 139,102  North point 
    686       ! middle recirculation ( uncounting in the balance ) 
    687       DO jk = 15, 20                       
    688          DO jj = mj0(102), mj1(102)  
    689             DO ji = mi0(140), mi1(140)  
    690                zu2_ms_i(jk) = -( zmrw_ms / 6. ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,jk) )  
    691             END DO 
    692          END DO 
    693       END DO  
    694  
    695       DO jj = mj0(102), mj1(102)  
    696          DO ji = mi0(140), mi1(140)  
    697             zu2_ms_i(22) = -( zisw_ms + zbrw_ms ) / ( e2u(ji-1, jj) * fse3u(ji-1, jj,22) ) 
    698          END DO 
    699       END DO  
    700  
    701       ! profile at East Gibraltar    
    702       ! velocity profile at 141,102  
    703       DO  jk = 1, 14                      
    704          DO jj = mj0(102), mj1(102)  
    705             DO ji = mi0(140), mi1(140)  
    706                zu3_ms_i(jk) =  ( zisw_ms / 14. ) / ( e2u(ji, jj) * fse3u(ji, jj,jk) )  
    707             END DO 
    708          END DO 
    709       END DO 
    710  
    711       ! deeper  
    712       DO jj = mj0(102), mj1(102)  
    713          DO ji = mi0(140), mi1(140)  
    714             zu3_ms_i(21) = -zisw_ms / ( e2u(ji, jj) * fse3u(ji, jj,21) ) 
    715          END DO 
    716       END DO 
    717  
    718  
    719       ! Initialization at Hormuz 
    720       ! ------------------------ 
    721  
    722       ! imposed transport 
    723       zisw_pg = 4. * 0.25e6      ! surface and bottom  water 
    724  
    725       ! initialization of the velocity 
    726       zu_pg(:) = 0.e0       ! velocity profile at 139,101 South point 
    727  
    728       ! Velocity profile  
    729       DO jk = 1, 8  
    730          DO jj = mj0(94), mj1(94)  
     685               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:) 
     686            END DO 
     687         END DO 
     688         !                  ! ---------------- ! 
     689      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module) 
     690         !                  ! --------=======- ! 
     691         !                           
     692         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side) 
    731693            DO ji = mi0(172), mi1(172)  
    732                zu_pg(jk) = -( zisw_pg / 8. ) /  ( e2u(ji-1,jj) * fse3u(ji-1,jj,jk) ) 
    733             END DO 
    734          END DO 
    735       END DO 
    736      DO jk = 16, 18 
    737          DO jj = mj0(94), mj1(94)  
    738             DO ji = mi0(172), mi1(172)  
    739                zu_pg(jk) =  ( zisw_pg / 3. )  / ( e2u(ji-1,jj) * fse3u(ji-1,jj,jk) ) 
    740             END DO 
    741          END DO 
    742       END DO 
    743  
    744       ! Temperature and Salinity at Hormuz 
    745       zthor(:) = 0.e0 
    746       zshor(:) = 0.e0 
    747  
    748       zthor(16) = 18.4 
    749       zshor(16) = 36.27 
    750       ! 
    751       zthor(17) = 17.8 
    752       zshor(17) = 36.4 
    753       ! 
    754       zthor(18) = 16. 
    755       zshor(18) = 36.27 
    756   
    757    END SUBROUTINE tra_cla_init 
    758  
     694               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0) 
     695                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * tn(ji,jj,jk)  
     696                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * sn(ji,jj,jk)  
     697               END DO 
     698               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0) 
     699                  ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * t_171_94_hor(jk) 
     700                  sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * s_171_94_hor(jk) 
     701               END DO 
     702            END DO 
     703         END DO 
     704         !                  ! ---------------- ! 
     705      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module) 
     706         !                  ! --------=======- ! 
     707         ! No barotropic flow through Hormuz strait 
     708         ! at this stage, (ua,va) are the after velocity, not the tendancy 
     709         ! compute the velocity from the divergence at T-point 
     710         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point) 
     711            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign 
     712               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   & 
     713                  &                           * e2u(ji,jj) * fse3u(ji,jj,:) 
     714            END DO 
     715         END DO 
     716         ! 
     717      END SELECT 
     718      ! 
     719   END SUBROUTINE cla_hormuz 
     720    
    759721#else 
    760722   !!---------------------------------------------------------------------- 
    761    !!   Default option                              NO cross land advection 
     723   !!   Default key                                            Dummy module 
    762724   !!---------------------------------------------------------------------- 
    763    USE in_out_manager  ! I/O manager 
     725   USE in_out_manager ! I/O manager 
    764726CONTAINS 
    765    SUBROUTINE tra_cla_init  
    766    END SUBROUTINE tra_cla_init 
    767    SUBROUTINE tra_cla( kt )  
    768       INTEGER, INTENT(in) ::   kt    ! ocean time-step indice 
    769       IF( kt == nit000 .AND. lwp ) THEN 
    770          WRITE(numout,*) 
    771          WRITE(numout,*) 'tra_cla : No use of cross land advection' 
    772          WRITE(numout,*) '~~~~~~~' 
    773       ENDIF 
    774    END SUBROUTINE tra_cla 
     727   SUBROUTINE cla_init 
     728      CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2 with 31 levels' ) 
     729   END SUBROUTINE cla_init 
     730   SUBROUTINE cla_div( kt ) 
     731      WRITE(*,*) 'cla_div: You should have not see this print! error?', kt 
     732   END SUBROUTINE cla_div 
     733   SUBROUTINE cla_traadv( kt )  
     734      WRITE(*,*) 'cla_traadv: You should have not see this print! error?', kt 
     735   END SUBROUTINE cla_traadv 
     736   SUBROUTINE cla_dynspg( kt )  
     737      WRITE(*,*) 'dyn_spg_cla: You should have not see this print! error?', kt 
     738   END SUBROUTINE cla_dynspg 
    775739#endif 
    776  
     740    
    777741   !!====================================================================== 
    778742END MODULE cla 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/opa.F90

    r2382 r2392  
    3838   USE step_oce        ! module used in the ocean time stepping module 
    3939   USE sbc_oce         ! surface boundary condition: ocean 
     40   USE cla             ! cross land advection               (tra_cla routine) 
    4041   USE domcfg          ! domain configuration               (dom_cfg routine) 
    4142   USE mppini          ! shared/distributed memory setting (mpp_init routine) 
    … …  
    4647   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine) 
    4748   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine) 
    48    USE zdfini 
     49   USE zdfini          ! vertical physics setting          (zdf_init routine) 
    4950   USE phycst          ! physical constant                  (par_cst routine) 
    5051   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine) 
    … …  
    6768   USE trcini          ! passive tracer initialisation 
    6869#endif 
    69  
    7070   USE lib_mpp         ! distributed memory computing 
    7171#if defined key_iomput 
    … …  
    8282   !!---------------------------------------------------------------------- 
    8383   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    84    !! $Id $ 
     84   !! $Id$ 
    8585   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8686   !!---------------------------------------------------------------------- 
    … …  
    277277                            CALL ldf_tra_init      ! Lateral ocean tracer physics 
    278278                            CALL ldf_dyn_init      ! Lateral ocean momentum physics 
    279       IF( lk_ldfslp )       CALL ldf_slp_init      ! slope of lateral mixing 
     279      IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing 
    280280 
    281281      !                                     ! Active tracers 
    … …  
    285285      IF( lk_tradmp     )   CALL tra_dmp_init   ! internal damping trends 
    286286                            CALL tra_adv_init   ! horizontal & vertical advection 
    287       IF( n_cla == 1    )   CALL tra_cla_init   ! Cross Land Advection (Update Hor. advection) 
    288287                            CALL tra_ldf_init   ! lateral mixing 
    289288                            CALL tra_zdf_init   ! vertical mixing and after tracer fields 
    … …  
    296295                            CALL dyn_zdf_init   ! vertical diffusion 
    297296                            CALL dyn_spg_init   ! surface pressure gradient 
     297                             
     298      !                                     ! Misc. options 
     299      IF( nn_cla == 1   )   CALL cla_init       ! Cross Land Advection 
     300       
    298301#if defined key_top 
    299302      !                                     ! Passive tracers 
    … …  
    302305      !                                     ! Diagnostics 
    303306                            CALL     iom_init   ! iom_put initialization 
    304       IF( lk_floats    )    CALL     flo_init   ! drifting Floats 
    305       IF( lk_diaar5    )    CALL dia_ar5_init   ! ar5 diag 
     307      IF( lk_floats     )   CALL     flo_init   ! drifting Floats 
     308      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag 
    306309                            CALL dia_ptr_init   ! Poleward TRansports initialization 
    307310                            CALL dia_hsb_init   ! heat content, salt content and volume budgets 
    308311                            CALL trd_mod_init   ! Mixed-layer/Vorticity/Integral constraints trends 
    309       IF( lk_diaobs    ) THEN                   ! Observation & model comparison 
     312      IF( lk_diaobs     ) THEN                  ! Observation & model comparison 
    310313                            CALL dia_obs_init            ! Initialize observational data 
    311314                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart 
    312315      ENDIF       
    313316      !                                     ! Assimilation increments 
    314       IF( lk_asminc    )    CALL asm_inc_init   ! Initialize assimilation increments 
     317      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    315318      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
    316319      ! 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/step.F90

    r2382 r2392  
    186186      IF( lk_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
    187187                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
    188       IF( n_cla == 1     )   CALL tra_cla    ( kstp )       ! Cross Land Advection (Update Hor. advection) 
    189188      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    190189                             CALL tra_ldf    ( kstp )       ! lateral mixing 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r2382 r2392  
    3131   USE traadv           ! advection scheme control     (tra_adv_ctl routine) 
    3232   USE traldf           ! lateral mixing                   (tra_ldf routine) 
    33    USE cla              ! cross land advection             (tra_cla routine) 
    3433   !   zdfkpp           ! KPP non-local tracer fluxes      (tra_kpp routine) 
    3534   USE trazdf           ! vertical mixing                  (tra_zdf routine) 
Note: See TracChangeset for help on using the changeset viewer.