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

Changeset 4616


Ignore:
Timestamp:
2014-04-06T17:28:25+02:00 (10 years ago)
Author:
gm
Message:

#1260 : see the associated wiki page for explanation

Location:
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC
Files:
1 added
78 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

    r4596 r4616  
    465465                     u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj)   & 
    466466                        &                                               - e1e2t(ji  ,jj) * hdiv(ji  ,jj) ) & 
    467                         &                                             / e1u(ji,jj) * umask(ji,jj,jk)  
     467                        &                                             * r1_e1u(ji,jj) * umask(ji,jj,jk)  
    468468                     v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1)   & 
    469469                        &                                               - e1e2t(ji,jj  ) * hdiv(ji,jj  ) ) & 
    470                         &                                             / e2v(ji,jj) * vmask(ji,jj,jk)  
     470                        &                                             * r1_e2v(ji,jj) * vmask(ji,jj,jk)  
    471471                  END DO 
    472472               END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r4292 r4616  
    1515   !!   'key_dynspg_flt'                              filtered free surface 
    1616   !!---------------------------------------------------------------------- 
    17    USE timing          ! Timing 
    1817   USE oce             ! ocean dynamics and tracers  
     18   USE bdy_oce         ! ocean open boundary conditions 
     19   USE sbc_oce         ! ocean surface boundary conditions 
    1920   USE dom_oce         ! ocean space and time domain  
    2021   USE phycst          ! physical constants 
    21    USE bdy_oce         ! ocean open boundary conditions 
     22   ! 
     23   USE in_out_manager  ! I/O manager 
    2224   USE lib_mpp         ! for mppsum 
    23    USE in_out_manager  ! I/O manager 
    24    USE sbc_oce         ! ocean surface boundary conditions 
     25   USE timing          ! Timing 
     26   USE lib_fortran     ! Fortran routines library 
    2527 
    2628   IMPLICIT NONE 
     
    3234#  include "domzgr_substitute.h90" 
    3335   !!---------------------------------------------------------------------- 
    34    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     36   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    3537   !! $Id$  
    3638   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    9092      ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 
    9193      ! ----------------------------------------------------------------------- 
    92       z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 
    93       IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain 
     94      z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
    9495 
    9596      ! Transport through the unstructured open boundary 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r4313 r4616  
    189189      IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    190190 
    191       area(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 
    192  
    193       area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot ) 
     191      area(:,:) = e1e2t(:,:) * tmask_i(:,:) 
     192 
     193      area_tot = glob_sum( area(:,:) ) 
    194194 
    195195      vol0        = 0._wp 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r4147 r4616  
    99   !!---------------------------------------------------------------------- 
    1010#if ! defined key_coupled 
    11   
    12    !!---------------------------------------------------------------------- 
    13    !!   Only for ORCA2 ORCA1 and ORCA025 
     11   !!---------------------------------------------------------------------- 
     12   !!   Only for ORCA2 ORCA1 and ORCA025 and not coupled case 
    1413   !!---------------------------------------------------------------------- 
    1514   !!---------------------------------------------------------------------- 
     
    2120   USE sbc_oce         ! ??? 
    2221   USE zdf_oce         ! ocean vertical physics 
     22   ! 
    2323   USE in_out_manager  ! I/O manager 
    2424   USE lib_mpp         ! distributed memory computing library 
     25   USE lib_fortran    ! Fortran utilities 
    2526   USE timing          ! preformance summary 
    2627 
     
    4445   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4546   !!---------------------------------------------------------------------- 
    46  
    4747CONTAINS 
    4848 
     
    7777         a_salb   = 0.e0 ! valeur de sal au debut de la simulation 
    7878         ! sshb used because diafwb called after tranxt (i.e. after the swap) 
    79          a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) ) 
    80          IF( lk_mpp )   CALL mpp_sum( a_sshb )      ! sum over the global domain 
     79         a_sshb = glob_sum(  e1e2t(:,:) * sshb(:,:)  )     ! sum over the global domain 
    8180 
    8281         DO jk = 1, jpkm1 
    8382            DO jj = 2, jpjm1 
    8483               DO ji = fs_2, fs_jpim1   ! vector opt. 
    85                   zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    86                   a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
     84                  zwei   = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     85                  a_salb = a_salb + zwei * ( tsb(ji,jj,jk,jp_sal) - zsm0 ) 
    8786               END DO 
    8887            END DO 
     
    9190      ENDIF 
    9291       
    93       a_fwf    = SUM( e1t(:,:) * e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) )  
    94       IF( lk_mpp )   CALL mpp_sum( a_fwf    )       ! sum over the global domain 
     92      a_fwf = glob_sum(  e1e2t(:,:) * ( emp(:,:)-rnf(:,:) )  )    ! sum over the global domain 
    9593 
    9694      IF( kt == nitend ) THEN 
     
    10199         zfwfnew = 0.e0 
    102100         ! Mean sea level at nitend 
    103          a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) ) 
    104          IF( lk_mpp )   CALL mpp_sum( a_sshn )      ! sum over the global domain 
    105          zarea  = SUM( e1t(:,:) * e2t(:,:) *             tmask_i(:,:) ) 
    106          IF( lk_mpp )   CALL mpp_sum( zarea  )      ! sum over the global domain 
     101         a_sshn = glob_sum( e1e2t(:,:) * sshn(:,:) )     ! sum over the global domain 
     102         zarea  = glob_sum( e1e2t(:,:) )                 ! sum over the global domain (tmask_i included) 
    107103          
    108104         DO jk = 1, jpkm1    
    109105            DO jj = 2, jpjm1 
    110106               DO ji = fs_2, fs_jpim1   ! vector opt. 
    111                   zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    112                   a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    113                   zvol  = zvol  + zwei 
     107                  zwei  = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     108                  a_saln = a_saln + zwei * ( tsn(ji,jj,jk,jp_sal) - zsm0 ) 
     109                  zvol   = zvol   + zwei 
    114110               END DO 
    115111            END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r4333 r4616  
    8080      CALL wrk_alloc( jpi, jpj, zsurf ) 
    8181   
    82       zsurf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area 
     82      zsurf(:,:) = e1e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area 
    8383       
    8484      ! ------------------------- ! 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r4596 r4616  
    188188      CALL lbc_lnk( z2d, 'T', 1. ) 
    189189      CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
    190 !CDIR NOVERRCHK 
    191190      z2d(:,:) = SQRT( z2d(:,:) ) 
    192191      CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r4488 r4616  
    157157   !! horizontal curvilinear coordinate and scale factors 
    158158   !! --------------------------------------------------------------------- 
    159    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamt, glamu   !: longitude of t-, u-, v- and f-points (degre) 
    160    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamv, glamf   !: 
    161    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre) 
    162    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !: 
    163    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m) 
    164    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m) 
    165    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m) 
    166    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m) 
    167    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2) 
    168    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
     159   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   glamt , glamu, glamv , glamf    !: longitude at t, u, v, f-points [degree] 
     160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   gphit , gphiu, gphiv , gphif    !: latitude  at t, u, v, f-points [degree] 
     161   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1t   , e2t  , r1_e1t, r1_e2t   !: t-point horizontal scale factors    [m] 
     162   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1u   , e2u  , r1_e1u, r1_e2u   !: horizontal scale factors at u-point [m] 
     163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1v   , e2v  , r1_e1v, r1_e2v   !: horizontal scale factors at v-point [m] 
     164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m] 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
     167   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
     168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
     169   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff                              !: coriolis factor                   [1/s] 
    169170 
    170171   !!---------------------------------------------------------------------- 
    171172   !! vertical coordinate and scale factors 
    172173   !! --------------------------------------------------------------------- 
    173    !                                 !!* Namelist namzgr : vertical coordinate * 
    174    LOGICAL, PUBLIC ::   ln_zco        !: z-coordinate - full step 
    175    LOGICAL, PUBLIC ::   ln_zps        !: z-coordinate - partial step 
    176    LOGICAL, PUBLIC ::   ln_sco        !: s-coordinate or hybrid z-s coordinate 
     174   !                            !!* Namelist namzgr : vertical coordinate * 
     175   LOGICAL, PUBLIC ::   ln_zco   !: z-coordinate - full step 
     176   LOGICAL, PUBLIC ::   ln_zps   !: z-coordinate - partial step 
     177   LOGICAL, PUBLIC ::   ln_sco   !: s-coordinate or hybrid z-s coordinate 
    177178 
    178179   !! All coordinates 
     
    214215   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0           !: reference depth at t-       points (meters) 
    215216   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_0 , hv_0    !: reference depth at u- and v-points (meters) 
    216    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   re2u_e1u       !: scale factor coeffs at u points (e2u/e1u) 
    217    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   re1v_e2v       !: scale factor coeffs at v points (e1v/e2v) 
    218    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12t , r1_e12t !: horizontal cell surface and inverse at t points 
    219    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12u , r1_e12u !: horizontal cell surface and inverse at u points 
    220    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12v , r1_e12v !: horizontal cell surface and inverse at v points 
    221    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e12f , r1_e12f !: horizontal cell surface and inverse at f points 
    222217 
    223218   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
     
    334329         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     & 
    335330         &                                      nleit(jpnij) , nlejt(jpnij) ,     & 
    336          &      mi0(jpidta)   , mi1 (jpidta),  mj0(jpjdta)   , mj1 (jpjdta),      & 
    337          &      tpol(jpiglo)  , fpol(jpiglo)                               , STAT=ierr(2) ) 
    338          ! 
    339       ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) ,                      &  
    340          &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) ,                      &   
    341          &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) ,     &   
    342          &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )      
     331         &      mi0(jpidta)   , mi1 (jpidta),  mj0(jpjdta)   , mj1 (jpjdta) ,     & 
     332         &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) ) 
     333         ! 
     334      ALLOCATE( glamt(jpi,jpj) ,    glamu(jpi,jpj) ,  glamv(jpi,jpj) ,  glamf(jpi,jpj) ,     & 
     335         &      gphit(jpi,jpj) ,    gphiu(jpi,jpj) ,  gphiv(jpi,jpj) ,  gphif(jpi,jpj) ,     & 
     336         &       e1t (jpi,jpj) ,     e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) ,     & 
     337         &       e1u (jpi,jpj) ,     e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) ,     & 
     338         &       e1v (jpi,jpj) ,     e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) ,     & 
     339         &       e1f (jpi,jpj) ,     e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) ,     & 
     340         &      e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj)                                     ,     & 
     341         &      e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj)                   ,     & 
     342         &      e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj)                   ,     & 
     343         &      e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj)                                     ,     & 
     344         &        ff (jpi,jpj)                                                         , STAT=ierr(3) ) 
    343345         ! 
    344346      ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) ,                         & 
     
    361363         ! 
    362364      ALLOCATE( hu      (jpi,jpj) , hur     (jpi,jpj) , hu_0(jpi,jpj) , ht_0  (jpi,jpj) ,     & 
    363          &      hv      (jpi,jpj) , hvr     (jpi,jpj) , hv_0(jpi,jpj) , ht    (jpi,jpj) ,     & 
    364          &      re2u_e1u(jpi,jpj) , re1v_e2v(jpi,jpj) ,                                       & 
    365          &      e12t    (jpi,jpj) , r1_e12t (jpi,jpj) ,                                       & 
    366          &      e12u    (jpi,jpj) , r1_e12u (jpi,jpj) ,                                       & 
    367          &      e12v    (jpi,jpj) , r1_e12v (jpi,jpj) ,                                       & 
    368          &      e12f    (jpi,jpj) , r1_e12f (jpi,jpj) ,                                   STAT=ierr(6)  ) 
     365         &      hv      (jpi,jpj) , hvr     (jpi,jpj) , hv_0(jpi,jpj) , ht    (jpi,jpj) , STAT=ierr(6)  ) 
    369366         ! 
    370367      ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) ,                                     & 
     
    377374         &      scosrf(jpi,jpj) , scobot(jpi,jpj) ,     & 
    378375         &      hifv  (jpi,jpj) , hiff  (jpi,jpj) ,     & 
    379          &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1 (jpi,jpj) , STAT=ierr(8) ) 
     376         &      hift  (jpi,jpj) , hifu  (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) ) 
    380377 
    381378      ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) ,                     & 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r4366 r4616  
    1414   !!                            use of parameters in par_CONFIG-Rxx.h90, not in namelist 
    1515   !!             -   ! 2004-05  (A. Koch-Larrouy) Add Gyre configuration  
    16    !!            4.0  ! 2011-02  (G. Madec) add cell surface (e1e2t) 
     16   !!            3.7  ! 2014-032  (G. Madec) add cell surface and their inverse 
    1717   !!---------------------------------------------------------------------- 
    1818 
     
    3535 
    3636   !!---------------------------------------------------------------------- 
    37    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     37   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    3838   !! $Id$  
    3939   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    120120         WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m   
    121121      ENDIF 
    122  
    123  
    124       SELECT CASE( jphgr_msh )   ! type of horizontal mesh 
    125  
    126       CASE ( 0 )                     !  curvilinear coordinate on the sphere read in coordinate.nc file 
    127  
     122      ! 
     123      SELECT CASE( jphgr_msh )   !  type of horizontal mesh   
     124      ! 
     125      CASE ( 0 )                     !==  read in coordinate.nc file  ==! 
     126         ! 
    128127         IF(lwp) WRITE(numout,*) 
    129128         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file' 
    130  
     129         ! 
    131130         CALL hgr_read           ! Defaultl option  :   NetCDF file 
    132  
     131         ! 
    133132         !                                                ! ===================== 
    134133         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
     
    155154            ! 
    156155         ENDIF 
    157  
    158             !                                             ! ===================== 
     156         ! 
     157         !                                                ! ===================== 
    159158         IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    160159            !                                             ! ===================== 
    161  
     160            ! 
    162161            ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u = 20 km) 
    163162            ij0 = 200   ;   ij1 = 200   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3 
     
    199198            IF(lwp) WRITE(numout,*) 
    200199            IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km' 
    201  
    202             ! 
    203  
    204             ! 
    205             ! 
    206             ! 
    207             ! 
    208          ENDIF 
    209  
     200            ! 
     201         ENDIF 
     202         ! 
    210203         !                                                ! ====================== 
    211204         IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration 
     
    248241            ! 
    249242         ENDIF 
    250  
    251  
     243         ! 
    252244         ! N.B. :  General case, lat and long function of both i and j indices: 
    253245         !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   & 
     
    268260         !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   & 
    269261         !                                  + (                           fsdjph( zfi, zfj ) )**2  ) 
    270  
    271  
    272       CASE ( 1 )                     ! geographical mesh on the sphere with regular grid-spacing 
    273  
     262         ! 
     263         ! 
     264      CASE ( 1 )                     !==  geographical mesh on the sphere with regular (in degree) grid-spacing  ==! 
     265         ! 
    274266         IF(lwp) WRITE(numout,*) 
    275267         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing' 
    276268         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg'  
    277  
     269         ! 
    278270         DO jj = 1, jpj 
    279271            DO ji = 1, jpi 
    280                zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    281                zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 ) 
    282                zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5 
    283                zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5 
     272               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - 1 + njmpp - 1 ) 
     273               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - 1 + njmpp - 1 ) 
     274               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5 
     275               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5 
    284276         ! Longitude 
    285277               glamt(ji,jj) = ppglam0 + ppe1_deg * zti 
     
    304296            END DO 
    305297         END DO 
    306  
    307  
    308       CASE ( 2:3 )                   ! f- or beta-plane with regular grid-spacing 
    309  
     298         ! 
     299      CASE ( 2:3 )                   !==  f- or beta-plane with regular grid-spacing  ==! 
     300         ! 
    310301         IF(lwp) WRITE(numout,*) 
    311302         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing' 
    312303         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'  
    313  
     304         ! 
    314305         ! Position coordinates (in kilometers) 
    315306         !                          ========== 
    316307         glam0 = 0.e0 
    317308         gphi0 = - ppe2_m * 1.e-3 
    318           
     309         ! 
    319310#if defined key_agrif  
    320311         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
     
    329320         DO jj = 1, jpj 
    330321            DO ji = 1, jpi 
    331                glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 )       ) 
    332                glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ) 
     322               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 )       ) 
     323               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 ) 
    333324               glamv(ji,jj) = glamt(ji,jj) 
    334325               glamf(ji,jj) = glamu(ji,jj) 
    335     
    336                gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 )       ) 
     326               ! 
     327               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 )       ) 
    337328               gphiu(ji,jj) = gphit(ji,jj) 
    338                gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 ) 
     329               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 ) 
    339330               gphif(ji,jj) = gphiv(ji,jj) 
    340331            END DO 
    341332         END DO 
    342  
     333         ! 
    343334         ! Horizontal scale factors (in meters) 
    344335         !                              ====== 
     
    347338         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m 
    348339         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m 
    349  
    350       CASE ( 4 )                     ! geographical mesh on the sphere, isotropic MERCATOR type 
    351  
     340         ! 
     341      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==! 
     342         ! 
    352343         IF(lwp) WRITE(numout,*) 
    353344         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type' 
    354345         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg' 
    355346         IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 
    356  
     347         ! 
    357348         !  Find index corresponding to the equator, given the grid spacing e1_deg 
    358349         !  and the (approximate) southern latitude ppgphi0. 
     
    362353         ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 
    363354         IF(  ppgphi0 > 0 )  ijeq = -ijeq 
    364  
     355         ! 
    365356         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq 
    366  
     357         ! 
    367358         DO jj = 1, jpj 
    368359            DO ji = 1, jpi 
    369                zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - ijeq + njmpp - 1 ) 
    370                zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - ijeq + njmpp - 1 ) 
    371                zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5 
    372                zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5 
     360               zti = REAL( ji - 1 + nimpp - 1 )         ;   ztj = REAL( jj - ijeq + njmpp - 1 ) 
     361               zui = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = REAL( jj - ijeq + njmpp - 1 ) 
     362               zvi = REAL( ji - 1 + nimpp - 1 )         ;   zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 
     363               zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 
    373364         ! Longitude 
    374365               glamt(ji,jj) = ppglam0 + ppe1_deg * zti 
     
    393384            END DO 
    394385         END DO 
    395  
    396       CASE ( 5 )                   ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration) 
    397  
     386         ! 
     387      CASE ( 5 )                   !==  beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration) 
     388         ! 
    398389         IF(lwp) WRITE(numout,*) 
    399390         IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)' 
    400391         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
    401  
     392         ! 
    402393         ! Position coordinates (in kilometers) 
    403394         !                          ========== 
    404  
     395         ! 
    405396         ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN 
    406          zlam1 = -85 
    407          zphi1 = 29 
     397         zlam1 = -85._wp 
     398         zphi1 =  29._wp 
    408399         ! resolution in meters 
    409          ze1 = 106000. / FLOAT(jp_cfg)             
     400         ze1 = 106000. / REAL( jp_cfg , wp )             
    410401         ! benchmark: forced the resolution to be about 100 km 
    411402         IF( nbench /= 0 )   ze1 = 106000.e0      
    412          zsin_alpha = - SQRT( 2. ) / 2. 
    413          zcos_alpha =   SQRT( 2. ) / 2. 
     403         zsin_alpha = - SQRT( 2._wp ) * 0.5_wp 
     404         zcos_alpha =   SQRT( 2._wp ) * 0.5_wp 
    414405         ze1deg = ze1 / (ra * rad) 
    415          IF( nbench /= 0 )   ze1deg = ze1deg / FLOAT(jp_cfg)        ! benchmark: keep the lat/+lon 
    416          !                                                          ! at the right jp_cfg resolution 
    417          glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2 ) 
    418          gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2 ) 
    419  
     406         IF( nbench /= 0 )   ze1deg = ze1deg / REAL( jp_cfg , wp )   ! benchmark: keep the lat/+lon 
     407         !                                                           ! at the right jp_cfg resolution 
     408         glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
     409         gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
     410         ! 
    420411         IF( nprint==1 .AND. lwp )   THEN 
    421412            WRITE(numout,*) '          ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 
    422413            WRITE(numout,*) '          ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0 
    423414         ENDIF 
    424  
     415         ! 
    425416         DO jj = 1, jpj 
    426            DO ji = 1, jpi 
    427              zim1 = FLOAT( ji + nimpp - 1 ) - 1.   ;   zim05 = FLOAT( ji + nimpp - 1 ) - 1.5 
    428              zjm1 = FLOAT( jj + njmpp - 1 ) - 1.   ;   zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5 
    429  
    430              glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
    431              gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
    432  
    433              glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
    434              gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
    435  
    436              glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
    437              gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
    438  
    439              glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
    440              gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
    441            END DO 
    442           END DO 
    443  
     417            DO ji = 1, jpi 
     418               zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5 
     419               zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5 
     420               ! 
     421               glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
     422               gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
     423               ! 
     424               glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
     425               gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
     426               ! 
     427               glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 
     428               gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 
     429               ! 
     430               glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha 
     431               gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha 
     432            END DO 
     433         END DO 
     434         ! 
    444435         ! Horizontal scale factors (in meters) 
    445436         !                              ====== 
     
    448439         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1 
    449440         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1 
    450  
     441         ! 
    451442      CASE DEFAULT 
    452443         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh 
    453444         CALL ctl_stop( ctmp1 ) 
    454  
     445         ! 
    455446      END SELECT 
    456447       
    457       ! T-cell surface 
    458       ! -------------- 
     448      ! associated horizontal metrics 
     449      ! ----------------------------- 
     450      ! 
     451      r1_e1t (:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
     452      r1_e1u (:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:) 
     453      r1_e1v (:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:) 
     454      r1_e1f (:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:) 
     455      ! 
    459456      e1e2t(:,:) = e1t(:,:) * e2t(:,:) 
    460      
    461       ! Useful shortcuts (JC: note the duplicated e2e2t array ! Need some cleaning) 
    462       ! --------------------------------------------------------------------------- 
    463       e12t    (:,:) = e1t(:,:) * e2t(:,:) 
    464       e12u    (:,:) = e1u(:,:) * e2u(:,:) 
    465       e12v    (:,:) = e1v(:,:) * e2v(:,:) 
    466       e12f    (:,:) = e1f(:,:) * e2f(:,:) 
    467       r1_e12t (:,:) = 1._wp    / e12t(:,:) 
    468       r1_e12u (:,:) = 1._wp    / e12u(:,:) 
    469       r1_e12v (:,:) = 1._wp    / e12v(:,:) 
    470       r1_e12f (:,:) = 1._wp    / e12f(:,:) 
    471       re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    472       re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    473  
    474       ! Control printing : Grid informations (if not restart) 
    475       ! ---------------- 
    476  
    477       IF( lwp .AND. .NOT.ln_rstart ) THEN 
     457      e1e2u(:,:) = e1u(:,:) * e2u(:,:) 
     458      e1e2v(:,:) = e1v(:,:) * e2v(:,:) 
     459      e1e2f(:,:) = e1f(:,:) * e2f(:,:) 
     460      !    
     461      r1_e1e2t (:,:) = 1._wp / e1e2t(:,:) 
     462      r1_e1e2u (:,:) = 1._wp / e1e2u(:,:) 
     463      r1_e1e2v (:,:) = 1._wp / e1e2v(:,:) 
     464      r1_e1e2f (:,:) = 1._wp / e1e2f(:,:) 
     465      ! 
     466      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
     467      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     468 
     469 
     470      IF( lwp .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart) 
    478471         WRITE(numout,*) 
    479472         WRITE(numout,*) '          longitude and e1 scale factors' 
     
    4854789300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    & 
    486479            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 ) 
    487           
     480            ! 
    488481         WRITE(numout,*) 
    489482         WRITE(numout,*) '          latitude and e2 scale factors' 
     
    495488      ENDIF 
    496489 
    497        
    498       IF( nprint == 1 .AND. lwp ) THEN 
    499          WRITE(numout,*) '          e1u e2u ' 
    500          CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    501          CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    502          WRITE(numout,*) '          e1v e2v  ' 
    503          CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    504          CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    505          WRITE(numout,*) '          e1f e2f  ' 
    506          CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    507          CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout ) 
    508       ENDIF 
    509  
    510490 
    511491      ! ================= ! 
     
    528508 
    529509         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0 
    530          zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points 
     510         zphi0   = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points 
    531511          
    532512#if defined key_agrif 
    533513         IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN    ! for EEL6 configuration only 
    534514            IF( .NOT. Agrif_Root() ) THEN 
    535               zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
     515              zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
    536516            ENDIF 
    537517         ENDIF 
     
    584564 
    585565      IF( nperio == 2 ) THEN 
    586          znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi ) 
     566         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi ) 
    587567         IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 
    588568      ENDIF 
     
    597577      !!              ***  ROUTINE hgr_read  *** 
    598578      !! 
    599       !! ** Purpose :   Read a coordinate file in NetCDF format  
    600       !! 
    601       !! ** Method  :   The mesh file has been defined trough a analytical  
    602       !!      or semi-analytical method. It is read in a NetCDF file.  
    603       !!      
     579      !! ** Purpose :   Read a coordinate file in NetCDF format using IOM 
     580      !! 
    604581      !!---------------------------------------------------------------------- 
    605582      USE iom 
    606  
     583      ! 
    607584      INTEGER ::   inum   ! temporary logical unit 
    608585      !!---------------------------------------------------------------------- 
    609  
     586      ! 
    610587      IF(lwp) THEN 
    611588         WRITE(numout,*) 
     
    613590         WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 
    614591      ENDIF 
    615        
     592      ! 
    616593      CALL iom_open( 'coordinates', inum ) 
    617        
     594      ! 
    618595      CALL iom_get( inum, jpdom_data, 'glamt', glamt ) 
    619596      CALL iom_get( inum, jpdom_data, 'glamu', glamu ) 
    620597      CALL iom_get( inum, jpdom_data, 'glamv', glamv ) 
    621598      CALL iom_get( inum, jpdom_data, 'glamf', glamf ) 
    622        
     599      ! 
    623600      CALL iom_get( inum, jpdom_data, 'gphit', gphit ) 
    624601      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu ) 
    625602      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv ) 
    626603      CALL iom_get( inum, jpdom_data, 'gphif', gphif ) 
    627        
     604      ! 
    628605      CALL iom_get( inum, jpdom_data, 'e1t', e1t ) 
    629606      CALL iom_get( inum, jpdom_data, 'e1u', e1u ) 
    630607      CALL iom_get( inum, jpdom_data, 'e1v', e1v ) 
    631608      CALL iom_get( inum, jpdom_data, 'e1f', e1f ) 
    632        
     609      ! 
    633610      CALL iom_get( inum, jpdom_data, 'e2t', e2t ) 
    634611      CALL iom_get( inum, jpdom_data, 'e2u', e2u ) 
    635612      CALL iom_get( inum, jpdom_data, 'e2v', e2v ) 
    636613      CALL iom_get( inum, jpdom_data, 'e2f', e2f ) 
    637        
     614      ! 
    638615      CALL iom_close( inum ) 
    639        
    640     END SUBROUTINE hgr_read 
     616      ! 
     617   END SUBROUTINE hgr_read 
    641618     
    642619   !!====================================================================== 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r4490 r4616  
    99   !!                                          vvl option includes z_star and z_tilde coordinates 
    1010   !!---------------------------------------------------------------------- 
    11    !!   'key_vvl'                              variable volume 
    12    !!---------------------------------------------------------------------- 
     11 
    1312   !!---------------------------------------------------------------------- 
    1413   !!   dom_vvl_init     : define initial vertical scale factors, depths and column thickness 
     
    1817   !!   dom_vvl_rst      : read/write restart file 
    1918   !!   dom_vvl_ctl      : Check the vvl options 
    20    !!   dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors  
    21    !!                    : to account for manual changes to e[1,2][u,v] in some Straits  
    2219   !!---------------------------------------------------------------------- 
    23    !! * Modules used 
    2420   USE oce             ! ocean dynamics and tracers 
    2521   USE dom_oce         ! ocean space and time domain 
     
    3632   PRIVATE 
    3733 
    38    !! * Routine accessibility 
    3934   PUBLIC  dom_vvl_init       ! called by domain.F90 
    4035   PUBLIC  dom_vvl_sf_nxt     ! called by step.F90 
    4136   PUBLIC  dom_vvl_sf_swp     ! called by step.F90 
    4237   PUBLIC  dom_vvl_interpol   ! called by dynnxt.F90 
    43    PRIVATE dom_vvl_orca_fix   ! called by dom_vvl_interpol 
    44  
    45    !!* Namelist nam_vvl 
    46    LOGICAL , PUBLIC                                      :: ln_vvl_zstar              ! zstar  vertical coordinate 
    47    LOGICAL , PUBLIC                                      :: ln_vvl_ztilde             ! ztilde vertical coordinate 
    48    LOGICAL , PUBLIC                                      :: ln_vvl_layer              ! level  vertical coordinate 
    49    LOGICAL , PUBLIC                                      :: ln_vvl_ztilde_as_zstar    ! ztilde vertical coordinate 
    50    LOGICAL , PUBLIC                                      :: ln_vvl_zstar_at_eqtor     ! ztilde vertical coordinate 
    51    LOGICAL , PUBLIC                                      :: ln_vvl_kepe               ! kinetic/potential energy transfer 
    52    !                                                                                           ! conservation: not used yet 
    53    REAL(wp)                                              :: rn_ahe3                   ! thickness diffusion coefficient 
    54    REAL(wp)                                              :: rn_rst_e3t                ! ztilde to zstar restoration timescale [days] 
    55    REAL(wp)                                              :: rn_lf_cutoff              ! cutoff frequency for low-pass filter  [days] 
    56    REAL(wp)                                              :: rn_zdef_max               ! maximum fractional e3t deformation 
    57    LOGICAL , PUBLIC                                      :: ln_vvl_dbg                ! debug control prints 
    58  
    59    !! * Module variables 
    60    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td                       ! thickness diffusion transport 
    61    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf                            ! low frequency part of hz divergence 
    62    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n           ! baroclinic scale factors 
    63    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a          ! baroclinic scale factors 
    64    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_e3t                        ! retoring period for scale factors 
    65    REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: frq_rst_hdv                        ! retoring period for low freq. divergence 
     38 
     39   !                                            !!* Namelist nam_vvl * 
     40   LOGICAL , PUBLIC :: ln_vvl_zstar              ! zstar  vertical coordinate 
     41   LOGICAL , PUBLIC :: ln_vvl_ztilde             ! ztilde vertical coordinate 
     42   LOGICAL , PUBLIC :: ln_vvl_layer              ! level  vertical coordinate 
     43   LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar    ! ztilde vertical coordinate 
     44   LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor     ! ztilde vertical coordinate 
     45   LOGICAL , PUBLIC :: ln_vvl_kepe               ! kinetic/potential energy transfer conservation: not used yet 
     46   REAL(wp)         :: rn_ahe3                   ! thickness diffusion coefficient 
     47   REAL(wp)         :: rn_rst_e3t                ! ztilde to zstar restoration timescale [days] 
     48   REAL(wp)         :: rn_lf_cutoff              ! cutoff frequency for low-pass filter  [days] 
     49   REAL(wp)         :: rn_zdef_max               ! maximum fractional e3t deformation 
     50   LOGICAL , PUBLIC :: ln_vvl_dbg                ! debug control prints 
     51 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   un_td, vn_td                ! thickness diffusion transport 
     53   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hdiv_lf                     ! low frequency part of hz divergence 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tilde_e3t_b, tilde_e3t_n    ! baroclinic scale factors 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tilde_e3t_a, dtilde_e3t_a   ! baroclinic scale factors 
     56   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   frq_rst_e3t                 ! retoring period for scale factors 
     57   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   frq_rst_hdv                 ! retoring period for low freq. divergence 
    6658 
    6759   !! * Substitutions 
     
    7365   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7466   !!---------------------------------------------------------------------- 
    75  
    7667CONTAINS 
    7768 
     
    8071      !!                ***  FUNCTION dom_vvl_alloc  *** 
    8172      !!---------------------------------------------------------------------- 
    82       IF( ln_vvl_zstar ) dom_vvl_alloc = 0 
     73      IF( ln_vvl_zstar )   dom_vvl_alloc = 0 
    8374      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    8475         ALLOCATE( tilde_e3t_b(jpi,jpj,jpk)  , tilde_e3t_n(jpi,jpj,jpk) , tilde_e3t_a(jpi,jpj,jpk) ,   & 
     
    9586         IF( dom_vvl_alloc /= 0 )   CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 
    9687      ENDIF 
    97  
     88      ! 
    9889   END FUNCTION dom_vvl_alloc 
    9990 
     
    358349            DO jj = 1, jpjm1 
    359350               DO ji = 1, fs_jpim1   ! vector opt. 
    360                   un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj) & 
    361                                   & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    362                   vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj) &  
    363                                   & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
     351                  un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)    & 
     352                     &                      * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
     353                  vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj)    &  
     354                     &                      * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji  ,jj+1,jk) ) 
    364355                  zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 
    365356                  zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
     
    380371                  tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + (   un_td(ji-1,jj  ,jk) - un_td(ji,jj,jk)    & 
    381372                     &                                          +     vn_td(ji  ,jj-1,jk) - vn_td(ji,jj,jk)    & 
    382                      &                                            ) * r1_e12t(ji,jj) 
     373                     &                                            ) * r1_e1e2t(ji,jj) 
    383374               END DO 
    384375            END DO 
     
    671662      !!                - vertical interpolation: simple averaging 
    672663      !!---------------------------------------------------------------------- 
    673       !! * Arguments 
    674664      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated 
    675665      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3 
    676666      CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors 
    677667      !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW' 
    678       !! * Local declarations 
     668      ! 
    679669      INTEGER ::   ji, jj, jk                                          ! dummy loop indices 
    680670      LOGICAL ::   l_is_orca                                           ! local logical 
     
    685675      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) l_is_orca = .TRUE.      ! ORCA R2 configuration - will need to correct some locations 
    686676 
    687       SELECT CASE ( pout ) 
    688          !               ! ------------------------------------- ! 
    689       CASE( 'U' )        ! interpolation from T-point to U-point ! 
    690          !               ! ------------------------------------- ! 
    691          ! horizontal surface weighted interpolation 
    692          DO jk = 1, jpk 
     677      SELECT CASE ( pout )     
     678      !                             ! ------------------------------------- ! 
     679      CASE( 'U' )                   ! interpolation from T-point to U-point ! 
     680         !                          ! ------------------------------------- ! 
     681         DO jk = 1, jpk                ! horizontal surface weighted interpolation 
    693682            DO jj = 1, jpjm1 
    694683               DO ji = 1, fs_jpim1   ! vector opt. 
    695                   pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj)                                   & 
    696                      &                       * (   e12t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
    697                      &                           + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
     684                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1e2u(ji,jj)                                   & 
     685                     &                       * (   e1e2t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) )     & 
     686                     &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
    698687               END DO 
    699688            END DO 
    700689         END DO 
    701          ! 
    702          IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    703          ! boundary conditions 
    704          CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. ) 
     690         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1. )         ! boundary conditions 
    705691         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    706          !               ! ------------------------------------- ! 
    707       CASE( 'V' )        ! interpolation from T-point to V-point ! 
    708          !               ! ------------------------------------- ! 
    709          ! horizontal surface weighted interpolation 
    710          DO jk = 1, jpk 
     692         ! 
     693         !                          ! ------------------------------------- ! 
     694      CASE( 'V' )                   ! interpolation from T-point to V-point ! 
     695         !                          ! ------------------------------------- ! 
     696         DO jk = 1, jpk                ! horizontal surface weighted interpolation 
    711697            DO jj = 1, jpjm1 
    712698               DO ji = 1, fs_jpim1   ! vector opt. 
    713                   pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj)                                   & 
    714                      &                       * (   e12t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
    715                      &                           + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
     699                  pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1e2v(ji,jj)                                   & 
     700                     &                       * (   e1e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) )     & 
     701                     &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
    716702               END DO 
    717703            END DO 
    718704         END DO 
    719          ! 
    720          IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    721          ! boundary conditions 
    722          CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. ) 
     705         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1. )         ! boundary conditions 
    723706         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    724          !               ! ------------------------------------- ! 
    725       CASE( 'F' )        ! interpolation from U-point to F-point ! 
    726          !               ! ------------------------------------- ! 
    727          ! horizontal surface weighted interpolation 
    728          DO jk = 1, jpk 
     707         ! 
     708         !                          ! ------------------------------------- ! 
     709      CASE( 'F' )                   ! interpolation from U-point to F-point ! 
     710         !                          ! ------------------------------------- ! 
     711         DO jk = 1, jpk                ! horizontal surface weighted interpolation 
    729712            DO jj = 1, jpjm1 
    730713               DO ji = 1, fs_jpim1   ! vector opt. 
    731                   pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj)               & 
    732                      &                       * (   e12u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
    733                      &                           + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
     714                  pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1e2f(ji,jj)               & 
     715                     &                       * (   e1e2u(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3u_0(ji,jj  ,jk) )     & 
     716                     &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
    734717               END DO 
    735718            END DO 
    736719         END DO 
    737          ! 
    738          IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    739720         ! boundary conditions 
    740721         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1. ) 
    741722         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    742          !               ! ------------------------------------- ! 
    743       CASE( 'W' )        ! interpolation from T-point to W-point ! 
    744          !               ! ------------------------------------- ! 
    745          ! vertical simple interpolation 
     723         ! 
     724         !                          ! ------------------------------------- ! 
     725      CASE( 'W' )                   ! interpolation from T-point to W-point ! 
     726         !                          ! ------------------------------------- ! 
     727         !                             ! vertical simple interpolation 
    746728         pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 
    747          ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
     729         ! - ML - The use of mask in this formaula enables the special treatment of the last w-point without indirect adressing 
    748730         DO jk = 2, jpk 
    749731            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )   & 
    750732               &                            +            0.5_wp * tmask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) ) 
    751733         END DO 
    752          !               ! -------------------------------------- ! 
    753       CASE( 'UW' )       ! interpolation from U-point to UW-point ! 
    754          !               ! -------------------------------------- ! 
    755          ! vertical simple interpolation 
     734         !                          ! -------------------------------------- ! 
     735      CASE( 'UW' )                  ! interpolation from U-point to UW-point ! 
     736         !                          ! -------------------------------------- ! 
     737         !                             ! vertical simple interpolation 
    756738         pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 
    757739         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
     
    760742               &                             +            0.5_wp * umask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) ) 
    761743         END DO 
    762          !               ! -------------------------------------- ! 
    763       CASE( 'VW' )       ! interpolation from V-point to VW-point ! 
    764          !               ! -------------------------------------- ! 
    765          ! vertical simple interpolation 
     744         !                          ! -------------------------------------- ! 
     745      CASE( 'VW' )                  ! interpolation from V-point to VW-point ! 
     746         !                          ! -------------------------------------- ! 
     747         !                             ! vertical simple interpolation 
    766748         pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 
    767749         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
     
    770752               &                             +            0.5_wp * vmask(:,:,jk)   * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) ) 
    771753         END DO 
     754         ! 
    772755      END SELECT 
    773756      ! 
    774  
    775757      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_interpol') 
    776  
     758      ! 
    777759   END SUBROUTINE dom_vvl_interpol 
     760 
    778761 
    779762   SUBROUTINE dom_vvl_rst( kt, cdrw ) 
     
    982965   END SUBROUTINE dom_vvl_ctl 
    983966 
    984    SUBROUTINE dom_vvl_orca_fix( pe3_in, pe3_out, pout ) 
    985       !!--------------------------------------------------------------------- 
    986       !!                   ***  ROUTINE dom_vvl_orca_fix  *** 
    987       !!                      
    988       !! ** Purpose :   Correct surface weighted, horizontally interpolated,  
    989       !!                scale factors at locations that have been individually 
    990       !!                modified in domhgr. Such modifications break the 
    991       !!                relationship between e12t and e1u*e2u etc. 
    992       !!                Recompute some scale factors ignoring the modified metric. 
    993       !!---------------------------------------------------------------------- 
    994       !! * Arguments 
    995       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in    ) ::  pe3_in     ! input e3 to be interpolated 
    996       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) ::  pe3_out    ! output interpolated e3 
    997       CHARACTER(LEN=*), INTENT( in )                    ::  pout       ! grid point of out scale factors 
    998       !                                                                !   =  'U', 'V', 'W, 'F', 'UW' or 'VW' 
    999       !! * Local declarations 
    1000       INTEGER ::   ji, jj, jk                                          ! dummy loop indices 
    1001       INTEGER ::   ij0, ij1, ii0, ii1                                  ! dummy loop indices 
    1002       !! acc 
    1003       !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for 
    1004       !! the ORCA2 tests (by changing jp_cfg test from 2 to 3) pending further investigations 
    1005       !!  
    1006       !                                                ! ===================== 
    1007       IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN    ! ORCA R2 configuration 
    1008          !                                             ! ===================== 
    1009       !! acc 
    1010          IF( nn_cla == 0 ) THEN 
    1011             ! 
    1012             ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified) 
    1013             ij0 = 102   ;   ij1 = 102 
    1014             DO jk = 1, jpkm1 
    1015                DO jj = mj0(ij0), mj1(ij1) 
    1016                   DO ji = mi0(ii0), mi1(ii1) 
    1017                      SELECT CASE ( pout ) 
    1018                      CASE( 'U' ) 
    1019                         pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1020                        &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1021                        &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1022                        &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1023                      CASE( 'F' ) 
    1024                         pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1025                        &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1026                        &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1027                        &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1028                      END SELECT 
    1029                   END DO 
    1030                END DO 
    1031             END DO 
    1032             ! 
    1033             ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified) 
    1034             ij0 =  88   ;   ij1 =  88 
    1035             DO jk = 1, jpkm1 
    1036                DO jj = mj0(ij0), mj1(ij1) 
    1037                   DO ji = mi0(ii0), mi1(ii1) 
    1038                      SELECT CASE ( pout ) 
    1039                      CASE( 'U' ) 
    1040                         pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1041                        &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1042                        &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1043                        &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1044                      CASE( 'V' ) 
    1045                         pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1046                        &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1047                        &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1048                        &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1049                      CASE( 'F' ) 
    1050                         pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1051                        &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1052                        &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1053                        &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1054                      END SELECT 
    1055                   END DO 
    1056                END DO 
    1057             END DO 
    1058          ENDIF 
    1059  
    1060          ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified) 
    1061          ij0 = 116   ;   ij1 = 116 
    1062          DO jk = 1, jpkm1 
    1063             DO jj = mj0(ij0), mj1(ij1) 
    1064                DO ji = mi0(ii0), mi1(ii1) 
    1065                   SELECT CASE ( pout ) 
    1066                   CASE( 'U' ) 
    1067                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1068                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1069                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1070                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1071                   CASE( 'F' ) 
    1072                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1073                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1074                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1075                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1076                   END SELECT 
    1077                END DO 
    1078             END DO 
    1079          END DO 
    1080       ENDIF 
    1081       ! 
    1082          !                                             ! ===================== 
    1083       IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration 
    1084          !                                             ! ===================== 
    1085          ! 
    1086          ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u was modified) 
    1087          ij0 = 200   ;   ij1 = 200 
    1088          DO jk = 1, jpkm1 
    1089             DO jj = mj0(ij0), mj1(ij1) 
    1090                DO ji = mi0(ii0), mi1(ii1) 
    1091                   SELECT CASE ( pout ) 
    1092                   CASE( 'U' ) 
    1093                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1094                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1095                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1096                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1097                   CASE( 'F' ) 
    1098                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1099                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1100                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1101                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1102                   END SELECT 
    1103                END DO 
    1104             END DO 
    1105          END DO 
    1106          ! 
    1107          ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u was modified) 
    1108          ij0 = 208   ;   ij1 = 208 
    1109          DO jk = 1, jpkm1 
    1110             DO jj = mj0(ij0), mj1(ij1) 
    1111                DO ji = mi0(ii0), mi1(ii1) 
    1112                   SELECT CASE ( pout ) 
    1113                   CASE( 'U' ) 
    1114                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &   
    1115                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1116                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1117                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1118                   CASE( 'F' ) 
    1119                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &   
    1120                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1121                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1122                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1123                   END SELECT 
    1124                END DO 
    1125             END DO 
    1126          END DO 
    1127          ! 
    1128          ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v was modified) 
    1129          ij0 = 124   ;   ij1 = 125 
    1130          DO jk = 1, jpkm1 
    1131             DO jj = mj0(ij0), mj1(ij1) 
    1132                DO ji = mi0(ii0), mi1(ii1) 
    1133                   SELECT CASE ( pout ) 
    1134                   CASE( 'V' ) 
    1135                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1136                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1137                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1138                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1139                   END SELECT 
    1140                END DO 
    1141             END DO 
    1142          END DO 
    1143          ! 
    1144          ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on] 
    1145          ij0 = 124   ;   ij1 = 125 
    1146          DO jk = 1, jpkm1 
    1147             DO jj = mj0(ij0), mj1(ij1) 
    1148                DO ji = mi0(ii0), mi1(ii1) 
    1149                   SELECT CASE ( pout ) 
    1150                   CASE( 'V' ) 
    1151                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1152                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1153                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1154                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1155                   END SELECT 
    1156                END DO 
    1157             END DO 
    1158          END DO 
    1159          ! 
    1160          ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v was modified) 
    1161          ij0 = 124   ;   ij1 = 125 
    1162          DO jk = 1, jpkm1 
    1163             DO jj = mj0(ij0), mj1(ij1) 
    1164                DO ji = mi0(ii0), mi1(ii1) 
    1165                   SELECT CASE ( pout ) 
    1166                   CASE( 'V' ) 
    1167                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1168                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1169                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1170                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1171                   END SELECT 
    1172                END DO 
    1173             END DO 
    1174          END DO 
    1175          ! 
    1176          ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v was modified) 
    1177          ij0 = 124   ;   ij1 = 125 
    1178          DO jk = 1, jpkm1 
    1179             DO jj = mj0(ij0), mj1(ij1) 
    1180                DO ji = mi0(ii0), mi1(ii1) 
    1181                   SELECT CASE ( pout ) 
    1182                   CASE( 'V' ) 
    1183                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1184                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1185                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1186                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1187                   END SELECT 
    1188                END DO 
    1189             END DO 
    1190          END DO 
    1191          ! 
    1192          ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v was modified) 
    1193          ij0 = 141   ;   ij1 = 142 
    1194          DO jk = 1, jpkm1 
    1195             DO jj = mj0(ij0), mj1(ij1) 
    1196                DO ji = mi0(ii0), mi1(ii1) 
    1197                   SELECT CASE ( pout ) 
    1198                   CASE( 'V' ) 
    1199                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1200                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1201                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1202                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1203                   END SELECT 
    1204                END DO 
    1205             END DO 
    1206          END DO 
    1207          ! 
    1208          ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v was modified) 
    1209          ij0 = 141   ;   ij1 = 142 
    1210          DO jk = 1, jpkm1 
    1211             DO jj = mj0(ij0), mj1(ij1) 
    1212                DO ji = mi0(ii0), mi1(ii1) 
    1213                   SELECT CASE ( pout ) 
    1214                   CASE( 'V' ) 
    1215                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1216                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1217                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1218                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1219                   END SELECT 
    1220                END DO 
    1221             END DO 
    1222          END DO 
    1223       ENDIF 
    1224          !                                             ! ===================== 
    1225       IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration 
    1226          !                                             ! ===================== 
    1227          ! 
    1228          ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified) 
    1229          ij0 = 327   ;   ij1 = 327 
    1230          DO jk = 1, jpkm1 
    1231             DO jj = mj0(ij0), mj1(ij1) 
    1232                DO ji = mi0(ii0), mi1(ii1) 
    1233                   SELECT CASE ( pout ) 
    1234                   CASE( 'U' ) 
    1235                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1236                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1237                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1238                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1239                   CASE( 'F' ) 
    1240                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1241                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1242                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1243                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1244                   END SELECT 
    1245                END DO 
    1246             END DO 
    1247          END DO 
    1248          ! 
    1249          ii0 = 627   ;   ii1 = 628        ! Bosphorus Strait (e2u was modified) 
    1250          ij0 = 343   ;   ij1 = 343 
    1251          DO jk = 1, jpkm1 
    1252             DO jj = mj0(ij0), mj1(ij1) 
    1253                DO ji = mi0(ii0), mi1(ii1) 
    1254                   SELECT CASE ( pout ) 
    1255                   CASE( 'U' ) 
    1256                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        &   
    1257                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1258                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1259                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1260                   CASE( 'F' ) 
    1261                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    &   
    1262                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1263                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1264                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1265                   END SELECT 
    1266                END DO 
    1267             END DO 
    1268          END DO 
    1269          ! 
    1270          ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified) 
    1271          ij0 = 232   ;   ij1 = 232 
    1272          DO jk = 1, jpkm1 
    1273             DO jj = mj0(ij0), mj1(ij1) 
    1274                DO ji = mi0(ii0), mi1(ii1) 
    1275                   SELECT CASE ( pout ) 
    1276                   CASE( 'U' ) 
    1277                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1278                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1279                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1280                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1281                   CASE( 'F' ) 
    1282                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1283                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1284                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1285                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1286                   END SELECT 
    1287                END DO 
    1288             END DO 
    1289          END DO 
    1290          ! 
    1291          ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified) 
    1292          ij0 = 232   ;   ij1 = 232 
    1293          DO jk = 1, jpkm1 
    1294             DO jj = mj0(ij0), mj1(ij1) 
    1295                DO ji = mi0(ii0), mi1(ii1) 
    1296                   SELECT CASE ( pout ) 
    1297                   CASE( 'U' ) 
    1298                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1299                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1300                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1301                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1302                   CASE( 'F' ) 
    1303                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1304                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1305                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1306                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1307                   END SELECT 
    1308                END DO 
    1309             END DO 
    1310          END DO 
    1311          ! 
    1312          ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified) 
    1313          ij0 = 270   ;   ij1 = 270 
    1314          DO jk = 1, jpkm1 
    1315             DO jj = mj0(ij0), mj1(ij1) 
    1316                DO ji = mi0(ii0), mi1(ii1) 
    1317                   SELECT CASE ( pout ) 
    1318                   CASE( 'U' ) 
    1319                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk)                                        & 
    1320                     &                    * (   e1t(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3t_0(ji  ,jj,jk) ) & 
    1321                     &                    +     e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) & 
    1322                     &                      ) / e1u(ji,jj)   +   e3u_0(ji,jj,jk) 
    1323                   CASE( 'F' ) 
    1324                      pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk)                    & 
    1325                     &                    * (   e1u(ji  ,jj) * ( pe3_in(ji  ,jj,jk) - e3u_0(ji  ,jj,jk) ) & 
    1326                     &                    +     e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) & 
    1327                     &                      ) / e1f(ji,jj)   +   e3f_0(ji,jj,jk) 
    1328                   END SELECT 
    1329                END DO 
    1330             END DO 
    1331          END DO 
    1332          ! 
    1333          ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified) 
    1334          ij0 = 232   ;   ij1 = 233 
    1335          DO jk = 1, jpkm1 
    1336             DO jj = mj0(ij0), mj1(ij1) 
    1337                DO ji = mi0(ii0), mi1(ii1) 
    1338                   SELECT CASE ( pout ) 
    1339                   CASE( 'V' ) 
    1340                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1341                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1342                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1343                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1344                   END SELECT 
    1345                END DO 
    1346             END DO 
    1347          END DO 
    1348          ! 
    1349          ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified) 
    1350          ij0 = 276   ;   ij1 = 276 
    1351          DO jk = 1, jpkm1 
    1352             DO jj = mj0(ij0), mj1(ij1) 
    1353                DO ji = mi0(ii0), mi1(ii1) 
    1354                   SELECT CASE ( pout ) 
    1355                   CASE( 'V' ) 
    1356                      pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk)                                        & 
    1357                     &                    * (   e2t(ji,jj  ) * ( pe3_in(ji,jj  ,jk) - e3t_0(ji,jj  ,jk) ) & 
    1358                     &                    +     e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) & 
    1359                     &                      ) / e2v(ji,jj)   +   e3v_0(ji,jj,jk) 
    1360                   END SELECT 
    1361                END DO 
    1362             END DO 
    1363          END DO 
    1364       ENDIF 
    1365    END SUBROUTINE dom_vvl_orca_fix 
    1366  
    1367967   !!====================================================================== 
    1368968END MODULE domvvl 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r4596 r4616  
    485485               zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   & 
    486486                               + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  ) 
    487                zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   & 
    488                     + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   & 
    489                     + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   & 
    490                     + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  ) 
     487               zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) * r1_e1u(ji-1,jj+1)   & 
     488                    + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) * r1_e1u(ji  ,jj+1)   & 
     489                    + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) * r1_e1u(ji-1,jj  )   & 
     490                    + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) * r1_e1u(ji  ,jj  ) 
    491491               zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk) 
    492492 
    493493               zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   & 
    494494                               + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  ) 
    495                zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   & 
    496                     + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   & 
    497                     + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   & 
    498                     + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1) 
     495               zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) * r1_e2v(ji+1,jj  )   & 
     496                    + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) * r1_e2v(ji  ,jj  )   & 
     497                    + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) * r1_e2v(ji+1,jj-1)   & 
     498                    + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) * r1_e2v(ji  ,jj-1) 
    499499               zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk) 
    500500 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r4596 r4616  
    5757      !! 
    5858      !! ** Method  :   the now divergence is computed as : 
    59       !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
     59      !!         hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
    6060      !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla)  
    6161      !! 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r3294 r4616  
    5252      ! 
    5353      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    54       REAL(wp) ::   zbu, zbv     ! local scalars 
    5554      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu_t, zfv_t, zfu_f, zfv_f, zfu_uw, zfv_vw, zfw 
    5655      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv 
     
    8988         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    9089            DO ji = fs_2, fs_jpim1   ! vector opt. 
    91                zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    92                zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    93                ! 
    9490               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & 
    95                   &                           + zfv_f(ji  ,jj  ,jk) - zfv_f(ji  ,jj-1,jk)  ) / zbu 
     91                  &                           + zfv_f(ji  ,jj  ,jk) - zfv_f(ji  ,jj-1,jk)  ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    9692               va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji  ,jj  ,jk) - zfu_f(ji-1,jj  ,jk)    & 
    97                   &                           + zfv_t(ji  ,jj+1,jk) - zfv_t(ji  ,jj  ,jk)  ) / zbv 
     93                  &                           + zfv_t(ji  ,jj+1,jk) - zfv_t(ji  ,jj  ,jk)  ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    9894            END DO 
    9995         END DO 
     
    113109      DO jk = 1, jpkm1                       ! ==================== ! 
    114110         !                                         ! Vertical volume fluxesÊ 
    115          zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk) 
     111         zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) 
    116112         ! 
    117113         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                    
     
    143139            DO ji = fs_2, fs_jpim1   ! vector opt. 
    144140               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    & 
    145                   &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     141                  &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    146142               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    & 
    147                   &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     143                  &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    148144            END DO 
    149145         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r4153 r4616  
    183183         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    184184            DO ji = fs_2, fs_jpim1   ! vector opt. 
    185                zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    186                zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
     185               zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 
     186               zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 
    187187               ! 
    188188               ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj  ,jk) - zfu_t(ji  ,jj  ,jk)    & 
     
    205205      DO jk = 1, jpkm1                       ! ==================== ! 
    206206         !                                         ! Vertical volume fluxesÊ 
    207          zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk) 
     207         zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) 
    208208         ! 
    209209         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                    
     
    235235            DO ji = fs_2, fs_jpim1   ! vector opt. 
    236236               ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) )    & 
    237                   &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     237                  &  / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    238238               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    & 
    239                   &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     239                  &  / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    240240            END DO 
    241241         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r3294 r4616  
    3333#  include "vectopt_loop_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     35   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    3636   !! $Id$ 
    3737   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    6969 
    7070 
    71 # if defined key_vectopt_loop 
    72         DO jj = 1, 1 
    73            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    74 # else 
    7571        DO jj = 2, jpjm1 
    7672           DO ji = 2, jpim1 
    77 # endif 
    7873              ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels 
    7974              ikbv = mbkv(ji,jj) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r4596 r4616  
    6060#  include "vectopt_loop_substitute.h90" 
    6161   !!---------------------------------------------------------------------- 
    62    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     62   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    6363   !! $Id$ 
    6464   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    217217            zcoef1 = zcoef0 * fse3w(ji,jj,1) 
    218218            ! hydrostatic pressure gradient 
    219             zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj) 
    220             zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj) 
     219            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
     220            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
    221221            ! add to the general momentum trend 
    222222            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
     
    234234               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
    235235                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )   & 
    236                   &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj) 
     236                  &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    237237 
    238238               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
    239239                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )   & 
    240                   &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj) 
     240                  &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
    241241               ! add to the general momentum trend 
    242242               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
     
    284284            zcoef1 = zcoef0 * fse3w(ji,jj,1) 
    285285            ! hydrostatic pressure gradient 
    286             zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) / e1u(ji,jj) 
    287             zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) / e2v(ji,jj) 
     286            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
     287            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
    288288            ! add to the general momentum trend 
    289289            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
     
    300300               ! hydrostatic pressure gradient 
    301301               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
    302                   &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   & 
    303                   &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) / e1u(ji,jj) 
     302                  &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )    & 
     303                  &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    304304 
    305305               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
    306                   &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   & 
    307                   &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) / e2v(ji,jj) 
     306                  &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )    & 
     307                  &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
    308308               ! add to the general momentum trend 
    309309               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
     
    315315 
    316316      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90) 
    317 # if defined key_vectopt_loop 
    318          jj = 1 
    319          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    320 # else 
    321317      DO jj = 2, jpjm1 
    322318         DO ji = 2, jpim1 
    323 # endif 
    324319            iku = mbku(ji,jj) 
    325320            ikv = mbkv(ji,jj) 
     
    329324               ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value 
    330325               zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one 
    331                   &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) / e1u(ji,jj) 
     326                  &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + gru(ji,jj) ) * r1_e1u(ji,jj) 
    332327               ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend 
    333328            ENDIF 
     
    335330               va  (ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)         ! subtract old value 
    336331               zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one 
    337                   &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) / e2v(ji,jj) 
     332                  &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + grv(ji,jj) ) * r1_e2v(ji,jj) 
    338333               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend 
    339334            ENDIF 
    340 # if ! defined key_vectopt_loop 
    341          END DO 
    342 # endif 
     335         END DO 
    343336      END DO 
    344337      ! 
     
    392385         DO ji = fs_2, fs_jpim1   ! vector opt. 
    393386            ! hydrostatic pressure gradient along s-surfaces 
    394             zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   & 
    395                &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
    396             zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   & 
    397                &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
     387            zhpi(ji,jj,1) = zcoef0 * r1_e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   & 
     388               &                                     - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
     389            zhpj(ji,jj,1) = zcoef0 * r1_e2v(ji,jj) * ( fse3w(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   & 
     390               &                                     - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) ) 
    398391            ! s-coordinate pressure gradient correction 
    399392            zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
    400                &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj) 
     393               &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) * r1_e1u(ji,jj) 
    401394            zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   & 
    402                &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj) 
     395               &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) * r1_e2v(ji,jj) 
    403396            ! add to the general momentum trend 
    404397            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
     
    406399         END DO 
    407400      END DO 
     401 
     402!!gm 
     403!!gm Idea of optimization here : only divide by e1u and e2v  when apply to ua, va .... 
     404!!gm 
    408405 
    409406      ! interior value (2=<jk=<jpkm1) 
     
    412409            DO ji = fs_2, fs_jpim1   ! vector opt. 
    413410               ! hydrostatic pressure gradient along s-surfaces 
    414                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
     411               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   & 
    415412                  &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
    416413                  &              - fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
    417                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
     414               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   & 
    418415                  &           * (  fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   & 
    419416                  &              - fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  ) 
    420417               ! s-coordinate pressure gradient correction 
    421418               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    422                   &           * ( fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj) 
     419                  &           * ( fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk) ) * r1_e1u(ji,jj) 
    423420               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    424                   &           * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj) 
     421                  &           * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) * r1_e2v(ji,jj) 
    425422               ! add to the general momentum trend 
    426423               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap 
     
    625622      DO jj = 2, jpjm1 
    626623         DO ji = fs_2, fs_jpim1   ! vector opt. 
    627             zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) / e1u(ji,jj) 
    628             zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) / e2v(ji,jj) 
     624            zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 
     625            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 
    629626            ! add to the general momentum trend 
    630627            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
     
    642639               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                & 
    643640                  &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    & 
    644                   &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) / e1u(ji,jj) 
     641                  &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    645642               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                & 
    646643                  &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    & 
    647                   &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) / e2v(ji,jj) 
     644                  &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj) 
    648645               ! add to the general momentum trend 
    649646               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
     
    853850               ! update the momentum trends in u direction 
    854851 
    855                zdpdx1 = zcoef0 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 
     852               zdpdx1 = zcoef0 * r1_e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk)) 
    856853               IF( lk_vvl ) THEN 
    857                  zdpdx2 = zcoef0 / e1u(ji,jj) * & 
     854                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 
    858855                         ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) ) 
    859856                ELSE 
    860                  zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
     857                 zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
    861858               ENDIF 
    862859 
    863860               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * & 
    864861               &           umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,jj,jk) 
     862!!gm above it is stupid:   umask is equal to the product of the 2 tmask that follows... 
    865863            ENDIF 
    866864 
     
    910908               ! update the momentum trends in v direction 
    911909 
    912                zdpdy1 = zcoef0 / e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 
     910               zdpdy1 = zcoef0 * r1_e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk)) 
    913911               IF( lk_vvl ) THEN 
    914                    zdpdy2 = zcoef0 / e2v(ji,jj) * & 
     912                   zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
    915913                           ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 
    916914               ELSE 
     
    920918               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2)*& 
    921919               &              vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,jk) 
     920!!gm above it is stupid:   vmask is equal to the product of the 2 tmask that follows... 
    922921            ENDIF 
    923922 
     
    932931   END SUBROUTINE hpg_prj 
    933932 
     933 
    934934   SUBROUTINE cspline(fsp, xsp, asp, bsp, csp, dsp, polynomial_type) 
    935935      !!---------------------------------------------------------------------- 
     
    940940      !! ** Method  :   f(x) = asp + bsp*x + csp*x^2 + dsp*x^3 
    941941      !! Reference: CJC Kruger, Constrained Cubic Spline Interpoltation 
    942       !! 
    943       !!---------------------------------------------------------------------- 
    944       IMPLICIT NONE 
     942      !!---------------------------------------------------------------------- 
    945943      REAL(wp), DIMENSION(:,:,:), INTENT(in)  :: fsp, xsp           ! value and coordinate 
    946       REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of 
    947                                                                     ! the interpoated function 
     944      REAL(wp), DIMENSION(:,:,:), INTENT(out) :: asp, bsp, csp, dsp ! coefficients of the interpolated function 
    948945      INTEGER, INTENT(in) :: polynomial_type                        ! 1: cubic spline 
    949                                                                     ! 2: Linear 
    950  
    951       ! Local Variables 
     946      !                                                             ! 2: Linear 
     947      ! 
    952948      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    953949      INTEGER  ::   jpi, jpj, jpkm1 
     
    10381034           CALL ctl_stop( 'invalid polynomial type in cspline' ) 
    10391035      ENDIF 
    1040  
    1041  
     1036      ! 
    10421037   END SUBROUTINE cspline 
    10431038 
     
    10691064   END FUNCTION interp1 
    10701065 
     1066 
    10711067   FUNCTION interp2(x, a, b, c, d)  RESULT(f) 
    10721068      !!---------------------------------------------------------------------- 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r3294 r4616  
    9999         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends 
    100100            DO ji = fs_2, fs_jpim1   ! vector opt. 
    101                ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    102                va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
     101               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) * r1_e1u(ji,jj) 
     102               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) * r1_e2v(ji,jj) 
    103103            END DO  
    104104         END DO 
     
    112112!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    113113!                  &                                   - vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    114 !                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e1u(ji,jj) 
     114!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) * r1_e1u(ji,jj) 
    115115!                  ! 
    116116!               va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * (   un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk)   & 
     
    120120!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    121121!                  &                                   - un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   & 
    122 !                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e2v(ji,jj) 
     122!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) * r1_e2v(ji,jj) 
    123123!            END DO  
    124124!         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r4596 r4616  
    161161      !!      ===========  pu as follows (idem on pv) 
    162162      !!      vertical fluxes : 
    163       !!         zftw = e1t*e2t/e3w * (ahm*wslpi^2+ahm*wslpj^2)  dk-1[ pu ] 
    164       !!              -     e2t     *  ahm*wslpi                di[ mi(mk(pu)) ] 
    165       !!              -     e1t     *  ahm*wslpj                dj[ mj(mk(pu)) ] 
     163      !!         zftw = e1e2t/e3w * (ahm*wslpi^2+ahm*wslpj^2)  dk-1[ pu ] 
     164      !!              -   e2t     *  ahm*wslpi                di[ mi(mk(pu)) ] 
     165      !!              -   e1t     *  ahm*wslpj                dj[ mj(mk(pu)) ] 
    166166      !!      take the vertical divergence of the fluxes add it to the hori- 
    167167      !!      zontal component, divide the result by the volume element : 
    168       !!         plu  =  zsign / (e1t*e2t*e3t) { plu + dk[ zftw ] } 
     168      !!         plu  =  zsign / (e1e2t*e3t) { plu + dk[ zftw ] } 
    169169      !!      where  zsign=+1  if kahm =1 (laplacian or 1st pass of bilaplacian) 
    170170      !!                  =-1  if kahm =2 (2nd pass in case of bilaplacian) 
     
    369369               zuwslpj = 0.5 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 
    370370               ! coef. for the vertical dirative 
    371                zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk)   & 
     371               zcoef0 = e1e2u(ji,jj) / fse3u(ji,jj,jk)   & 
    372372                  &   * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) 
    373373               ! weights for the i-k, j-k averaging at t- and f-points, resp. 
     
    403403               zvwslpj = 0.5 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) ) 
    404404               ! coef. for the vertical derivative 
    405                zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk)   & 
     405               zcoef0 = e1e2v(ji,jj) / fse3v(ji,jj,jk)   & 
    406406                  &   * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) 
    407407!!gm caution here fmask multiplication already done in the def of ahmf... 
     
    439439               zvav = zfvw(ji,jk) - zfvw(ji,jk+1) 
    440440               ! harmonic operator applied to (pu,pv) and multiply by ahm 
    441                plu(ji,jj,jk) = zsign * ( plu(ji,jj,jk) + zuav ) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) ) 
    442                plv(ji,jj,jk) = zsign * ( plv(ji,jj,jk) + zvav ) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) ) 
     441               plu(ji,jj,jk) = zsign * ( plu(ji,jj,jk) + zuav ) / ( e1e2u(ji,jj)*fse3u(ji,jj,jk) ) 
     442               plv(ji,jj,jk) = zsign * ( plv(ji,jj,jk) + zvav ) / ( e1e2v(ji,jj)*fse3v(ji,jj,jk) ) 
    443443            END DO 
    444444         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r4596 r4616  
    110110      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    111111      REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                       ! local scalars 
    112       REAL(wp) ::   zmskt, zmskf, zbu, zbv, zuah, zvah               !   -      - 
     112      REAL(wp) ::   zmskt, zmskf                                     !   -      - 
    113113      REAL(wp) ::   zcoef0, zcoef3, zcoef4, zmkt, zmkf               !   -      - 
    114114      REAL(wp) ::   zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      - 
     
    135135            DO jj = 2, jpjm1 
    136136               DO ji = 2, jpim1 
    137                   uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 
    138                   vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
    139                   wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 
    140                   wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 
     137                  uslp (ji,jj,jk) = - ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
     138                  vslp (ji,jj,jk) = - ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
     139                  wslpi(ji,jj,jk) = - ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 
     140                  wslpj(ji,jj,jk) = - ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 
    141141               END DO 
    142142            END DO 
     
    183183            DO jj = 2, jpjm1 
    184184               DO ji = fs_2, jpi   ! vector opt. 
    185                   zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj) 
     185                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) * r1_e1t(ji,jj) 
    186186 
    187187                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     & 
     
    198198            DO jj = 2, jpjm1 
    199199               DO ji = fs_2, jpi   ! vector opt. 
    200                   zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 
     200                  zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * fse3t(ji,jj,jk) * r1_e1t(ji,jj) 
    201201 
    202202                  zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     & 
     
    215215         DO jj = 1, jpjm1 
    216216            DO ji = 1, fs_jpim1   ! vector opt. 
    217                zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 
     217               zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * fse3f(ji,jj,jk) * r1_e2f(ji,jj) 
    218218 
    219219               zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     & 
     
    236236         DO jj = 2, jpjm1 
    237237            DO ji = 1, fs_jpim1   ! vector opt. 
    238                zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 
     238               zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * fse3f(ji,jj,jk) * r1_e1f(ji,jj) 
    239239 
    240240               zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     & 
     
    253253            DO jj = 2, jpj 
    254254               DO ji = 1, fs_jpim1   ! vector opt. 
    255                   zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / e2t(ji,jj) 
     255                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) * r1_e2t(ji,jj) 
    256256 
    257257                  zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     & 
     
    268268            DO jj = 2, jpj 
    269269               DO ji = 1, fs_jpim1   ! vector opt. 
    270                   zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 
     270                  zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * fse3t(ji,jj,jk) * r1_e2t(ji,jj) 
    271271 
    272272                  zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
     
    285285         ! Second derivative (divergence) and add to the general trend 
    286286         ! ----------------------------------------------------------- 
    287  
    288287         DO jj = 2, jpjm1 
    289288            DO ji = 2, jpim1          !! Question vectop possible??? !!bug 
    290                ! volume elements 
    291                zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    292                zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    293                ! horizontal component of isopycnal momentum diffusive trends 
    294                zuah =( ziut (ji+1,jj) - ziut (ji,jj  ) +   & 
    295                   &    zjuf (ji  ,jj) - zjuf (ji,jj-1)  ) / zbu 
    296                zvah =( zivf (ji,jj  ) - zivf (ji-1,jj) +   & 
    297                   &    zjvt (ji,jj+1) - zjvt (ji,jj  )  ) / zbv 
    298                ! add the trends to the general trends 
    299                ua (ji,jj,jk) = ua (ji,jj,jk) + zuah 
    300                va (ji,jj,jk) = va (ji,jj,jk) + zvah 
     289               ua(ji,jj,jk) = ua(ji,jj,jk) + ( ziut(ji+1,jj) - ziut(ji,jj  )    & 
     290                  &                          + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     291               va(ji,jj,jk) = va(ji,jj,jk) + ( zivf(ji,jj  ) - zivf(ji-1,jj)    & 
     292                  &                          + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    301293            END DO 
    302294         END DO 
     
    411403         DO jk = 1, jpkm1 
    412404            DO ji = 2, jpim1 
    413                ! volume elements 
    414                zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 
    415                zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 
    416                ! part of the k-component of isopycnal momentum diffusive trends 
    417                zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu 
    418                zvav = ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / zbv 
    419                ! add the trends to the general trends 
    420                ua(ji,jj,jk) = ua(ji,jj,jk) + zuav 
    421                va(ji,jj,jk) = va(ji,jj,jk) + zvav 
     405               ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     406               va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    422407            END DO 
    423408         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    r4596 r4616  
    8989            DO ji = fs_2, jpi   ! vector opt. 
    9090               !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    91                zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) / ( e1f(ji-1,jj-1) * e2f(ji-1,jj-1) )     & 
     91               zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * fse3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)      & 
    9292                  &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)                & 
    9393                  &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  ) * fmask(ji-1,jj-1,jk) 
     
    101101         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div ) 
    102102            DO ji = fs_2, fs_jpim1   ! vector opt. 
    103                pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                  & 
    104                   &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
    105                   &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) /   e1u(ji,jj)                     ) 
     103               pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                   & 
     104                  &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) /  ( e2u(ji,jj) * fse3u(ji,jj,jk) )   & 
     105                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     ) 
    106106                  ! 
    107                pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                  & 
    108                   &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
    109                   &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) /   e2v(ji,jj)                     ) 
     107               pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                   & 
     108                  &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) /  ( e1v(ji,jj) * fse3v(ji,jj,jk) )   & 
     109                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     ) 
    110110            END DO 
    111111         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90

    r4372 r4616  
    349349      !! ** Method  : - Divergence: 
    350350      !!      - compute the divergence given by : 
    351       !!         zhdivnep = 1/(e1t*e2t*e3t) ( di[e2u*e3u zunep] + dj[e1v*e3v zvnep] ) 
     351      !!         zhdivnep = 1/(e1e2t*e3t) ( di[e2u*e3u zunep] + dj[e1v*e3v zvnep] ) 
    352352      !!      - compute the curl in tensorial formalism: 
    353353      !!         zmrotnep = 1/(e1f*e2f) ( di[e2v zvnep] - dj[e1u zunep] ) 
     
    414414               &    + e1v(ji  ,jj  )*fse3v(ji  ,jj  ,jk) * zvnep(ji  ,jj  ) * vmask(ji  ,jj  ,jk)    & 
    415415               &    - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * zvnep(ji  ,jj-1) * vmask(ji  ,jj-1,jk) )  & 
    416                &  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     416               &  / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    417417            END DO 
    418418         END DO 
     
    435435                  &        - e1u(ji  ,jj+1) * zunep(ji  ,jj+1) * umask(ji  ,jj+1,jk)     & 
    436436                  &        + e1u(ji  ,jj  ) * zunep(ji  ,jj  ) * umask(ji  ,jj  ,jk)  )  & 
    437                   &       * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) ) 
     437                  &       * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) 
    438438            END DO 
    439439         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r4370 r4616  
    5353#  include "domzgr_substitute.h90" 
    5454   !!---------------------------------------------------------------------- 
    55    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     55   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    5656   !! $Id$  
    5757   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    335335      ! 
    336336      DO jk = 1, jpkm1 
    337 #if defined key_vectopt_loop 
    338          DO jj = 1, 1         !Vector opt. => forced unrolling 
    339             DO ji = 1, jpij 
    340 #else  
    341337         DO jj = 1, jpj 
    342338            DO ji = 1, jpi 
    343 #endif                   
    344339               un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    345340               vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r4496 r4616  
    120120               DO ji = fs_2, fs_jpim1   ! vector opt. 
    121121                  spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    & 
    122                      &                      + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) /e1u(ji,jj) 
     122                     &                      + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
    123123                  spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    & 
    124                      &                      + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj) 
     124                     &                      + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj) 
    125125               END DO 
    126126            END DO 
     
    134134            DO jj = 2, jpjm1                         ! add tide potential forcing 
    135135               DO ji = fs_2, fs_jpim1   ! vector opt. 
    136                   spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj) 
    137                   spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj) 
     136                  spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
     137                  spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
    138138               END DO  
    139139            END DO 
     
    148148            DO jj = 2, jpjm1 
    149149               DO ji = fs_2, fs_jpim1   ! vector opt. 
    150                   spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 
    151                   spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 
     150                  spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 
     151                  spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 
    152152               END DO 
    153153            END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r4328 r4616  
    2525   USE iom             ! I/O library 
    2626   USE timing          ! Timing 
    27  
    2827 
    2928   IMPLICIT NONE 
     
    8079         DO jj = 2, jpjm1                    ! now surface pressure gradient 
    8180            DO ji = fs_2, fs_jpim1   ! vector opt. 
    82                spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj) 
    83                spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj) 
     81               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
     82               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
    8483            END DO  
    8584         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r4328 r4616  
    166166         DO jj = 2, jpjm1              ! Surface pressure gradient (now) 
    167167            DO ji = fs_2, fs_jpim1   ! vector opt. 
    168                spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj) 
    169                spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj) 
     168               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
     169               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
    170170            END DO  
    171171         END DO  
     
    192192      ! compute the next vertically averaged velocity (effect of the additional force not included) 
    193193      ! --------------------------------------------- 
     194      ! vertical sum 
    194195      DO jj = 2, jpjm1 
    195196         DO ji = fs_2, fs_jpim1   ! vector opt. 
    196             spgu(ji,jj) = 0._wp 
    197             spgv(ji,jj) = 0._wp 
    198          END DO 
    199       END DO 
    200  
    201       ! vertical sum 
    202 !CDIR NOLOOPCHG 
    203       IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll 
    204          DO jk = 1, jpkm1 
    205             DO ji = 1, jpij 
    206                spgu(ji,1) = spgu(ji,1) + fse3u_a(ji,1,jk) * ua(ji,1,jk) 
    207                spgv(ji,1) = spgv(ji,1) + fse3v_a(ji,1,jk) * va(ji,1,jk) 
    208             END DO 
    209          END DO 
    210       ELSE                        ! No  vector opt. 
    211          DO jk = 1, jpkm1 
    212             DO jj = 2, jpjm1 
    213                DO ji = 2, jpim1 
    214                   spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 
    215                   spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 
    216                END DO 
    217             END DO 
    218          END DO 
    219       ENDIF 
     197            spgu(ji,jj) = fse3u_a(ji,jj,1) * ua(ji,jj,1) 
     198            spgv(ji,jj) = fse3v_a(ji,jj,1) * va(ji,jj,1) 
     199         END DO 
     200      END DO 
     201      DO jk = 2, jpkm1 
     202         DO jj = 2, jpjm1 
     203            DO ji = 2, jpim1 
     204               spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 
     205               spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 
     206            END DO 
     207         END DO 
     208      END DO 
    220209 
    221210      ! transport: multiplied by the horizontal scale factor 
     
    294283         DO ji = fs_2, fs_jpim1   ! vector opt. 
    295284            ! trend of Transport divergence gradient 
    296             ztdgu = z2dtg * (gcx(ji+1,jj  ) - gcx(ji,jj) ) / e1u(ji,jj) 
    297             ztdgv = z2dtg * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj) 
     285            ztdgu = z2dtg * (gcx(ji+1,jj  ) - gcx(ji,jj) ) * r1_e1u(ji,jj) 
     286            ztdgv = z2dtg * (gcx(ji  ,jj+1) - gcx(ji,jj) ) * r1_e2v(ji,jj) 
    298287            ! multiplied by z2dt 
    299288#if defined key_bdy 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4496 r4616  
    7575#  include "vectopt_loop_substitute.h90" 
    7676   !!---------------------------------------------------------------------- 
    77    !! NEMO/OPA 3.5 , NEMO Consortium (2013) 
     77   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    7878   !! $Id: dynspg_ts.F90 
    7979   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    104104      ! 
    105105   END FUNCTION dyn_spg_ts_alloc 
     106 
    106107 
    107108   SUBROUTINE dyn_spg_ts( kt ) 
     
    290291      ! 
    291292      DO jk = 1, jpkm1 
    292 #if defined key_vectopt_loop 
    293          DO jj = 1, 1         !Vector opt. => forced unrolling 
    294             DO ji = 1, jpij 
    295 #else  
    296293         DO jj = 1, jpj 
    297294            DO ji = 1, jpi 
    298 #endif                                                                    
    299295               zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    300296               zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)          
     
    324320         DO jj = 2, jpjm1 
    325321            DO ji = fs_2, fs_jpim1   ! vector opt. 
    326                zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj) 
    327                zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
    328                zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj) 
    329                zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
     322               zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) 
     323               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) 
     324               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) 
     325               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) 
    330326               ! energy conserving formulation for planetary vorticity term 
    331                zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    332                zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
     327               zu_trd(ji,jj) = z1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
     328               zv_trd(ji,jj) =-z1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
    333329            END DO 
    334330         END DO 
     
    338334            DO ji = fs_2, fs_jpim1   ! vector opt. 
    339335               zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) & 
    340                  &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
     336                 &            + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj) 
    341337               zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) & 
    342                  &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
     338                 &            + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    343339               zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    344340               zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     
    349345         DO jj = 2, jpjm1 
    350346            DO ji = fs_2, fs_jpim1   ! vector opt. 
    351                zu_trd(ji,jj) = + z1_12 / e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) & 
    352                 &                                      + ftnw(ji+1,jj) * zwy(ji+1,jj  ) & 
    353                 &                                      + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
    354                 &                                      + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
    355                zv_trd(ji,jj) = - z1_12 / e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
    356                 &                                      + ftse(ji,jj+1) * zwx(ji  ,jj+1) & 
    357                 &                                      + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
    358                 &                                      + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) 
     347               zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) & 
     348                &                                         + ftnw(ji+1,jj) * zwy(ji+1,jj  ) & 
     349                &                                         + ftse(ji,jj  ) * zwy(ji  ,jj-1) & 
     350                &                                         + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
     351               zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 
     352                &                                         + ftse(ji,jj+1) * zwx(ji  ,jj+1) & 
     353                &                                         + ftnw(ji,jj  ) * zwx(ji-1,jj  ) & 
     354                &                                         + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    359355            END DO 
    360356         END DO 
     
    367363         DO jj = 2, jpjm1  
    368364            DO ji = fs_2, fs_jpim1   ! vector opt. 
    369                zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) / e1u(ji,jj) 
    370                zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) / e2v(ji,jj) 
     365               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj) 
     366               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj) 
    371367            END DO 
    372368         END DO 
     
    417413            DO jj = 2, jpjm1               
    418414               DO ji = fs_2, fs_jpim1   ! vector opt. 
    419                   zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) /e1u(ji,jj) 
    420                   zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj) 
     415                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 
     416                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 
    421417                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 
    422418                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg 
     
    427423               DO ji = fs_2, fs_jpim1   ! vector opt. 
    428424                  zu_spg =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    & 
    429                       &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) /e1u(ji,jj) 
     425                      &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
    430426                  zv_spg =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    & 
    431                       &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj) 
     427                      &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj) 
    432428                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 
    433429                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg 
     
    525521            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points 
    526522               DO ji = 2, fs_jpim1   ! Vector opt. 
    527                   zwx(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj)     & 
    528                      &              * ( e12t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    529                      &              +   e12t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 
    530                   zwy(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj)     & 
    531                      &              * ( e12t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
    532                      &              +   e12t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 
     523                  zwx(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj)     & 
     524                     &              * ( e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
     525                     &              +   e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 
     526                  zwy(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj)     & 
     527                     &              * ( e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     528                     &              +   e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 
    533529               END DO 
    534530            END DO 
     
    578574         ! Sum over sub-time-steps to compute advective velocities 
    579575         za2 = wgtbtp2(jn) 
    580          zu_sum  (:,:) = zu_sum  (:,:) + za2 * zwx  (:,:) / e2u  (:,:) 
    581          zv_sum  (:,:) = zv_sum  (:,:) + za2 * zwy  (:,:) / e1v  (:,:) 
     576         zu_sum  (:,:) = zu_sum  (:,:) + za2 * zwx  (:,:) * r1_e2u  (:,:) 
     577         zv_sum  (:,:) = zv_sum  (:,:) + za2 * zwy  (:,:) * r1_e1v  (:,:) 
    582578         ! 
    583579         ! Set next sea level: 
     
    585581            DO ji = fs_2, fs_jpim1   ! vector opt. 
    586582               zhdiv(ji,jj) = (   zwx(ji,jj) - zwx(ji-1,jj)   & 
    587                   &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e12t(ji,jj) 
     583                  &             + zwy(ji,jj) - zwy(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
    588584            END DO 
    589585         END DO 
     
    603599            DO jj = 2, jpjm1 
    604600               DO ji = 2, jpim1      ! NO Vector Opt. 
    605                   zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj)  & 
    606                      &              * ( e12t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
    607                      &              +   e12t(ji+1,jj  ) * ssha_e(ji+1,jj  ) ) 
    608                   zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj)  & 
    609                      &              * ( e12t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
    610                      &              +   e12t(ji  ,jj+1) * ssha_e(ji  ,jj+1) ) 
     601                  zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj)  & 
     602                     &              * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
     603                     &              +   e1e2t(ji+1,jj  ) * ssha_e(ji+1,jj  ) ) 
     604                  zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj)  & 
     605                     &              * ( e1e2t(ji  ,jj  ) * ssha_e(ji  ,jj  ) & 
     606                     &              +   e1e2t(ji  ,jj+1) * ssha_e(ji  ,jj+1) ) 
    611607               END DO 
    612608            END DO 
     
    642638            DO jj = 2, jpjm1                             
    643639               DO ji = 2, jpim1 
    644                   zx1 = z1_2 * umask(ji  ,jj,1) *  r1_e12u(ji  ,jj)    & 
    645                      &      * ( e12t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    & 
    646                      &      +   e12t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) ) 
    647                   zy1 = z1_2 * vmask(ji  ,jj,1) *  r1_e12v(ji  ,jj  )  & 
    648                      &       * ( e12t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  & 
    649                      &       +   e12t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) ) 
     640                  zx1 = z1_2 * umask(ji  ,jj,1) *  r1_e1e2u(ji  ,jj)    & 
     641                     &      * ( e1e2t(ji  ,jj  ) * zsshp2_e(ji  ,jj)    & 
     642                     &      +   e1e2t(ji+1,jj  ) * zsshp2_e(ji+1,jj  ) ) 
     643                  zy1 = z1_2 * vmask(ji  ,jj,1) *  r1_e1e2v(ji  ,jj  )  & 
     644                     &       * ( e1e2t(ji ,jj  ) * zsshp2_e(ji  ,jj  )  & 
     645                     &       +   e1e2t(ji ,jj+1) * zsshp2_e(ji  ,jj+1) ) 
    650646                  zhust_e(ji,jj) = hu_0(ji,jj) + zx1  
    651647                  zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 
     
    664660            DO jj = 2, jpjm1 
    665661               DO ji = fs_2, fs_jpim1   ! vector opt. 
    666                   zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj) 
    667                   zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
    668                   zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) / e2v(ji,jj) 
    669                   zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
    670                   zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    671                   zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
     662                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) 
     663                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
     664                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) 
     665                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
     666                  zu_trd(ji,jj) = z1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) * r1_e1u(ji,jj) 
     667                  zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) * r1_e2v(ji,jj) 
    672668               END DO 
    673669            END DO 
     
    677673               DO ji = fs_2, fs_jpim1   ! vector opt. 
    678674                  zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) & 
    679                    &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj) 
     675                   &             + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) * r1_e1u(ji,jj) 
    680676                  zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) & 
    681                    &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj) 
     677                   &             + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    682678                  zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    683679                  zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     
    688684            DO jj = 2, jpjm1 
    689685               DO ji = fs_2, fs_jpim1   ! vector opt. 
    690                   zu_trd(ji,jj) = + z1_12 / e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) & 
    691                      &                                    + ftnw(ji+1,jj) * zwy(ji+1,jj  ) & 
    692                      &                                    + ftse(ji,jj  ) * zwy(ji  ,jj-1) &  
    693                      &                                    + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
    694                   zv_trd(ji,jj) = - z1_12 / e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &  
    695                      &                                    + ftse(ji,jj+1) * zwx(ji  ,jj+1) & 
    696                      &                                    + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &  
    697                      &                                    + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) 
     686                  zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zwy(ji  ,jj  ) & 
     687                     &                                       + ftnw(ji+1,jj) * zwy(ji+1,jj  ) & 
     688                     &                                       + ftse(ji,jj  ) * zwy(ji  ,jj-1) &  
     689                     &                                       + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
     690                  zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zwx(ji-1,jj+1) &  
     691                     &                                       + ftse(ji,jj+1) * zwx(ji  ,jj+1) & 
     692                     &                                       + ftnw(ji,jj  ) * zwx(ji-1,jj  ) &  
     693                     &                                       + ftne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    698694               END DO 
    699695            END DO 
     
    705701            DO jj = 2, jpjm1 
    706702               DO ji = fs_2, fs_jpim1   ! vector opt. 
    707                   zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj) 
    708                   zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj) 
     703                  zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
     704                  zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
    709705                  zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg 
    710706                  zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg 
     
    721717            DO ji = fs_2, fs_jpim1   ! vector opt. 
    722718               ! Add surface pressure gradient 
    723                zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) / e1u(ji,jj) 
    724                zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) / e2v(ji,jj) 
     719               zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
     720               zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
    725721               zwx(ji,jj) = zu_spg 
    726722               zwy(ji,jj) = zv_spg 
     
    827823         DO jj = 1, jpjm1 
    828824            DO ji = 1, jpim1      ! NO Vector Opt. 
    829                zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e12u(ji,jj) & 
    830                   &              * ( e12t(ji  ,jj) * ssha(ji  ,jj)    & 
    831                   &              +   e12t(ji+1,jj) * ssha(ji+1,jj) ) 
    832                zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e12v(ji,jj) & 
    833                   &              * ( e12t(ji,jj  ) * ssha(ji,jj  )    & 
    834                   &              +   e12t(ji,jj+1) * ssha(ji,jj+1) ) 
     825               zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1)  * r1_e1e2u(ji,jj) & 
     826                  &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)    & 
     827                  &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 
     828               zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1)  * r1_e1e2v(ji,jj) & 
     829                  &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )    & 
     830                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 
    835831            END DO 
    836832         END DO 
     
    10711067         DO jj = 1, jpj 
    10721068            DO ji =1, jpi 
    1073                zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 
    1074                zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 
    1075                zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 
     1069               zxr2 = 1._wp / ( e1t(ji,jj)*e1t(ji,jj) ) 
     1070               zyr2 = 1._wp / ( e2t(ji,jj)*e2t(ji,jj) ) 
     1071               zcu(ji,jj) = SQRT( grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 
    10761072            END DO 
    10771073         END DO 
     
    10791075         DO jj = 1, jpj 
    10801076            DO ji =1, jpi 
    1081                zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 
    1082                zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 
    1083                zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) ) 
     1077               zxr2 = 1._wp / ( e1t(ji,jj)*e1t(ji,jj) ) 
     1078               zyr2 = 1._wp / ( e2t(ji,jj)*e2t(ji,jj) ) 
     1079               zcu(ji,jj) = SQRT( grav*ht(ji,jj)*(zxr2 + zyr2) ) 
    10841080            END DO 
    10851081         END DO 
     
    10921088      IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 
    10931089       
    1094       rdtbt = rdt / FLOAT(nn_baro) 
     1090      rdtbt = rdt / REAL( nn_baro, wp ) 
    10951091      zcmax = zcmax * rdtbt 
    10961092                     ! Print results 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r4596 r4616  
    245245               DO ji = 1, fs_jpim1   ! vector opt. 
    246246                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    247                      &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    248                      &       / ( e1f(ji,jj) * e2f(ji,jj) ) 
     247                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    249248               END DO 
    250249            END DO 
     
    254253                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    255254                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    256                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     255                       &     * 0.5 * r1_e1e2f(ji,jj) 
    257256               END DO 
    258257            END DO 
     
    262261                  zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    263262                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    264                      &                   / ( e1f(ji,jj) * e2f(ji,jj) ) 
     263                     &                   * r1_e1e2f(ji,jj) 
    265264               END DO 
    266265            END DO 
     
    271270                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    272271                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    273                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     272                       &     * 0.5 * r1_e1e2f(ji,jj) 
    274273               END DO 
    275274            END DO 
     
    293292               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 
    294293               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) 
    295                pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    296                pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 / e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
     294               pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
     295               pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
    297296            END DO   
    298297         END DO   
     
    357356               DO ji = 1, fs_jpim1   ! vector opt. 
    358357                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    359                      &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    360                      &       / ( e1f(ji,jj) * e2f(ji,jj) ) 
     358                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    361359               END DO 
    362360            END DO 
     
    366364                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    367365                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    368                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     366                       &     * 0.5 * r1_e1e2f(ji,jj) 
    369367               END DO 
    370368            END DO 
     
    374372                  zwz(ji,jj) = ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    375373                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    376                      &                   / ( e1f(ji,jj) * e2f(ji,jj) ) 
     374                     &                   * r1_e1e2f(ji,jj) 
    377375               END DO 
    378376            END DO 
     
    383381                       &     + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    384382                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    385                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) 
     383                       &     * 0.5 * r1_e1e2f(ji,jj) 
    386384               END DO 
    387385            END DO 
     
    401399         DO jj = 2, jpjm1 
    402400            DO ji = fs_2, fs_jpim1   ! vector opt. 
    403                zuav = r1_8 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
     401               zuav = r1_8 * r1_e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   & 
    404402                  &                       + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) 
    405                zvau =-r1_8 / e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
     403               zvau =-r1_8 * r1_e2v(ji,jj) * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1)   & 
    406404                  &                       + zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) 
    407405               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
     
    501499                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    502500                     &          - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    503                      &       / ( e1f(ji,jj) * e2f(ji,jj) ) * r1_e3f(ji,jj,jk) 
     501                     &       * r1_e1e2f(ji,jj) * r1_e3f(ji,jj,jk) 
    504502               END DO 
    505503            END DO 
     
    510508                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    511509                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    512                        &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * r1_e3f(ji,jj,jk) 
     510                       &     * 0.5 * r1_e1e2f(ji,jj) * r1_e3f(ji,jj,jk) 
    513511               END DO 
    514512            END DO 
     
    519517                  zwz(ji,jj) = (  ff(ji,jj) + (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    & 
    520518                     &                      - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) & 
    521                      &                      / ( e1f(ji,jj) * e2f(ji,jj) )    ) * r1_e3f(ji,jj,jk) 
     519                     &                      * r1_e1e2f(ji,jj)    ) * r1_e3f(ji,jj,jk) 
    522520               END DO 
    523521            END DO 
     
    529527                       &        + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       & 
    530528                       &            - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   & 
    531                        &        * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )   ) * r1_e3f(ji,jj,jk) 
     529                       &        * 0.5 * r1_e1e2f(ji,jj)   ) * r1_e3f(ji,jj,jk) 
    532530               END DO 
    533531            END DO 
     
    560558         DO jj = 2, jpjm1 
    561559            DO ji = fs_2, fs_jpim1   ! vector opt. 
    562                zua = + r1_12 / e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
    563                   &                          + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
    564                zva = - r1_12 / e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
    565                   &                          + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
     560               zua = + r1_12 * r1_e1u(ji,jj) * (  ztne(ji,jj  ) * zwy(ji  ,jj  ) + ztnw(ji+1,jj) * zwy(ji+1,jj  )   & 
     561                  &                             + ztse(ji,jj  ) * zwy(ji  ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 
     562               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
     563                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    566564               pua(ji,jj,jk) = pua(ji,jj,jk) + zua 
    567565               pva(ji,jj,jk) = pva(ji,jj,jk) + zva 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r3294 r4616  
    4747      !! 
    4848      !! ** Method  :   The now vertical advection of momentum is given by: 
    49       !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ] 
    50       !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ] 
     49      !!         w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ] 
     50      !!         w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ] 
    5151      !!      Add this trend to the general trend (ua,va): 
    5252      !!         (ua,va) = (ua,va) + w dz(u,v) 
     
    8383         DO jj = 2, jpj                   ! vertical fluxes  
    8484            DO ji = fs_2, jpi             ! vector opt. 
    85                zww(ji,jj) = 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) 
     85               zww(ji,jj) = 0.25 * e1e2t(ji,jj) * wn(ji,jj,jk) 
    8686            END DO 
    8787         END DO 
     
    106106            DO ji = fs_2, fs_jpim1       ! vector opt. 
    107107               !                         ! vertical momentum advective trends 
    108                zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    109                zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     108               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     109               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    110110               !                         ! add the trends to the general momentum trends 
    111111               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r4370 r4616  
    3939#  include "vectopt_loop_substitute.h90" 
    4040   !!---------------------------------------------------------------------- 
    41    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     41   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4242   !! $Id$ 
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    101101 
    102102      IF( ln_bfrimp ) THEN 
    103 # if defined key_vectopt_loop 
    104          DO jj = 1, 1 
    105             DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    106 # else 
    107103         DO jj = 2, jpjm1 
    108104            DO ji = 2, jpim1 
    109 # endif 
    110105               ikbu = mbku(ji,jj)       ! ocean bottom level at u- and v-points  
    111106               ikbv = mbkv(ji,jj)       ! (deepest ocean u- and v-points) 
     
    352347      !! restore bottom layer avmu(v)  
    353348      IF( ln_bfrimp ) THEN 
    354 # if defined key_vectopt_loop 
    355       DO jj = 1, 1 
    356          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    357 # else 
    358       DO jj = 2, jpjm1 
    359          DO ji = 2, jpim1 
    360 # endif 
    361             ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    362             ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    363             avmu(ji,jj,ikbu+1) = 0.e0 
    364             avmv(ji,jj,ikbv+1) = 0.e0 
    365          END DO 
    366       END DO 
     349         DO jj = 2, jpjm1 
     350            DO ji = 2, jpim1 
     351               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
     352               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
     353               avmu(ji,jj,ikbu+1) = 0._wp 
     354               avmv(ji,jj,ikbv+1) = 0._wp 
     355            END DO 
     356         END DO 
    367357      ENDIF 
    368358      ! 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r4596 r4616  
    194194            DO jj = 2, jpjm1 
    195195               DO ji = fs_2, fs_jpim1   ! vector opt. 
    196                   zhdiv(ji,jj,jk) = r1_e12t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 
     196                  zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 
    197197               END DO 
    198198            END DO 
     
    232232         CALL wrk_alloc( jpi, jpj, jpk, z3d )  
    233233         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    234          z2d(:,:) = rau0 * e12t(:,:) 
     234         z2d(:,:) = rau0 * e1e2t(:,:) 
    235235         DO jk = 1, jpk 
    236236            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90

    r3294 r4616  
    261261                     &   (  tcoef1(ki) * ub(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) +   & 
    262262                     &      tcoef2(ki) * un(iidu(jfl,jind1),ijdu(jfl,jind2),ikdu(jfl,jind3)) )   & 
    263                      &      / e1u(iidu(jfl,jind1),ijdu(jfl,jind2))  
     263                     &      * r1_e1u(iidu(jfl,jind1),ijdu(jfl,jind2))  
    264264               END DO 
    265265            END DO 
     
    345345                     &   ( tcoef1(ki) * vb(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3))  +   & 
    346346                     &     tcoef2(ki) * vn(iidv(jfl,jind1),ijdv(jfl,jind2),ikdv(jfl,jind3)) )    &  
    347                      &     / e2v(iidv(jfl,jind1),ijdv(jfl,jind2)) 
     347                     &     * r1_e2v(iidv(jfl,jind1),ijdv(jfl,jind2)) 
    348348               END DO 
    349349            END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90

    r4328 r4616  
    125125 
    126126            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. 
    127             zsurfz = e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl)) 
     127            zsurfz = e1e2t(iiloc(jfl),ijloc(jfl)) 
    128128            zvol   = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl)) 
    129129 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90

    r4596 r4616  
    236236 
    237237            ! Translation of this distances (in meter) in indexes 
    238             zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab/e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 
    239             zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 
     238            zgifl(jfl)= (iimfl(jfl)-0.5) + zdxab*r1_e1u(iimfl(jfl)-1,ijmfl(jfl)) + (mig(1)-jpizoom) 
     239            zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad*r1_e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom) 
    240240            zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   & 
    241241               &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              & 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90

    r3631 r4616  
    11MODULE icbthm 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  icbthm  *** 
     
    1110   !!            -    !  2011-05  (Alderson)       Use tmask instead of tmask_i 
    1211   !!---------------------------------------------------------------------- 
    13    !!---------------------------------------------------------------------- 
    14    !!   icb_thm : initialise 
    15    !!             reference for equations - M = Martin + Adcroft, OM 34, 2010 
     12    
     13   !!---------------------------------------------------------------------- 
     14   !!   icb_thm : initialise (reference for equations - M = Martin + Adcroft, OM 34, 2010) 
    1615   !!---------------------------------------------------------------------- 
    1716   USE par_oce        ! NEMO parameters 
     
    2120   USE phycst         ! NEMO physical constants 
    2221   USE sbc_oce 
    23  
     22   ! 
    2423   USE icb_oce        ! define iceberg arrays 
    2524   USE icbutl         ! iceberg utility routines 
     
    3130   PUBLIC   icb_thm ! routine called in icbstp.F90 module 
    3231 
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
     34   !! $Id: cla.F90 4596 2014-03-26 11:02:30Z gm $ 
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
    3337CONTAINS 
    3438 
     
    155159         ! use tmask rather than tmask_i when dealing with icebergs 
    156160         IF( tmask(ii,ij,1) /= 0._wp ) THEN    ! Add melting to the grid and field diagnostics 
    157             z1_e1e2    = 1._wp / e1e2t(ii,ij) * this%mass_scaling 
     161            z1_e1e2    = r1_e1e2t(ii,ij) * this%mass_scaling 
    158162            z1_dt_e1e2 = z1_dt * z1_e1e2 
    159163            zmelt    = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt   ! kg/s 
     
    194198            ! 
    195199         ELSE                            ! Diagnose mass distribution on grid 
    196             z1_e1e2 = 1._wp / e1e2t(ii,ij) * this%mass_scaling 
     200            z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling 
    197201            CALL icb_dia_size( ii, ij, zWn, zLn, zAbits,   & 
    198202            &                  this%mass_scaling, zMnew, znMbits, z1_e1e2) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r4292 r4616  
    7373 
    7474   !!---------------------------------------------------------------------- 
    75    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     75   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    7676   !! $Id$ 
    7777   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    812812               IF( zofs /= 0. )   pv_r1d(:) = pv_r1d(:) + zofs 
    813813            ELSEIF( PRESENT(pv_r2d) ) THEN 
    814 !CDIR COLLAPSE 
    815814               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf 
    816 !CDIR COLLAPSE 
    817815               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs 
    818816            ELSEIF( PRESENT(pv_r3d) ) THEN 
    819 !CDIR COLLAPSE 
    820817               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 
    821 !CDIR COLLAPSE 
    822818               IF( zofs /= 0.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 
    823819            ENDIF 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90

    r4596 r4616  
    316316            DO ji = mi0(161), mi1(161)         !------------------------------ 
    317317               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0) 
    318                   hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     318                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    319319               END DO 
    320320               !                                   ! recirculation water   (Ind -> Red)   (div >0) 
    321                hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) ) 
    322                hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) ) 
     321               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1e2t(ji,jj) * fse3t(ji,jj,20) ) 
     322               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1e2t(ji,jj) * fse3t(ji,jj,21) ) 
    323323            END DO 
    324324         END DO 
     
    327327            DO ji = mi0(161), mi1(161)         !------------------------------ 
    328328               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0) 
    329                hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) ) 
     329               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1e2t(ji,jj) * fse3t(ji,jj,21) ) 
    330330            END DO 
    331331         END DO 
     
    334334            DO ji = mi0(160), mi1(160)         !------------------------------ 
    335335               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0) 
    336                   hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     336                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    337337               END DO 
    338338               !                                   ! deep    outflow   (Red -> Ind)   (div >0) 
    339                hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) ) 
     339               hdiv_160_89(16)    = + zio_flow / (      e1e2t(ji,jj) * fse3t(ji,jj,16) ) 
    340340            END DO 
    341341         END DO 
     
    347347         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea 
    348348            DO ji = mi0(148), mi1(160)  
    349                zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
     349               zemp_red = zemp_red + emp(ji,jj) * e1e2t(ji,jj) * tmask_i(ji,jj) 
    350350            END DO 
    351351         END DO 
     
    421421         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point) 
    422422            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point)  
    423                ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   & 
    424                   &                              * e2u(ji,jj) * fse3u(ji,jj,:) 
     423               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 
    425424            END DO 
    426425         END DO 
    427426         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point) 
    428427            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point)  
    429                ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   & 
    430                   &                           * e2u(ji,jj) * fse3u(ji,jj,:) 
     428               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 
    431429            END DO 
    432430         END DO 
    433431         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side) 
    434432            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point) 
    435                va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   & 
    436                   &                              * e1v(ji,jj) * fse3v(ji,jj,:) 
     433               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1e2t(ji,jj+1) * fse3t(ji,jj+1,:) ) * e1v(ji,jj) * fse3v(ji,jj,:) 
    437434            END DO 
    438435         END DO 
     
    492489            DO ji = mi0(139), mi1(139)         !----------------------------- 
    493490               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0) 
    494                   hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     491                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    495492               END DO 
    496493               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)    
    497                   hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     494                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    498495               END DO 
    499496               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0) 
    500                hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     497               hdiv_139_101(21) =               + zrecirc_upp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    501498               ! 
    502499               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0) 
    503                hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     500               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    504501            END DO 
    505502         END DO 
     
    507504            DO ji = mi0(139), mi1(139)         !----------------------------- 
    508505               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)                 
    509                   hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     506                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    510507               END DO 
    511508               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0)  
    512                hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     509               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    513510            END DO 
    514511         END DO 
     
    516513            DO ji = mi0(141), mi1(141)         !------------------------------ 
    517514               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0) 
    518                   hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     515                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    519516               END DO 
    520517               !                                    ! deep    outflow toward the Atlantic    (div >0)  
    521                hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     518               hdiv_141_102(21)    = + zio_flow / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    522519            END DO 
    523520         END DO 
     
    529526         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea 
    530527            DO ji = mi0(141),mi1(181) 
    531                zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)  
     528               zemp_med = zemp_med + emp(ji,jj) * e1e2t(ji,jj) * tmask_i(ji,jj)  
    532529            END DO 
    533530         END DO 
    534531         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea  
    535532            DO ji = mi0(148),mi1(148) 
    536                zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
     533               zemp_med = zemp_med - emp(ji,jj) * e1e2t(ji,jj) * tmask_i(ji,jj) 
    537534            END DO 
    538535            DO ji = mi0(149),mi1(149) 
    539                zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
     536               zemp_med = zemp_med - emp(ji,jj) * e1e2t(ji,jj) * tmask_i(ji,jj) 
    540537            END DO 
    541538         END DO 
     
    549546               hdiv_139_101_kt(:) = hdiv_139_101(:)       
    550547               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0)  
    551                   hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     548                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    552549               END DO 
    553550               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:) 
     
    563560               hdiv_141_102(:) = hdiv_141_102(:) 
    564561               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0) 
    565                   hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     562                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    566563               END DO 
    567564               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:) 
     
    616613         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point) 
    617614            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign 
    618                ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   & 
    619                   &                             * e2u(ji,jj) * fse3u(ji,jj,:) 
     615               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1e2t(ji,jj) * fse3t(ji,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 
    620616            END DO 
    621617         END DO 
    622618         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point) 
    623619            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign 
    624                ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   & 
    625                   &                          * e2u(ji,jj) * fse3u(ji,jj,:)    
     620               ua(ji,jj,:) = hdiv_139_102(:) / ( e1e2t(ji,jj) * fse3t(ji,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:)    
    626621            END DO 
    627622         END DO 
    628623         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point) 
    629624            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign 
    630                ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   & 
    631                   &                            * e2u(ji,jj) * fse3u(ji,jj,:) 
     625               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 
    632626            END DO 
    633627         END DO 
     
    675669            DO ji = mi0(172), mi1(172)  
    676670               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0) 
    677                   hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     671                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    678672               END DO 
    679673               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0) 
    680                   hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     674                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    681675               END DO 
    682676            END DO 
     
    722716         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point) 
    723717            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign 
    724                ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   & 
    725                   &                           * e2u(ji,jj) * fse3u(ji,jj,:) 
     718               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1e2t(ji+1,jj) * fse3t(ji+1,jj,:) ) * e2u(ji,jj) * fse3u(ji,jj,:) 
    726719            END DO 
    727720         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r4596 r4616  
    144144      END DO 
    145145      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
    146 # if defined key_vectopt_loop 
    147          DO jj = 1, 1 
    148             DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    149 # else 
    150146         DO jj = 1, jpjm1 
    151147            DO ji = 1, jpim1 
    152 # endif 
    153148               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 
    154149               zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 
     
    179174            DO ji = fs_2, fs_jpim1   ! vector opt. 
    180175               !                                      ! horizontal and vertical density gradient at u- and v-points 
    181                zau = zgru(ji,jj,jk) / e1u(ji,jj) 
    182                zav = zgrv(ji,jj,jk) / e2v(ji,jj) 
     176               zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) 
     177               zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj) 
    183178               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) ) 
    184179               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) ) 
     
    433428                  zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )    ! j-gradient of T & S at v-point 
    434429                  zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    435                   zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    436                   zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
     430                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) * r1_e1u(ji,jj) 
     431                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) * r1_e2v(ji,jj) 
    437432                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN(  MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw  )   ! keep the sign 
    438433                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN(  MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw  ) 
     
    447442                  zdit = gtsu(ji,jj,jp_tem)   ;   zdjt = gtsv(ji,jj,jp_tem)      ! i- & j-gradient of Temperature 
    448443                  zdis = gtsu(ji,jj,jp_sal)   ;   zdjs = gtsv(ji,jj,jp_sal)      ! i- & j-gradient of Salinity 
    449                   zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj) 
    450                   zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj) 
     444                  zdxrho_raw = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) * r1_e1u(ji,jj) 
     445                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) * r1_e2v(ji,jj) 
    451446                  zdxrho(ji+ip,jj   ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw )   ! keep the sign 
    452447                  zdyrho(ji   ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
     
    468463                     zdks = 0._wp 
    469464                  ENDIF 
    470                   zdzrho_raw = ( - zalbet(ji   ,jj   ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 
    471                   zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln 
     465                  zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 
     466                  zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw )    ! force zdzrho >= repsln 
    472467                 END DO 
    473468            END DO 
     
    507502                     ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 
    508503                     zti_g_raw = (  zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp)      & 
    509                         &          - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk) 
    510                      ze3_e1    =  fse3w(ji+ip,jj,jk-kp) / e1u(ji,jj)  
     504                        &          - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj)  ) * umask(ji,jj,jk) 
     505                     ze3_e1    =  fse3w(ji+ip,jj,jk-kp) * r1_e1u(ji,jj)  
    511506                     zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1  , ABS( zti_g_raw ) ), zti_g_raw ) 
    512507                  ENDIF 
     
    550545                     ! 
    551546                     ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 
    552                      zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj) 
    553                      ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)                  ! unmasked 
     547                     zti_coord = znot_thru_surface * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) 
     548                     ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj)     ! unmasked 
    554549                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces 
    555550                     ztj_g_raw = ztj_raw - ztj_coord 
    556551                     ! additional limit required in bilaplacian case 
    557                      ze3_e1    = fse3w(ji+ip,jj   ,jk+kp) / e1u(ji,jj) 
    558                      ze3_e2    = fse3w(ji   ,jj+jp,jk+kp) / e2v(ji,jj) 
     552                     ze3_e1    = fse3w(ji+ip,jj   ,jk+kp) * r1_e1u(ji,jj) 
     553                     ze3_e2    = fse3w(ji   ,jj+jp,jk+kp) * r1_e2v(ji,jj) 
    559554                     ! NB: hard coded factor 5 (can be a namelist parameter...) 
    560555                     zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) 
     
    602597#endif 
    603598                     ! 
    604                      zbu  = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji   ,jj   ,jk   ) 
    605                      zbv  = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji   ,jj   ,jk   ) 
    606                      zbti = e1e2t(ji+ip,jj   )      * fse3w(ji+ip,jj   ,jk+kp) 
    607                      zbtj = e1e2t(ji   ,jj+jp)      * fse3w(ji   ,jj+jp,jk+kp) 
     599                     zbu  = e1e2u(ji   ,jj   ) * fse3u(ji   ,jj   ,jk   ) 
     600                     zbv  = e1e2v(ji   ,jj   ) * fse3v(ji   ,jj   ,jk   ) 
     601                     zbti = e1e2t(ji+ip,jj   ) * fse3w(ji+ip,jj   ,jk+kp) 
     602                     zbtj = e1e2t(ji   ,jj+jp) * fse3w(ji   ,jj+jp,jk+kp) 
    608603                     ! 
    609604                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked 
     
    673668      !                                            !==   surface mixed layer mask   ! 
    674669      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    675 # if defined key_vectopt_loop 
    676          DO jj = 1, 1 
    677             DO ji = 1, jpij                        ! vector opt. (forced unrolling) 
    678 # else 
    679670         DO jj = 1, jpj 
    680671            DO ji = 1, jpi 
    681 # endif 
    682672               ik = nmln(ji,jj) - 1 
    683673               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp 
     
    699689      !----------------------------------------------------------------------- 
    700690      ! 
    701 # if defined key_vectopt_loop 
    702       DO jj = 1, 1 
    703          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    704 # else 
    705691      DO jj = 2, jpjm1 
    706692         DO ji = 2, jpim1 
    707 # endif 
    708693            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==! 
    709694            ! 
     
    714699            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) ) 
    715700            !                        !- horizontal density gradient at u- & v-points 
    716             zau = p_gru(ji,jj,iku) / e1u(ji,jj) 
    717             zav = p_grv(ji,jj,ikv) / e2v(ji,jj) 
     701            zau = p_gru(ji,jj,iku) * r1_e1u(ji,jj) 
     702            zav = p_grv(ji,jj,ikv) * r1_e2v(ji,jj) 
    718703            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 
    719704            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 
     
    816801!               DO jj = 2, jpjm1 
    817802!                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    818 !                     uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk) 
    819 !                     vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk) 
    820 !                     wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 
    821 !                     wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 
     803!                     uslp (ji,jj,jk) = - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
     804!                     vslp (ji,jj,jk) = - ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
     805!                     wslpi(ji,jj,jk) = - ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 
     806!                     wslpj(ji,jj,jk) = - ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 
    822807!                  END DO 
    823808!               END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90

    r4596 r4616  
    106106         ! 
    107107         DO jk = 1 , jpkm1 
    108             zue2(:,:) = un(:,:,jk) / e2u(:,:)          !!gm  for stability reason use of before instead of now here !!!! 
    109             zve1(:,:) = vn(:,:,jk) / e1v(:,:) 
    110             zue1(:,:) = un(:,:,jk) / e1u(:,:) 
    111             zve2(:,:) = vn(:,:,jk) / e2v(:,:) 
     108            zue2(:,:) = un(:,:,jk) * r1_e2u(:,:)          !!gm  for stability reason use of before instead of now here !!!! 
     109            zve1(:,:) = vn(:,:,jk) * r1_e1v(:,:) 
     110            zue1(:,:) = un(:,:,jk) * r1_e1u(:,:) 
     111            zve2(:,:) = vn(:,:,jk) * r1_e2v(:,:) 
    112112            ! 
    113113            DO jj = 2, jpj                               !!gm  multiplication by tmask useless as un, vn maked field ! 
    114114               DO ji= 2, jpi 
    115                   zux(ji,jj) = ( zue2(ji,jj) - zue2(ji-1,jj  ) ) / e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh  
    116                   zvy(ji,jj) = ( zve1(ji,jj) - zve1(ji  ,jj-1) ) / e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh  
     115                  zux(ji,jj) = ( zue2(ji,jj) - zue2(ji-1,jj  ) ) * r1_e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh  
     116                  zvy(ji,jj) = ( zve1(ji,jj) - zve1(ji  ,jj-1) ) * r1_e1e2t(ji,jj) * tmask(ji,jj,jk) * zsmsh  
    117117               END DO 
    118118            END DO 
     
    120120            DO jj = 1, jpjm1 
    121121               DO ji = 1, jpim1 
    122                zuy(ji,jj) = ( zue1(ji  ,jj+1) - zue1(ji,jj) ) / e2f(ji,jj) *e1f(ji,jj) * fmask(ji,jj,jk) 
    123                zvx(ji,jj) = ( zve2(ji+1,jj  ) - zve2(ji,jj) ) / e1f(ji,jj) *e2f(ji,jj) * fmask(ji,jj,jk) 
     122               zuy(ji,jj) = ( zue1(ji  ,jj+1) - zue1(ji,jj) ) * r1_e2f(ji,jj) *e1f(ji,jj) * fmask(ji,jj,jk) 
     123               zvx(ji,jj) = ( zve2(ji+1,jj  ) - zve2(ji,jj) ) * r1_e1f(ji,jj) *e2f(ji,jj) * fmask(ji,jj,jk) 
    124124               END DO 
    125125            END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r3294 r4616  
    2323   USE netcdf           ! NetCDF library 
    2424   USE lib_mpp          ! MPP library 
    25    USE dom_oce, ONLY : &                  ! Domain variables 
    26       &                    tmask, tmask_i, e1t, e2t, gphit, glamt 
    27    USE obs_const, ONLY :   obfillflt      ! Fillvalue 
    28    USE oce      , ONLY :   sshn           ! Model variables 
     25   USE dom_oce  , ONLY :   tmask, tmask_i, e1e2t, gphit, glamt ! Domain variables 
     26   USE obs_const, ONLY :   obfillflt                           ! Fillvalue 
     27   USE oce      , ONLY :   sshn                                ! Model variables 
    2928 
    3029   IMPLICIT NONE 
     
    220219      DO jj = 1, jpj 
    221220         DO ji = 1, jpi 
    222           zdxdy = e1t(ji,jj) * e2t(ji,jj) * zpromsk(ji,jj) 
     221          zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj) 
    223222          zarea = zarea + zdxdy 
    224223          zeta1 = zeta1 + mdt(ji,jj) * zdxdy 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r4371 r4616  
    281281               ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 
    282282               ztintb =  1. - ztinta 
    283 !CDIR COLLAPSE 
    284283               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
    285284            ELSE   ! nothing to do... 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r4162 r4616  
    195195 
    196196      DO jj = 2, jpjm1 
    197 !CDIR NOVERRCHK 
    198197         DO ji = fs_2, jpi   ! vector opt. 
    199198 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r4306 r4616  
    168168      !!--------------------------------------------------------------------- 
    169169      zcoef = 0.5 / ( zrhoa * zcdrag )  
    170 !CDIR NOVERRCHK 
    171170      DO jj = 2, jpjm1 
    172 !CDIR NOVERRCHK 
    173171         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    174172            ztx = utau(ji-1,jj  ) + utau(ji,jj)  
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r4147 r4616  
    271271      ! module of wind stress and wind speed at T-point 
    272272      zcoef = 1. / ( zrhoa * zcdrag )  
    273 !CDIR NOVERRCHK 
    274273      DO jj = 2, jpjm1 
    275 !CDIR NOVERRCHK 
    276274         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    277275            ztx = utau(ji-1,jj  ) + utau(ji,jj)  
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r4147 r4616  
    240240      !   momentum fluxes  (utau, vtau )   ! 
    241241      !------------------------------------! 
    242 !CDIR COLLAPSE 
    243242      utau(:,:) = sf(jp_utau)%fnow(:,:,1) 
    244 !CDIR COLLAPSE 
    245243      vtau(:,:) = sf(jp_vtau)%fnow(:,:,1) 
    246244 
     
    248246      !   wind stress module (taum )       ! 
    249247      !------------------------------------! 
    250 !CDIR NOVERRCHK 
    251248      DO jj = 2, jpjm1 
    252 !CDIR NOVERRCHK 
    253249         DO ji = fs_2, fs_jpim1   ! vector opt. 
    254250            ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
     
    262258      !   store the wind speed  (wndm )    ! 
    263259      !------------------------------------! 
    264 !CDIR COLLAPSE 
    265260      wndm(:,:) = sf(jp_wndm)%fnow(:,:,1) 
    266261 
     
    274269      !   Other ocean fluxes   ! 
    275270      !------------------------! 
    276 !CDIR NOVERRCHK 
    277 !CDIR COLLAPSE 
    278271      DO jj = 1, jpj 
    279 !CDIR NOVERRCHK 
    280272         DO ji = 1, jpi 
    281273            ! 
     
    368360      zcprec = rcp /  rday     ! convert prec ( mm/day ==> m/s)  ==> W/m2 
    369361 
    370 !CDIR COLLAPSE 
    371362      emp(:,:) = zqla(:,:) / cevap                                        &   ! freshwater flux 
    372363         &     - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1) 
    373364      ! 
    374 !CDIR COLLAPSE 
    375365      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                        &   ! Downward Non Solar flux 
    376366         &     - zqla(:,:)             * pst(:,:) * zcevap                &   ! remove evap.   heat content at SST in Celcius 
     
    496486      !  and the correction factor for taking into account  the effect of clouds  
    497487      !------------------------------------------------------ 
    498 !CDIR NOVERRCHK 
    499 !CDIR COLLAPSE 
    500488      DO jj = 1, jpj 
    501 !CDIR NOVERRCHK 
    502489         DO ji = 1, jpi 
    503490            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                ! air temperature in Kelvins  
     
    546533      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    547534         !                                  ! ========================== ! 
    548 !CDIR NOVERRCHK 
    549 !CDIR COLLAPSE 
    550535         DO jj = 1 , jpj 
    551 !CDIR NOVERRCHK 
    552536            DO ji = 1, jpi 
    553537               !-------------------------------------------! 
     
    607591      ! ----------------------------------------------------------------------------- ! 
    608592      ! 
    609 !CDIR COLLAPSE 
    610593      p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    611 !CDIR COLLAPSE 
    612594      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s] 
    613595      ! 
     
    615597      !    Correct the OCEAN non solar flux with the existence of solid precipitation ! 
    616598      ! ---------------=====--------------------------------------------------------- ! 
    617 !CDIR COLLAPSE 
    618599      qns(:,:) = qns(:,:)                                                           &   ! update the non-solar heat flux with: 
    619600         &     - p_spr(:,:) * lfus                                                  &   ! remove melting solid precip 
     
    716697      ! Saturated water vapour and vapour pressure 
    717698      ! ------------------------------------------ 
    718 !CDIR NOVERRCHK 
    719 !CDIR COLLAPSE 
    720699      DO jj = 1, jpj 
    721 !CDIR NOVERRCHK 
    722700         DO ji = 1, jpi 
    723701            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt 
     
    748726      zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist ) 
    749727 
    750 !CDIR NOVERRCHK 
    751728      DO jj = 1, jpj 
    752 !CDIR NOVERRCHK 
    753729         DO ji = 1, jpi 
    754730            !  product of sine (cosine) of latitude and sine (cosine) of solar declination 
     
    771747 
    772748      ! compute and sum ocean qsr over the daylight (i.e. between sunrise and sunset) 
    773 !CDIR NOVERRCHK    
    774749      DO jt = 1, jp24 
    775750         zcoef = FLOAT( jt ) - 0.5 
    776 !CDIR NOVERRCHK      
    777 !CDIR COLLAPSE 
    778751         DO jj = 1, jpj 
    779 !CDIR NOVERRCHK 
    780752            DO ji = 1, jpi 
    781753               zlha = COS(  zlsrise(ji,jj) - zcoef * zdlha(ji,jj)  )                  ! local hour angle 
     
    796768      ! Taking into account the ellipsity of the earth orbit, the clouds AND masked if sea-ice cover > 0% 
    797769      zcoef1 = srgamma * zdaycor / ( 2. * rpi ) 
    798 !CDIR COLLAPSE 
    799770      DO jj = 1, jpj 
    800771         DO ji = 1, jpi 
     
    854825      ! Saturated water vapour and vapour pressure 
    855826      ! ------------------------------------------ 
    856 !CDIR NOVERRCHK 
    857 !CDIR COLLAPSE 
    858827      DO jj = 1, jpj 
    859 !CDIR NOVERRCHK 
    860828         DO ji = 1, jpi            
    861829            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt            
     
    886854      zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist ) 
    887855 
    888 !CDIR NOVERRCHK 
    889856      DO jj = 1, jpj 
    890 !CDIR NOVERRCHK 
    891857         DO ji = 1, jpi 
    892858            !  product of sine (cosine) of latitude and sine (cosine) of solar declination 
     
    913879      DO jl = 1, ijpl      !  loop over ice categories  ! 
    914880         !                 !----------------------------!  
    915 !CDIR NOVERRCHK    
    916881         DO jt = 1, jp24    
    917882            zcoef = FLOAT( jt ) - 0.5 
    918 !CDIR NOVERRCHK      
    919 !CDIR COLLAPSE 
    920883            DO jj = 1, jpj 
    921 !CDIR NOVERRCHK 
    922884               DO ji = 1, jpi 
    923885                  zlha = COS(  zlsrise(ji,jj) - zcoef * zdlha(ji,jj)  )                  ! local hour angle 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4333 r4616  
    8888#  include "vectopt_loop_substitute.h90" 
    8989   !!---------------------------------------------------------------------- 
    90    !! NEMO/OPA 3.3 , NEMO-consortium (2010)  
     90   !! NEMO/OPA 3.7 , NEMO-consortium (2014)  
    9191   !! $Id$ 
    9292   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    125125      !!---------------------------------------------------------------------- 
    126126      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    127       !! 
     127      ! 
    128128      INTEGER  ::   ierror   ! return error code 
    129129      INTEGER  ::   ifpr     ! dummy loop indice 
     
    141141         &                  sn_tdif, rn_zqt , ln_bulk2z, rn_zu 
    142142      !!--------------------------------------------------------------------- 
    143  
     143      ! 
    144144      !                                         ! ====================== ! 
    145145      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
     
    149149         READ  ( numnam_ref, namsbc_core, IOSTAT = ios, ERR = 901) 
    150150901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in reference namelist', lwp ) 
    151  
     151         ! 
    152152         REWIND( numnam_cfg )              ! Namelist namsbc_core in configuration namelist : CORE bulk parameters 
    153153         READ  ( numnam_cfg, namsbc_core, IOSTAT = ios, ERR = 902 ) 
     
    269269      zwnd_j(:,:) = 0.e0 
    270270#if defined key_cyclone 
    271 # if defined key_vectopt_loop 
    272 !CDIR COLLAPSE 
    273 # endif 
    274271      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add Manu ! 
    275272      DO jj = 2, jpjm1 
     
    279276         END DO 
    280277      END DO 
    281 #endif 
    282 #if defined key_vectopt_loop 
    283 !CDIR COLLAPSE 
    284278#endif 
    285279      DO jj = 2, jpjm1 
     
    292286      CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 
    293287      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    294 !CDIR NOVERRCHK 
    295 !CDIR COLLAPSE 
    296288      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
    297289         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
     
    306298      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
    307299      ENDIF 
    308 !CDIR COLLAPSE 
    309300      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    310301      ! ----------------------------------------------------------------------------- ! 
     
    313304 
    314305      ! ... specific humidity at SST and IST 
    315 !CDIR NOVERRCHK 
    316 !CDIR COLLAPSE 
    317306      zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) )  
    318307 
     
    340329      ELSE 
    341330         !! If air temp. and spec. hum. are given at same height than wind (10m) : 
    342 !gm bug?  at the compiling phase, add a copy in temporary arrays...  ==> check perf 
    343 !         CALL TURB_CORE_1Z( 10., zst   (:,:), sf(jp_tair)%fnow(:,:),              & 
    344 !            &                    zqsatw(:,:), sf(jp_humi)%fnow(:,:), wndm(:,:),   & 
    345 !            &                    Cd    (:,:),             Ch  (:,:), Ce  (:,:)  ) 
    346 !gm bug 
    347 ! ARPDBG - this won't compile with gfortran. Fix but check performance 
    348 ! as per comment above. 
    349331         CALL TURB_CORE_1Z( 10., zst   , sf(jp_tair)%fnow(:,:,1),       & 
    350332            &                    zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, & 
    351             &                    Cd    , Ch              , Ce    ) 
     333            &                    Cd    , Ch                     , Ce    ) 
    352334      ENDIF 
    353335 
     
    364346      ! ... add the HF tau contribution to the wind stress module? 
    365347      IF( lhftau ) THEN  
    366 !CDIR COLLAPSE 
    367348         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    368349      ENDIF 
     
    387368         zqsb (:,:) =                      rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat 
    388369      ELSE 
    389 !CDIR COLLAPSE 
    390370         zevap(:,:) = rn_efac * MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
    391 !CDIR COLLAPSE 
    392371         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
    393372      ENDIF 
    394 !CDIR COLLAPSE 
    395373      zqla (:,:) = Lv * zevap(:,:)                                                              ! Latent Heat 
    396374 
     
    409387      !     III    Total FLUXES                                                       ! 
    410388      ! ----------------------------------------------------------------------------- ! 
    411       
    412 !CDIR COLLAPSE 
     389      ! 
    413390      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    414391         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    415 !CDIR COLLAPSE 
    416392      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar flux 
    417393         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
     
    579555      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
    580556         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
    581 !CDIR NOVERRCHK 
    582557         DO jj = 2, jpjm1 
    583558            DO ji = 2, jpim1   ! B grid : NO vector opt 
     
    604579         ! 
    605580      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    606 #if defined key_vectopt_loop 
    607 !CDIR COLLAPSE 
    608 #endif 
    609581         DO jj = 2, jpj 
    610582            DO ji = fs_2, jpi   ! vect. opt. 
     
    614586            END DO 
    615587         END DO 
    616 #if defined key_vectopt_loop 
    617 !CDIR COLLAPSE 
    618 #endif 
    619588         DO jj = 2, jpjm1 
    620589            DO ji = fs_2, fs_jpim1   ! vect. opt. 
     
    635604      DO jl = 1, ijpl                       !  Loop over ice categories  ! 
    636605         !                                  ! ========================== ! 
    637 !CDIR NOVERRCHK 
    638 !CDIR COLLAPSE 
    639606         DO jj = 1 , jpj 
    640 !CDIR NOVERRCHK 
    641607            DO ji = 1, jpi 
    642608               ! ----------------------------! 
     
    690656      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    691657     
    692 !CDIR COLLAPSE 
    693658      p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca ) 
    694 !CDIR COLLAPSE 
    695659      p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca ) 
    696660        
    697 !CDIR COLLAPSE 
    698661      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
    699 !CDIR COLLAPSE 
    700662      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    701663      CALL iom_put( 'snowpre', p_spr * 86400. )                  ! Snow precipitation  
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r4147 r4616  
    248248         ! for basin budget and cooerence 
    249249         !-------------------------------------------------- 
    250 !CDIR COLLAPSE 
    251250           emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1) 
    252 !CDIR COLLAPSE 
    253251 
    254252         CALL iom_put( "qlw_oce",   qbw  )                 ! output downward longwave heat over the ocean 
     
    264262   
    265263  
    266    SUBROUTINE fluxes_mfs(alat,alon,hour,                               & 
    267         sst,tnow,shnow,unow,vnow,mslnow,cldnow,qsw,qbw,ha,elat,        & 
    268         evap,taux,tauy) 
     264   SUBROUTINE fluxes_mfs( alat, alon , hour, sst ,                   & 
     265      &                   tnow, shnow, unow, vnow, mslnow, cldnow,   & 
     266      &                   qsw , qbw  , ha  , elat, evap, taux, tauy ) 
    269267      !!---------------------------------------------------------------------- 
    270268      !!                    ***  ROUTINE fluxes_mfs  *** 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4393 r4616  
    752752         ! => need to be done only when otx1 was changed 
    753753         IF( llnewtx ) THEN 
    754 !CDIR NOVERRCHK 
    755754            DO jj = 2, jpjm1 
    756 !CDIR NOVERRCHK 
    757755               DO ji = fs_2, fs_jpim1   ! vect. opt. 
    758756                  zzx = frcv(jpr_otx1)%z3(ji-1,jj  ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 
     
    782780         IF( llnewtau ) THEN  
    783781            zcoef = 1. / ( zrhoa * zcdrag )  
    784 !CDIR NOVERRCHK 
    785782            DO jj = 1, jpj 
    786 !CDIR NOVERRCHK 
    787783               DO ji = 1, jpi  
    788784                  wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 
     
    797793      ! -> need to be reset before each call of the ice/fsbc       
    798794      IF( MOD( kt-1, k_fsbc ) == 0 ) THEN 
    799          ! 
    800795         utau(:,:) = frcv(jpr_otx1)%z3(:,:,1) 
    801796         vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1) 
    802797         taum(:,:) = frcv(jpr_taum)%z3(:,:,1) 
    803798         CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    804          !   
    805799      ENDIF 
    806800 
     
    832826!!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget 
    833827!!            ! remove negative runoff 
    834 !!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    835 !!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
     828!!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1e2t(:,:) * tmask_i(:,:) )  
     829!!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1e2t(:,:) * tmask_i(:,:) ) 
    836830!!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain 
    837831!!            IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
     
    11831177!!gm                                       at least should be optional... 
    11841178!!       ! remove negative runoff                            ! sum over the global domain 
    1185 !!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )  
    1186 !!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
     1179!!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1e2t(:,:) * tmask_i(:,:) )  
     1180!!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1e2t(:,:) * tmask_i(:,:) ) 
    11871181!!       IF( lk_mpp )   CALL mpp_sum( zcumulpos ) 
    11881182!!       IF( lk_mpp )   CALL mpp_sum( zcumulneg )  
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r4147 r4616  
    131131         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1) 
    132132         ENDIF 
    133 !CDIR COLLAPSE 
     133         ! 
    134134         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    135135            DO ji = 1, jpi 
     
    145145         !                                                        ! module of wind stress and wind speed at T-point 
    146146         zcoef = 1. / ( zrhoa * zcdrag ) 
    147 !CDIR NOVERRCHK 
    148147         DO jj = 2, jpjm1 
    149 !CDIR NOVERRCHK 
    150148            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    151149               ztx = utau(ji-1,jj  ) + utau(ji,jj)  
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r4292 r4616  
    5555   PRIVATE 
    5656 
    57    !! * Routine accessibility 
    5857   PUBLIC cice_sbc_init   ! routine called by sbc_init 
    5958   PUBLIC cice_sbc_final  ! routine called by sbc_final 
     
    8382   !! * Substitutions 
    8483#  include "domzgr_substitute.h90" 
    85  
     84   !!---------------------------------------------------------------------- 
    8685CONTAINS 
    8786 
     
    225224            DO jj = 1, jpjm1 
    226225               DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible 
    227                   zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
    228                   zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
     226                  zcoefu = 0.5  * umask(ji,jj,1) * r1_e1e2u(ji,jj) 
     227                  zcoefv = 0.5  * vmask(ji,jj,1) * r1_e1e2v(ji,jj) 
    229228                  zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
    230                   sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
    231                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 
    232                   sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
    233                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 
    234                   sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
    235                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 
    236                   sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
    237                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 
     229                  sshu_b(ji,jj) = zcoefu * ( e1e2t(ji,jj) * sshb(ji,jj) + e1e2t(ji+1,jj  ) * sshb(ji+1,jj  ) ) 
     230                  sshv_b(ji,jj) = zcoefv * ( e1e2t(ji,jj) * sshb(ji,jj) + e1e2t(ji  ,jj+1) * sshb(ji  ,jj+1) ) 
     231                  sshu_n(ji,jj) = zcoefu * ( e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj  ) * sshn(ji+1,jj  ) ) 
     232                  sshv_n(ji,jj) = zcoefv * ( e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji  ,jj+1) * sshn(ji  ,jj+1) ) 
    238233               END DO 
    239234            END DO 
     
    242237            DO jj = 1, jpjm1 
    243238               DO ji = 1, jpim1      ! NO Vector Opt. 
    244                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    245                        &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    246                        &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
    247                        &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
    248                END DO 
     239                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)      & 
     240                       &               * (  e1e2u(ji,jj  ) * sshu_n(ji,jj  )    & 
     241                       &                  + e1e2u(ji,jj+1) * sshu_n(ji,jj+1)  ) * r1_e1e2f(ji,jj) 
     242              END DO 
    249243            END DO 
    250244            CALL lbc_lnk( sshf_n, 'F', 1. ) 
     
    266260      INTEGER, INTENT(in   ) ::   kt   ! ocean time step 
    267261      INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type 
    268  
     262      ! 
    269263      INTEGER  ::   ji, jj, jl                   ! dummy loop indices       
    270264      REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice 
     
    458452! x comp and y comp of sea surface slope (on F points) 
    459453! T point to F point 
    460       DO jj=1,jpjm1 
    461          DO ji=1,jpim1 
    462             ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  ))/e1u(ji,jj  )   & 
    463                                + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) &  
    464                             *  fmask(ji,jj,1) 
    465          ENDDO 
    466       ENDDO 
    467       CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 
     454      DO jj = 1, jpjm1 
     455         DO ji = 1, jpim1 
     456            ztmp(ji,jj)=0.5 * (  (zpice(ji+1,jj  )-zpice(ji,jj  )) * r1_e1u(ji,jj  )    & 
     457               &               + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1)  ) * fmask(ji,jj,1) 
     458         END DO 
     459      END DO 
     460      CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 
    468461 
    469462! T point to F point 
    470       DO jj=1,jpjm1 
    471          DO ji=1,jpim1 
    472             ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj))/e2v(ji  ,jj)   & 
    473                                + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 
    474                             *  fmask(ji,jj,1) 
    475          ENDDO 
    476       ENDDO 
     463      DO jj = 1, jpjm1 
     464         DO ji = 1, jpim1 
     465            ztmp(ji,jj)=0.5 * (  (zpice(ji  ,jj+1)-zpice(ji  ,jj)) * r1_e2v(ji  ,jj)    & 
     466               &               + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj)  ) *  fmask(ji,jj,1) 
     467         END DO 
     468      END DO 
    477469      CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 
    478470 
     
    532524! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep] 
    533525 
    534       utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:) 
    535       vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)      
     526      utau(:,:) = ( 1.0 - fr_iu(:,:) ) * utau(:,:) - ss_iou(:,:) 
     527      vtau(:,:) = ( 1.0 - fr_iv(:,:) ) * vtau(:,:) - ss_iov(:,:)      
    536528 
    537529! Freshwater fluxes  
     
    542534! Not ideal since aice won't be the same as in the atmosphere.   
    543535! Better to use evap and tprecip? (but for now don't read in evap in this case) 
    544          emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
     536         emp(:,:)  = emp(:,:) + fr_i(:,:) * ( tprecip(:,:) - sprecip(:,:) ) 
    545537      ELSE IF (nsbc == 4) THEN 
    546          emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
     538         emp(:,:)  = ( 1.0 - fr_i(:,:) ) * emp(:,:)         
    547539      ELSE IF (nsbc ==5) THEN 
    548540! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
     
    551543      ENDIF 
    552544 
    553       CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. ) 
    554       CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. ) 
     545      CALL cice2nemo( fresh_gbm, ztmp1,'T', 1. ) 
     546      CALL cice2nemo( fsalt_gbm, ztmp2,'T', 1. ) 
    555547 
    556548! Check to avoid unphysical expression when ice is forming (ztmp1 negative) 
     
    559551! This check breaks conservation but seems reasonable until we have prognostic ice salinity 
    560552! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU) 
    561       WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0) 
    562       sfx(:,:)=ztmp2(:,:)*1000.0 
    563       emp(:,:)=emp(:,:)-ztmp1(:,:) 
     553      WHERE (ztmp1(:,:) < 0._wp )   ztmp2(:,:) = MAX( ztmp2(:,:) , ztmp1(:,:)*sss_m(:,:)/1000._wp ) 
     554      sfx(:,:) = ztmp2(:,:) * 1000.0 
     555      emp(:,:) = emp(:,:) - ztmp1(:,:) 
    564556  
    565557      CALL lbc_lnk( emp , 'T', 1. ) 
     
    584576! Now add in ice / snow related terms 
    585577! [fswthru will be zero unless running with calc_Tsfc=T in CICE] 
    586       CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. ) 
     578      CALL cice2nemo( fswthru_gbm,ztmp1,'T', 1. ) 
    587579      qsr(:,:)=qsr(:,:)+ztmp1(:,:) 
    588580      CALL lbc_lnk( qsr , 'T', 1. ) 
     
    590582      DO jj=1,jpj 
    591583         DO ji=1,jpi 
    592             nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0) 
     584            nfrzmlt(ji,jj) = MAX (nfrzmlt(ji,jj) , 0._wp ) 
    593585         ENDDO 
    594586      ENDDO 
     
    818810#endif 
    819811      !!--------------------------------------------------------------------- 
    820  
    821       CHARACTER(len=1), INTENT( in ) ::   & 
    822           cd_type       ! nature of pn grid-point 
    823           !             !   = T or F gridpoints 
    824       REAL(wp), INTENT( in ) ::   & 
    825           psgn          ! control of the sign change 
    826           !             !   =-1 , the sign is modified following the type of b.c. used 
    827           !             !   = 1 , no sign change 
    828       REAL(wp), DIMENSION(jpi,jpj) :: pn 
     812      CHARACTER(len=1), INTENT( in ) ::   cd_type   ! nature of pn grid-point (= T or F) 
     813      REAL(wp)        , INTENT( in ) ::   psgn      ! control of the sign change 
     814          !                                         !   =-1 , the sign is modified following the type of b.c. used 
     815          !                                         !   = 1 , no sign change 
     816      REAL(wp), DIMENSION(jpi,jpj) ::   pn          !!gm INTENT missing !!!!! 
    829817#if !defined key_nemocice_decomp 
    830818      REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2 
    831819      REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg 
    832820#endif 
    833       REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc 
     821      REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) ::   pc   !!gm INTENT missing !!!! 
    834822      INTEGER (int_kind) :: & 
    835823         field_type,        &! id for type of field (scalar, vector, angle) 
     
    838826 
    839827      INTEGER  ::   ji, jj, jn                      ! dummy loop indices 
     828      !!--------------------------------------------------------------------- 
    840829 
    841830!     A. Ensure all haloes are filled in NEMO field (pn) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4161 r4616  
    3333#  include "domzgr_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     35   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    3636   !! $Id$ 
    3737   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    107107 
    108108         ! Flux and ice fraction computation 
    109 !CDIR COLLAPSE 
    110109         DO jj = 1, jpj 
    111110            DO ji = 1, jpi 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r4147 r4616  
    4848#  include "domzgr_substitute.h90" 
    4949   !!---------------------------------------------------------------------- 
    50    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     50   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    5151   !! $Id$ 
    5252   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    9393            ! 
    9494            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    95 !CDIR COLLAPSE 
    9695               DO jj = 1, jpj 
    9796                  DO ji = 1, jpi 
     
    106105            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    107106               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    108 !CDIR COLLAPSE 
    109107               DO jj = 1, jpj 
    110108                  DO ji = 1, jpi 
     
    120118               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    121119               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    122 !CDIR COLLAPSE 
    123120               DO jj = 1, jpj 
    124121                  DO ji = 1, jpi                             
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90

    r4328 r4616  
    8989         DO ji = 2, jpim1 
    9090            zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
    91             zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient 
    92             zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient 
    93             zcoefe = -zcoef * hu(ji  ,jj  ) * e2u(ji  ,jj  ) / e1u(ji  ,jj  )    ! east coefficient 
    94             zcoefn = -zcoef * hv(ji  ,jj  ) * e1v(ji  ,jj  ) / e2v(ji  ,jj  )    ! north coefficient 
     91            zcoefs = -zcoef * hv(ji  ,jj-1) * e1_e2v(ji  ,jj-1)    ! south coefficient 
     92            zcoefw = -zcoef * hu(ji-1,jj  ) * e2_e1u(ji-1,jj  )    ! west coefficient 
     93            zcoefe = -zcoef * hu(ji  ,jj  ) * e2_e1u(ji  ,jj  )    ! east coefficient 
     94            zcoefn = -zcoef * hv(ji  ,jj  ) * e1_e2v(ji  ,jj  )    ! north coefficient 
    9595            gcp(ji,jj,1) = zcoefs 
    9696            gcp(ji,jj,2) = zcoefw 
    9797            gcp(ji,jj,3) = zcoefe 
    9898            gcp(ji,jj,4) = zcoefn 
    99             gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient 
     99            gcdmat(ji,jj) = e1e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient 
    100100               &          - zcoefs -zcoefw -zcoefe -zcoefn 
    101101         END DO 
     
    110110 
    111111            !  south coefficient 
    112             zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
     112            zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 
    113113            zcoefs = zcoefs * bdyvmask(ji,jj-1) 
    114114            gcp(ji,jj,1) = zcoefs 
    115115 
    116116            !  west coefficient 
    117             zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
     117            zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 
    118118            zcoefw = zcoefw * bdyumask(ji-1,jj) 
    119119            gcp(ji,jj,2) = zcoefw 
    120120 
    121121            !  east coefficient 
    122             zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
     122            zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 
    123123            zcoefe = zcoefe * bdyumask(ji,jj) 
    124124            gcp(ji,jj,3) = zcoefe 
    125125 
    126126            !  north coefficient 
    127             zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
     127            zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 
    128128            zcoefn = zcoefn * bdyvmask(ji,jj) 
    129129            gcp(ji,jj,4) = zcoefn 
    130130 
    131131            ! diagonal coefficient 
    132             gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 
    133                             - zcoefs -zcoefw -zcoefe -zcoefn 
     132            gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn 
    134133         END DO 
    135134      END DO 
     
    149148               !  south coefficient 
    150149               IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN 
    151                   zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
     150                  zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
    152151               ELSE 
    153                   zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
     152                  zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 
    154153               END IF 
    155154               gcp(ji,jj,1) = zcoefs 
     
    157156               !  west coefficient 
    158157               IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 )  ) THEN 
    159                   zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
     158                  zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
    160159               ELSE 
    161                   zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
     160                  zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 
    162161               END IF 
    163162               gcp(ji,jj,2) = zcoefw 
     
    165164               !   east coefficient 
    166165               IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN 
    167                   zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1)) 
     166                  zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1)) 
    168167               ELSE 
    169                   zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
     168                  zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 
    170169               END IF 
    171170               gcp(ji,jj,3) = zcoefe 
     
    173172               !   north coefficient 
    174173               IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN 
    175                   zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
     174                  zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
    176175               ELSE 
    177                   zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
     176                  zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 
    178177               END IF 
    179178               gcp(ji,jj,4) = zcoefn 
    180179               ! 
    181180               ! diagonal coefficient 
    182                gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   & 
    183                   &            - zcoefs -zcoefw -zcoefe -zcoefn 
     181               gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn 
    184182            END DO 
    185183         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r4292 r4616  
    133133      ! 
    134134      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    135 !CDIR NOVERRCHK 
     135         ! 
    136136         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
    137137         ! 
     
    265265      ! 
    266266      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    267 !CDIR NOVERRCHK 
     267         ! 
    268268         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 
    269269         ! 
     
    394394      ! 
    395395      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    396       ! 
    397 !CDIR NOVERRCHK 
     396         ! 
    398397         DO jj = 1, jpjm1 
    399 !CDIR NOVERRCHK 
    400398            DO ji = 1, fs_jpim1   ! vector opt. 
    401399               zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r4596 r4616  
    9090      !                                               !==  effective transport  ==! 
    9191      DO jk = 1, jpkm1 
    92          zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
    93          zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    94          zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk) 
     92         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
     93         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     94         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    9595      END DO 
    9696      ! 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r4499 r4616  
    8282      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv 
    8383      !!       * horizontal advective trend (divergence of the fluxes) 
    84       !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] } 
     84      !!               ztra = 1/(e1e2t*e3t) { di-1[zwx] + dj-1[zwy] } 
    8585      !!       * Add this trend now to the general trend of tracer (ta,sa): 
    8686      !!               pta = pta + ztra 
     
    249249            DO jj = 2, jpjm1 
    250250               DO ji = fs_2, fs_jpim1   ! vector opt. 
    251                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) ) 
     251                  zbtr = 1. / ( e1e2t(ji,jj) *  fse3t(ji,jj,jk) ) 
    252252                  ! advective trends 
    253253                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r4325 r4616  
    184184         DO jj = 1, jpjm1 
    185185            DO ji = 1, fs_jpim1   ! vector opt. 
    186                zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2u(ji,jj) / e1u(ji,jj)          & 
     186               zpsim_u(ji,jj) = rc_f *   zhu(ji,jj)   * zhu(ji,jj)   * e2_e1u(ji,jj)               & 
    187187                  &                  * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 
    188188                  ! 
    189                zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1v(ji,jj) / e2v(ji,jj)          & 
     189               zpsim_v(ji,jj) = rc_f *   zhv(ji,jj)   * zhv(ji,jj)   * e1_e2v(ji,jj)               & 
    190190                  &                  * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 
    191191            END DO 
     
    247247         ! divide by cross distance to give streamfunction with dimensions m^2/s 
    248248         DO jk = 1, ikmax+1 
    249             zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk)/e2u(:,:) 
    250             zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk)/e1v(:,:) 
     249            zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) / e2u(:,:) 
     250            zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) / e1v(:,:) 
    251251         END DO 
    252252         CALL iom_put( "psiu_mle", zpsi_uw )    ! i-mle streamfunction 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r4499 r4616  
    191191                  z0u = SIGN( 0.5, pun(ji,jj,jk) ) 
    192192                  zalpha = 0.5 - z0u 
    193                   zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     193                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    194194                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji+1,jj,jk)) 
    195195                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji  ,jj,jk)) 
     
    198198                  z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 
    199199                  zalpha = 0.5 - z0v 
    200                   zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     200                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    201201                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj+1,jk)) 
    202202                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj  ,jk)) 
     
    212212            DO jj = 2, jpjm1       
    213213               DO ji = fs_2, fs_jpim1   ! vector opt. 
    214                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     214                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    215215                  ! horizontal advective trends 
    216216                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    270270            DO jj = 2, jpjm1       
    271271               DO ji = fs_2, fs_jpim1   ! vector opt. 
    272                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
     272                  zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
    273273                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 
    274274                  zalpha = 0.5 + z0w 
     
    285285            DO jj = 2, jpjm1       
    286286               DO ji = fs_2, fs_jpim1   ! vector opt. 
    287                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     287                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    288288                  ! vertical advective trends  
    289289                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r4499 r4616  
    146146                  z0u = SIGN( 0.5, pun(ji,jj,jk) ) 
    147147                  zalpha = 0.5 - z0u 
    148                   zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 
     148                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 
    149149                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk) 
    150150                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk) 
     
    153153                  z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 
    154154                  zalpha = 0.5 - z0v 
    155                   zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 
     155                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 
    156156                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk) 
    157157                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk) 
     
    190190            DO jj = 2, jpjm1 
    191191               DO ji = fs_2, fs_jpim1   ! vector opt. 
    192                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     192                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    193193                  ! horizontal advective trends  
    194194                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    249249            DO jj = 2, jpjm1 
    250250               DO ji = fs_2, fs_jpim1   ! vector opt. 
    251                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
     251                  zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 
    252252                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 
    253253                  zalpha = 0.5 + z0w 
     
    275275            DO jj = 2, jpjm1       
    276276               DO ji = fs_2, fs_jpim1   ! vector opt. 
    277                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     277                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    278278                  ! vertical advective trends  
    279279                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r4499 r4616  
    224224            DO jj = 2, jpjm1 
    225225               DO ji = fs_2, fs_jpim1   ! vector opt.   
    226                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     226                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    227227                  ! horizontal advective trends 
    228228                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 
     
    350350            DO jj = 2, jpjm1 
    351351               DO ji = fs_2, fs_jpim1   ! vector opt.   
    352                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     352                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    353353                  ! horizontal advective trends 
    354354                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 
     
    413413            DO jj = 2, jpjm1 
    414414               DO ji = fs_2, fs_jpim1   ! vector opt. 
    415                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     415                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    416416                  ! k- vertical advective trends  
    417417                  ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )  
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r4499 r4616  
    151151            DO jj = 2, jpjm1 
    152152               DO ji = fs_2, fs_jpim1   ! vector opt. 
    153                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     153                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    154154                  ! total intermediate advective trends 
    155155                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    211211            DO jj = 2, jpjm1 
    212212               DO ji = fs_2, fs_jpim1   ! vector opt.   
    213                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     213                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    214214                  ! total advective trends 
    215215                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     
    321321 
    322322               ! up & down beta terms 
    323                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 
     323               zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 
    324324               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 
    325325               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90

    r4499 r4616  
    120120            DO jj = 1, jpjm1            ! First derivative (gradient) 
    121121               DO ji = 1, fs_jpim1   ! vector opt. 
    122                   zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) 
    123                   zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk) 
     122                  zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk) 
     123                  zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) 
    124124                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
    125125                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
     
    164164            DO jj = 2, jpjm1 
    165165               DO ji = fs_2, fs_jpim1   ! vector opt. 
    166                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     166                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    167167                  ! horizontal advective 
    168168                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   & 
     
    219219            DO jj = 2, jpjm1 
    220220               DO ji = fs_2, fs_jpim1   ! vector opt. 
    221                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     221                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    222222                  ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr 
    223223                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak  
     
    245245            DO jj = 2, jpjm1  
    246246               DO ji = fs_2, fs_jpim1   ! vector opt.    
    247                   zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     247                  zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    248248                  ! k- vertical advective trends   
    249249                  ztra = - zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) 
     
    259259               DO jj = 2, jpjm1 
    260260                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    261                      zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     261                     zbtr = 1.e0 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    262262                     z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr 
    263263                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn 
     
    358358               zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) ) 
    359359               ! up & down beta terms 
    360                zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 
     360               zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt 
    361361               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 
    362362               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r4147 r4616  
    8484      ! 
    8585      !                             !  Add the geothermal heat flux trend on temperature 
    86 #if defined key_vectopt_loop 
    87       DO jj = 1, 1 
    88          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    89 #else 
    9086      DO jj = 2, jpjm1 
    9187         DO ji = 2, jpim1 
    92 #endif 
    9388            ik = mbkt(ji,jj) 
    9489            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r4292 r4616  
    3737   USE timing         ! Timing 
    3838 
    39  
    4039   IMPLICIT NONE 
    4140   PRIVATE 
     
    4746   PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90 
    4847 
    49    LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag 
    50  
    51    !                                !!* Namelist nambbl * 
    52    INTEGER , PUBLIC ::   nn_bbl_ldf  !: =1   : diffusive bbl or not (=0) 
    53    INTEGER , PUBLIC ::   nn_bbl_adv  !: =1/2 : advective bbl or not (=0) 
    54    !                                            !  =1 : advective bbl using the bottom ocean velocity 
    55    !                                            !  =2 :     -      -  using utr_bbl proportional to grad(rho) 
    56    REAL(wp), PUBLIC ::   rn_ahtbbl   !: along slope bbl diffusive coefficient [m2/s] 
    57    REAL(wp), PUBLIC ::   rn_gambbl   !: lateral coeff. for bottom boundary layer scheme [s] 
    58  
    59    LOGICAL , PUBLIC ::   l_bbl                  !: flag to compute bbl diffu. flux coef and transport 
     48   !                                  !!* Namelist nambbl * 
     49   LOGICAL , PUBLIC ::   ln_trabbl     !: bottom boundary layer flag 
     50   INTEGER , PUBLIC ::   nn_bbl_ldf    !: =1   : diffusive bbl or not (=0) 
     51   INTEGER , PUBLIC ::   nn_bbl_adv    !: =1/2 : advective bbl or not (=0) 
     52   !                                   !         =1 : advective bbl using the bottom ocean velocity 
     53   !                                   !         =2 :     -      -  using utr_bbl proportional to grad(rho) 
     54   REAL(wp), PUBLIC ::   rn_ahtbbl     !: along slope bbl diffusive coefficient [m2/s] 
     55   REAL(wp), PUBLIC ::   rn_gambbl     !: lateral coeff. for bottom boundary layer scheme [s] 
     56 
     57   LOGICAL , PUBLIC ::   l_bbl         !: flag to compute bbl diffu. flux coef and transport 
    6058 
    6159   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer 
     
    179177      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    180178      !!---------------------------------------------------------------------- 
    181       ! 
    182179      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    183180      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
     
    186183      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    187184      INTEGER  ::   ik           ! local integers 
    188       REAL(wp) ::   zbtr         ! local scalars 
    189185      REAL(wp), POINTER, DIMENSION(:,:) :: zptb 
    190186      !!---------------------------------------------------------------------- 
     
    196192      DO jn = 1, kjpt                                     ! tracer loop 
    197193         !                                                ! =========== 
    198 #  if defined key_vectopt_loop 
    199          DO jj = 1, 1   ! vector opt. (forced unrolling) 
    200             DO ji = 1, jpij 
    201 #else 
    202194         DO jj = 1, jpj 
    203195            DO ji = 1, jpi 
    204 #endif 
    205196               ik = mbkt(ji,jj)                        ! bottom T-level index 
    206197               zptb(ji,jj) = ptb(ji,jj,ik,jn)              ! bottom before T and S 
     
    208199         END DO 
    209200         !                                                ! Compute the trend 
    210 #  if defined key_vectopt_loop 
    211          DO jj = 1, 1   ! vector opt. (forced unrolling) 
    212             DO ji = jpi+1, jpij-jpi-1 
    213 #  else 
    214201         DO jj = 2, jpjm1 
    215202            DO ji = 2, jpim1 
    216 #  endif 
    217203               ik = mbkt(ji,jj)                            ! bottom T-level index 
    218                zbtr = r1_e12t(ji,jj)  / fse3t(ji,jj,ik) 
    219                pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         & 
    220                   &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   & 
    221                   &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   & 
    222                   &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   & 
    223                   &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr 
     204               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  & 
     205                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & 
     206                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & 
     207                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
     208                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
     209                  &             / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) ) 
    224210            END DO 
    225211         END DO 
     
    264250      DO jn = 1, kjpt                                            ! tracer loop 
    265251         !                                                       ! =========== 
    266 # if defined key_vectopt_loop 
    267          DO jj = 1, 1 
    268             DO ji = 1, jpij-jpi-1   ! vector opt. (forced unrolling) 
    269 # else 
    270252         DO jj = 1, jpjm1 
    271253            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west 
    272 # endif 
    273254               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection 
    274255                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf) 
     
    278259                  ! 
    279260                  !                                               ! up  -slope T-point (shelf bottom point) 
    280                   zbtr = r1_e12t(iis,jj) / fse3t(iis,jj,ikus) 
     261                  zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 
    281262                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    282263                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
    283264                  ! 
    284265                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    285                      zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,jk) 
     266                     zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 
    286267                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
    287268                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
    288269                  END DO 
    289270                  ! 
    290                   zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,ikud) 
     271                  zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 
    291272                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    292273                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
     
    300281                  ! 
    301282                  ! up  -slope T-point (shelf bottom point) 
    302                   zbtr = r1_e12t(ji,ijs) / fse3t(ji,ijs,ikvs) 
     283                  zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 
    303284                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    304285                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
    305286                  ! 
    306287                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    307                      zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,jk) 
     288                     zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 
    308289                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
    309290                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
    310291                  END DO 
    311292                  !                                               ! down-slope T-point (deep bottom point) 
    312                   zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,ikvd) 
     293                  zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 
    313294                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
    314295                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
     
    353334      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    354335      !!---------------------------------------------------------------------- 
    355       ! 
    356336      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    357337      INTEGER         , INTENT(in   ) ::   kit000          ! first time step index 
     
    412392 
    413393      !                                        !* bottom temperature, salinity, velocity and depth 
    414 #if defined key_vectopt_loop 
    415       DO jj = 1, 1   ! vector opt. (forced unrolling) 
    416          DO ji = 1, jpij 
    417 #else 
    418394      DO jj = 1, jpj 
    419395         DO ji = 1, jpi 
    420 #endif 
    421396            ik = mbkt(ji,jj)                        ! bottom T-level index 
    422397            ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1)      ! bottom before T and S 
     
    629604 
    630605      !                             !* masked diffusive flux coefficients 
    631       ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:) * umask(:,:,1) 
    632       ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:) * vmask(:,:,1) 
     606      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 
     607      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
    633608 
    634609 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r4596 r4616  
    7272      !!               - pahv e2u*vslp    dk[ mj(mk(tb)) ] 
    7373      !!      take the horizontal divergence of the fluxes: 
    74       !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  } 
     74      !!         difft = 1/(e1e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  } 
    7575      !!      Add this trend to the general trend (ta,sa): 
    7676      !!         ta = ta + difft 
     
    8282      !!                   + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ]  } 
    8383      !!      take the horizontal divergence of the fluxes: 
    84       !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ] 
     84      !!         difft = 1/(e1e2t*e3t) dk[ zftw ] 
    8585      !!      Add this trend to the general trend (ta,sa): 
    8686      !!         pta = pta + difft 
     
    246246            DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    247247               DO ji = 1, fs_jpim1   ! vector opt. 
    248                   zabe1 = pahu(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 
    249                   zabe2 = pahv(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 
     248                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u(ji,jj,jk) 
     249                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v(ji,jj,jk) 
    250250                  ! 
    251251                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   & 
     
    259259                  ! 
    260260                  zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   & 
    261                      &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      & 
    262                      &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk) 
     261                     &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      & 
     262                     &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk) 
    263263                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   & 
    264                      &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
    265                      &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                   
     264                     &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
     265                     &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                   
    266266               END DO 
    267267            END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r4596 r4616  
    3838   PUBLIC   tra_ldf_blp   ! routine called by step.F90 
    3939 
    40    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients 
    41  
    4240   !! * Substitutions 
    4341#  include "domzgr_substitute.h90" 
     
    6159      !!      fields (forward time scheme). The horizontal diffusive trends of  
    6260      !!      the tracer is given by: 
    63       !!          difft = 1/(e1t*e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ] 
    64       !!                                   + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 
     61      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ] 
     62      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 
    6563      !!      Add this trend to the general tracer trend pta : 
    6664      !!          pta = pta + difft 
     
    9896         DO jj = 1, jpjm1 
    9997            DO ji = 1, fs_jpim1   ! vector opt. 
    100                zaheeu(ji,jj,jk) = pahu(ji,jj,jk) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)   !!gm   * umask(ji,jj,jk) 
    101                zaheev(ji,jj,jk) = pahv(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)   !!gm   * vmask(ji,jj,jk) 
     98               zaheeu(ji,jj,jk) = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u(ji,jj,jk)   !!gm   * umask(ji,jj,jk) 
     99               zaheev(ji,jj,jk) = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v(ji,jj,jk)   !!gm   * vmask(ji,jj,jk) 
    102100            END DO 
    103101         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4333 r4616  
    6262#  include "vectopt_loop_substitute.h90" 
    6363   !!---------------------------------------------------------------------- 
    64    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     64   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    6565   !! $Id$ 
    6666   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    187187                  CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step 
    188188                  !          
    189 !CDIR COLLAPSE 
    190 !CDIR NOVERRCHK 
    191189                  DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl 
    192 !CDIR NOVERRCHK 
    193190                     DO ji = 1, jpi 
    194191                        zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
     
    215212               ! 
    216213               DO jk = 2, nksr+1 
    217 !CDIR NOVERRCHK 
    218214                  DO jj = 1, jpj 
    219 !CDIR NOVERRCHK    
    220215                     DO ji = 1, jpi 
    221216                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     ) 
     
    502497                
    503498                  DO jk = 2, nksr+1 
    504 !CDIR NOVERRCHK 
    505499                     DO jj = 1, jpj 
    506 !CDIR NOVERRCHK    
    507500                        DO ji = 1, jpi 
    508501                           zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r     ) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r4596 r4616  
    105105      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    106106         ! 
    107 # if defined key_vectopt_loop 
    108          jj = 1 
    109          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    110 # else 
    111107         DO jj = 1, jpjm1 
    112108            DO ji = 1, jpim1 
    113 # endif 
    114109               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    115110               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
     
    146141                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 
    147142               ENDIF 
    148 # if ! defined key_vectopt_loop 
    149143            END DO 
    150 # endif 
    151144         END DO 
    152145         CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. )   ;   CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. )   ! Lateral boundary cond. 
     
    156149      ! horizontal derivative of density anomalies (rd) 
    157150      IF( PRESENT( prd ) ) THEN         ! depth of the partial step level 
    158 # if defined key_vectopt_loop 
    159          jj = 1 
    160          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    161 # else 
    162151         DO jj = 1, jpjm1 
    163152            DO ji = 1, jpim1 
    164 # endif 
    165153               iku = mbku(ji,jj) 
    166154               ikv = mbkv(ji,jj) 
     
    173161               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv)     ! -     -      case 2 
    174162               ENDIF 
    175 # if ! defined key_vectopt_loop 
    176163            END DO 
    177 # endif 
    178164         END DO 
    179165 
     
    184170 
    185171         ! Gradient of density at the last level  
    186 # if defined key_vectopt_loop 
    187          jj = 1 
    188          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled) 
    189 # else 
    190172         DO jj = 1, jpjm1 
    191173            DO ji = 1, jpim1 
    192 # endif 
    193174               iku = mbku(ji,jj) 
    194175               ikv = mbkv(ji,jj) 
     
    201182               ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2 
    202183               ENDIF 
    203 # if ! defined key_vectopt_loop 
    204184            END DO 
    205 # endif 
    206185         END DO 
    207186         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90

    r4596 r4616  
    9292         SELECT CASE( ktrd ) 
    9393         CASE( jpdyn_trd_swf )         ! surface forcing 
    94             umo(ktrd) = SUM( ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1) ) 
    95             vmo(ktrd) = SUM( ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1) ) 
     94            umo(ktrd) = SUM( ptrd2dx(:,:) * e1e2u(:,:) * fse3u(:,:,1) ) 
     95            vmo(ktrd) = SUM( ptrd2dy(:,:) * e1e2v(:,:) * fse3v(:,:,1) ) 
    9696         END SELECT 
    9797         ! 
     
    104104      ! 
    105105      CASE( 'DYN' )              ! Momentum 
    106          hke(ktrd) = SUM(   un(:,:,1) * ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1)   & 
    107             &             + vn(:,:,1) * ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1)   ) 
     106         hke(ktrd) = SUM(   un(:,:,1) * ptrd2dx(:,:) * e1e2u(:,:) * fse3u(:,:,1)   & 
     107            &             + vn(:,:,1) * ptrd2dy(:,:) * e1e2v(:,:) * fse3v(:,:,1)   ) 
    108108         ! 
    109109      CASE( 'TRA' )              ! Tracers 
     
    159159         vmo(ktrd) = 0._wp 
    160160         DO jk = 1, jpkm1 
    161             umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) ) 
    162             vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) ) 
     161            umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2u(:,:) * fse3u(:,:,jk) ) 
     162            vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2v(:,:) * fse3v(:,:,jk) ) 
    163163         END DO 
    164164         ! 
     
    178178         hke(ktrd) = 0._wp 
    179179         DO jk = 1, jpkm1 
    180             hke(ktrd) = hke(ktrd) + SUM(   un(:,:,jk) * ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk)   & 
    181                &                         + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk)   ) 
     180            hke(ktrd) = hke(ktrd) + SUM(   un(:,:,jk) * ptrd3dx(:,:,jk) * e1e2u(:,:) * fse3u(:,:,jk)   & 
     181               &                         + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1e2v(:,:) * fse3v(:,:,jk)   ) 
    182182         END DO 
    183183         ! 
     
    230230         DO jj = 2, jpjm1 
    231231            DO ji = fs_2, fs_jpim1   ! vector opt. 
    232                tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
    233                tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
     232               tvolu = tvolu + e1e2u(ji,jj) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk) 
     233               tvolv = tvolv + e1e2v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 
    234234            END DO 
    235235         END DO 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r3632 r4616  
    179179         DO jj = 2, jpjm1 
    180180            DO ji = fs_2, fs_jpim1   ! vector opt. 
    181                zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     181               zbtr    = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    182182               ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    & 
    183183                 &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  ) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r4381 r4616  
    105105         IF ( ln_loglayer.AND.lk_vvl ) THEN ! "log layer" bottom friction coefficient 
    106106 
    107 #  if defined key_vectopt_loop 
    108             DO jj = 1, 1 
    109 !CDIR NOVERRCHK 
    110                DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    111 #  else 
    112 !CDIR NOVERRCHK 
    113107            DO jj = 1, jpj 
    114 !CDIR NOVERRCHK 
    115108               DO ji = 1, jpi 
    116 #  endif 
    117109                  ikbt = mbkt(ji,jj) 
    118110! JC: possible WAD implementation should modify line below if layers vanish 
     
    127119         ENDIF 
    128120 
    129 # if defined key_vectopt_loop 
    130          DO jj = 1, 1 
    131 !CDIR NOVERRCHK 
    132             DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    133 # else 
    134 !CDIR NOVERRCHK 
    135121         DO jj = 2, jpjm1 
    136 !CDIR NOVERRCHK 
    137122            DO ji = 2, jpim1 
    138 # endif 
    139123               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
    140124               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
     
    265249         ! 
    266250         IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all 
    267 #  if defined key_vectopt_loop 
    268             DO jj = 1, 1 
    269 !CDIR NOVERRCHK 
    270                DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    271 #  else 
    272 !CDIR NOVERRCHK 
    273251            DO jj = 1, jpj 
    274 !CDIR NOVERRCHK 
    275252               DO ji = 1, jpi 
    276 #  endif 
    277253                  ikbt = mbkt(ji,jj) 
    278254                  ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 
     
    309285      zmaxbfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient 
    310286      ! 
    311 #  if defined key_vectopt_loop 
    312       DO jj = 1, 1 
    313 !CDIR NOVERRCHK 
    314          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    315 #  else 
    316 !CDIR NOVERRCHK 
    317287      DO jj = 2, jpjm1 
    318 !CDIR NOVERRCHK 
    319288         DO ji = 2, jpim1 
    320 #  endif 
    321289             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points 
    322290             ikbv = mbkv(ji,jj) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r4147 r4616  
    4444#  include "vectopt_loop_substitute.h90" 
    4545   !!---------------------------------------------------------------------- 
    46    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     46   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    4747   !! $Id$ 
    4848   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    145145         ! ------------------ 
    146146         ! Constant eddy coefficient: reset to the background value 
    147 !CDIR NOVERRCHK 
    148147         DO jj = 1, jpj 
    149 !CDIR NOVERRCHK 
    150148            DO ji = 1, jpi 
    151149               zinr = 1./rrau(ji,jj,jk) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r3294 r4616  
    7878         ! 
    7979         DO jk = 1, jpkm1  
    80 #if defined key_vectopt_loop 
    81             DO jj = 1, 1                     ! big loop forced 
    82                DO ji = jpi+2, jpij    
    83 #else 
    8480            DO jj = 2, jpj             ! no vector opt. 
    8581               DO ji = 2, jpi 
    86 #endif 
    8782#if defined key_zdfkpp 
    8883                  ! no evd mixing in the boundary layer with KPP 
     
    110105         DO jk = 1, jpkm1 
    111106!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!  
    112 #if defined key_vectopt_loop 
    113             DO jj = 1, 1                     ! big loop forced 
    114                DO ji = 1, jpij    
    115 #else 
    116107            DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call) 
    117108               DO ji = 1, jpi 
    118 #endif 
    119109#if defined key_zdfkpp 
    120110                  ! no evd mixing in the boundary layer with KPP 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r4147 r4616  
    112112#  include "vectopt_loop_substitute.h90" 
    113113   !!---------------------------------------------------------------------- 
    114    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     114   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    115115   !! $Id$ 
    116116   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    174174 
    175175      ! Compute surface and bottom friction at T-points 
    176 !CDIR NOVERRCHK 
    177176      DO jj = 2, jpjm1 
    178 !CDIR NOVERRCHK 
    179177         DO ji = fs_2, fs_jpim1   ! vector opt. 
    180178            !  
     
    387385         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin 
    388386         !                      ! Balance between the production and the dissipation terms 
    389 !CDIR NOVERRCHK 
    390          DO jj = 2, jpjm1 
    391 !CDIR NOVERRCHK 
     387         DO jj = 2, jpjm1 
    392388            DO ji = fs_2, fs_jpim1   ! vector opt. 
    393389               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     
    410406      CASE ( 1 )             ! Neumman boundary condition 
    411407         !                       
    412 !CDIR NOVERRCHK 
    413          DO jj = 2, jpjm1 
    414 !CDIR NOVERRCHK 
     408         DO jj = 2, jpjm1 
    415409            DO ji = fs_2, fs_jpim1   ! vector opt. 
    416410               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     
    650644         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * hbro 
    651645         !                      ! Balance between the production and the dissipation terms 
    652 !CDIR NOVERRCHK 
    653          DO jj = 2, jpjm1 
    654 !CDIR NOVERRCHK 
     646         DO jj = 2, jpjm1 
    655647            DO ji = fs_2, fs_jpim1   ! vector opt. 
    656648               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
     
    673665      CASE ( 1 )             ! Neumman boundary condition 
    674666         !                       
    675 !CDIR NOVERRCHK 
    676          DO jj = 2, jpjm1 
    677 !CDIR NOVERRCHK 
     667         DO jj = 2, jpjm1 
    678668            DO ji = fs_2, fs_jpim1   ! vector opt. 
    679669               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r4147 r4616  
    147147#  include  "zdfddm_substitute.h90" 
    148148   !!---------------------------------------------------------------------- 
    149    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     149   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    150150   !! $Id$ 
    151151   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    435435            ws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal)                          & 
    436436               &             + sfx(ji,jj)                                     ) * rcs * tmask(ji,jj,1)  
    437          ENDDO 
    438       ENDDO 
     437         END DO 
     438      END DO 
    439439 
    440440      zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. )  
     
    447447            ! Friction velocity (zustar), at T-point : LMD94 eq. 2 
    448448            zustar(ji,jj) = SQRT( taum(ji,jj) / ( zrhos +  epsln ) ) 
    449          ENDDO 
    450       ENDDO 
    451  
    452 !CDIR NOVERRCHK   
    453       !                                               ! =============== 
     449         END DO 
     450      END DO 
     451 
     452      !                                                ! =============== 
    454453      DO jj = 2, jpjm1                                 !  Vertical slab 
    455454         !                                             ! =============== 
    456           
     455         ! 
    457456         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    458457         ! II Compute Boundary layer mixing coef. and diagnose the new boundary layer depth 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r4147 r4616  
    9999#  include "vectopt_loop_substitute.h90" 
    100100   !!---------------------------------------------------------------------- 
    101    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     101   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    102102   !! $Id$ 
    103103   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    256256      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    257257      !                     en(bot)   = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 
    258 !CDIR NOVERRCHK 
     258!!bfr   - commented area 
    259259!!    DO jj = 2, jpjm1 
    260 !CDIR NOVERRCHK 
    261260!!       DO ji = fs_2, fs_jpim1   ! vector opt. 
    262261!!          ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + & 
     
    291290         END DO 
    292291         !                               ! finite LC depth 
    293 # if defined key_vectopt_loop 
    294          DO jj = 1, 1 
    295             DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    296 # else 
    297292         DO jj = 1, jpj  
    298293            DO ji = 1, jpi 
    299 # endif 
    300294               zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj)) 
    301295            END DO 
    302296         END DO 
    303297         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    304 !CDIR NOVERRCHK 
    305298         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    306 !CDIR NOVERRCHK 
    307             DO jj = 2, jpjm1 
    308 !CDIR NOVERRCHK 
     299            DO jj = 2, jpjm1 
    309300               DO ji = fs_2, fs_jpim1   ! vector opt. 
    310301                  zus  = zcof * SQRT( taum(ji,jj) )           ! Stokes drift 
     
    425416         END DO 
    426417      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    427 !CDIR NOVERRCHK 
    428418         DO jk = 2, jpkm1 
    429 !CDIR NOVERRCHK 
    430             DO jj = 2, jpjm1 
    431 !CDIR NOVERRCHK 
     419            DO jj = 2, jpjm1 
    432420               DO ji = fs_2, fs_jpim1   ! vector opt. 
    433421                  ztx2 = utau(ji-1,jj  ) + utau(ji,jj) 
     
    513501      zmxlm(:,:,jpk)  = rmxl_min     ! last level set to the interior minium value 
    514502      ! 
    515 !CDIR NOVERRCHK 
    516503      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2) 
    517 !CDIR NOVERRCHK 
    518504         DO jj = 2, jpjm1 
    519 !CDIR NOVERRCHK 
    520505            DO ji = fs_2, fs_jpim1   ! vector opt. 
    521506               zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 
     
    588573            END DO 
    589574         END DO 
    590 !CDIR NOVERRCHK 
    591575         DO jk = 2, jpkm1 
    592 !CDIR NOVERRCHK 
    593             DO jj = 2, jpjm1 
    594 !CDIR NOVERRCHK 
     576            DO jj = 2, jpjm1 
    595577               DO ji = fs_2, fs_jpim1   ! vector opt. 
    596578                  zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) ) 
     
    612594      !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt) 
    613595      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    614 !CDIR NOVERRCHK 
    615596      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points 
    616 !CDIR NOVERRCHK 
    617597         DO jj = 2, jpjm1 
    618 !CDIR NOVERRCHK 
    619598            DO ji = fs_2, fs_jpim1   ! vector opt. 
    620599               zsqen = SQRT( en(ji,jj,jk) ) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r4147 r4616  
    5454#  include "vectopt_loop_substitute.h90" 
    5555   !!---------------------------------------------------------------------- 
    56    !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
     56   !! NEMO/OPA 3.7 , NEMO Consortium (2014) 
    5757   !! $Id$ 
    5858   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    144144            DO jj= 1, jpj 
    145145               DO ji= 1, jpi 
    146                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj)   & 
     146                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj)                   & 
    147147                     &         * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    148148               END DO 
     
    150150         END DO 
    151151         ztpc= rau0 / ( rn_tfe * rn_me ) * ztpc 
     152         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    152153         IF(lwp) WRITE(numout,*)  
    153154         IF(lwp) WRITE(numout,*) '          N Total power consumption by av_tide    : ztpc = ', ztpc * 1.e-12 ,'TW' 
     
    228229      DO jk = 1, jpkm1              
    229230         zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz 
    230 !CDIR NOVERRCHK 
    231231         zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N 
    232232         zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2 
     
    292292            DO jj= 1, jpj 
    293293               DO ji= 1, jpi 
    294                   ztpc = ztpc + e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   & 
    295                      &                     * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     294                  ztpc = ztpc + e1e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) )   & 
     295                     &                       * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    296296               END DO 
    297297            END DO 
    298298         END DO 
     299         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    299300         ztpc= rau0 * ztpc / ( rn_me * rn_tfe_itf ) 
    300301         IF(lwp) WRITE(numout,*) '          N Total power consumption by zavt_itf: ztpc = ', ztpc * 1.e-12 ,'TW' 
     
    446447            DO jj = 1, jpj 
    447448               DO ji = 1, jpi 
    448                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     449                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    449450               END DO 
    450451            END DO 
    451452         END DO 
     453         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    452454         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    453455 
     
    492494            DO jj = 1, jpj 
    493495               DO ji = 1, jpi 
    494                   ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     496                  ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    495497               END DO 
    496498            END DO 
    497499         END DO 
     500         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    498501         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    499502         WRITE(numout,*) '          2 Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW' 
    500  
     503!!gm bug mpp  in these diagnostics 
    501504         DO jk = 1, jpk 
    502             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zav_tide(:,:,jk)    * tmask_i(:,:) )   & 
    503                &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) ) 
    504             ztpc = 1.E50 
     505            ze_z =                  SUM( e1e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) )   & 
     506               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * tmask  (:,:,jk) * tmask_i(:,:) ) ) 
     507            ztpc = 1.e50_wp 
    505508            DO jj = 1, jpj 
    506509               DO ji = 1, jpi 
    507                   IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc =Min( ztpc, zav_tide(ji,jj,jk) ) 
     510                  IF( zav_tide(ji,jj,jk) /= 0.e0 )   ztpc = MIN( ztpc, zav_tide(ji,jj,jk) ) 
    508511               END DO 
    509512            END DO 
     
    512515         END DO 
    513516 
    514          WRITE(numout,*) '          e_tide : ', SUM( e1t*e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW' 
     517         WRITE(numout,*) '          e_tide : ', SUM( e1e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW' 
    515518         WRITE(numout,*)  
    516519         WRITE(numout,*) '          Initial profile of tidal vertical mixing' 
     
    521524               END DO 
    522525            END DO 
    523             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   & 
    524                &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) ) 
     526            ze_z =                  SUM( e1e2t(:,:) * zkz(:,:)       * tmask_i(:,:) )   & 
     527               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) ) 
    525528            WRITE(numout,*) '                jk= ', jk,'   ', ze_z * 1.e4,' cm2/s' 
    526529         END DO 
    527530         DO jk = 1, jpk 
    528531            zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 
    529             ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   & 
    530                &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) ) 
     532            ze_z =                  SUM( e1e2t(:,:) * zkz(:,:)       * tmask_i(:,:) )   & 
     533               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) ) 
    531534            WRITE(numout,*)  
    532535            WRITE(numout,*) '          N2 min - jk= ', jk,'   ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4,   & 
    533536               &       'max= ', MAXVAL(zkz)*1.e4, ' cm2/s' 
    534537         END DO 
     538!!gm  end bug mpp 
    535539         ! 
    536540      ENDIF 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/module_example

    r4147 r4616  
    1919   USE module_name1   ! brief description of the used module 
    2020   USE module_name2   ! .... 
     21   ! 
     22   USE in_out_manager ! I/O manager 
     23   USE prtctl         ! Print control 
     24   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     25   USE lib_mpp        ! MPP library 
     26   USE wrk_nemo       ! Memory Allocation 
     27   USE timing         ! Timing 
    2128 
    2229   IMPLICIT NONE 
     
    8794      !!---------------------------------------------------------------------- 
    8895      USE toto_module      ! description of the module 
    89       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    90       USE wrk_nemo, ONLY:   zztab => wrk_2d_5                     ! 2D workspace 
    91       USE wrk_nemo, ONLY:   zwx => wrk_3d_12 , zwy => wrk_3d_13   ! 3D workspace 
    92       !! 
     96      ! 
    9397      INTEGER , INTENT(in   )                     ::   kt      ! short description  
    9498      INTEGER , INTENT(inout)                     ::   pvar1   !   -         - 
    9599      REAL(wp), INTENT(  out)                     ::   pvar2   !   -         - 
    96100      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   pvar2   !   -         - 
    97       !! 
     101      ! 
    98102      INTEGER  ::   ji, jj, jk       ! dummy loop arguments  (DOCTOR : start with j, but not jp) 
    99103      INTEGER  ::   itoto, itata     ! temporary integers    (DOCTOR : start with i 
    100104      REAL(wp) ::   zmlmin, zbbrau   ! temporary scalars     (DOCTOR : start with z) 
    101105      REAL(wp) ::   zfact1, zfact2   ! do not use continuation lines in declaration 
     106      REAL(wp), POINTER, DIMENSION(:,:,:  ) ::  zwrku, zwrkv     ! 2D workspace as pointers 
     107      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zavm, zavt       ! 3D workspace as pointers 
    102108      !!-------------------------------------------------------------------- 
    103109 
    104       IF( wrk_in_use(3, 12,13) .OR. wrk_in_use(2, 5 ) THEN 
    105          CALL ctl_stop('exa_mpl: requested workspace arrays unavailable')   ;   RETURN 
    106       ENDIF 
     110      IF( nn_timing == 1 )   CALL timing_start('exa_mpl') 
     111 
     112      CALL wrk_alloc( jpi, jpj, jpk, zavm , zavt  )         ! assign workspace pointers to already allocated arrays 
     113      CALL wrk_alloc( jpi, jpj     , zwrku, zwrkv ) 
    107114 
    108115      IF( kt == nit000  )   CALL exa_mpl_init    ! Initialization (first time-step only) 
     
    137144      CALL mpplnk2( avmu, 'U', 1. )              ! Lateral boundary conditions (unchanged sign) 
    138145      ! 
    139       IF( wrk_not_released(3, 12,13) .OR. wrk_not_released(2, 5 ) THEN 
    140          CALL ctl_stop('exa_mpl: failed to release workspace arrays')   ;   RETURN 
    141       ENDIF 
     146      CALL wrk_dealloc( jpi, jpj, jpk,       zfu_t , zfv_t , zfu_f , zfv_f, zfu_uw, zfv_vw, zfu, zfv, zfw ) 
     147      CALL wrk_dealloc( jpi, jpj, jpk, jpts, zlu_uu, zlv_vv, zlu_uv, zlv_vu                               ) 
     148      ! 
     149      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_ubs') 
    142150      ! 
    143151   END SUBROUTINE exa_mpl 
     
    157165      !!---------------------------------------------------------------------- 
    158166      INTEGER ::   ji, jj, jk, jit   ! dummy loop indices 
    159       INTEGER  ::   ios              ! Local integer output status for namelist read 
    160       !! 
     167      INTEGER ::   ios               ! Local integer output status for namelist read 
     168      ! 
    161169      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex      
    162170      !!---------------------------------------------------------------------- 
    163171      ! 
    164       REWIND( numnam_ref )              ! Namelist namexa in reference namelist : Example 
     172      REWIND( numnam_ref )             ! Namelist namexa in reference namelist : Example 
    165173      READ  ( numnam_ref, namexa, IOSTAT = ios, ERR = 901) 
    166174901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in reference namelist', lwp ) 
    167  
    168       REWIND( numnam_cfg )              ! Namelist namexa in configuration namelist : Example 
     175      ! 
     176      REWIND( numnam_cfg )             ! Namelist namexa in configuration namelist : Example 
    169177      READ  ( numnam_cfg, namexa, IOSTAT = ios, ERR = 902 ) 
    170178902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namexa in configuration namelist', lwp ) 
    171    ! Output namelist for control 
    172       WRITE ( numond, namexa ) 
     179      ! 
     180      WRITE ( numond, namexa )         ! Output namelist for control 
     181 
    173182      ! 
    174183      IF(lwp) THEN                              ! Control print 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r4205 r4616  
    9494#endif 
    9595 
    96 #if defined key_vectopt_loop 
    97    LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag 
    98 #else 
    99    LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag 
    100 #endif 
    101  
    10296   !!---------------------------------------------------------------------- 
    10397   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
  • branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/step.F90

    r4596 r4616  
    212212      IF( ln_crs     )   CALL crs_fld( kstp )         ! ocean model: online field coarsening & output 
    213213 
    214  
    215214#if defined key_top 
    216215      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
Note: See TracChangeset for help on using the changeset viewer.