Ignore:
Timestamp:
2017-03-03T12:46:59+01:00 (4 years ago)
Author:
mocavero
Message:

Reverting trunk to remove OpenMP

Location:
trunk/NEMOGCM/NEMO/OPA_SRC/DOM
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90

    r7698 r7753  
    150150      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept_3d, pdepw_3d   ! depth = SUM( e3 )     [m] 
    151151      ! 
    152       INTEGER  ::   jk, jj, ji           ! dummy loop indices 
     152      INTEGER  ::   jk           ! dummy loop indices 
    153153      !!----------------------------------------------------------------------       
    154154      ! 
    155 !$OMP PARALLEL 
    156 !$OMP DO schedule(static) private(jj,ji) 
    157       DO jj = 1, jpj 
    158          DO ji = 1, jpi 
    159             pdepw_3d(ji,jj,1) = 0.0_wp 
    160             pdept_3d(ji,jj,1) = 0.5_wp * pe3w_3d(ji,jj,1) 
    161          END DO 
     155      pdepw_3d(:,:,1) = 0.0_wp 
     156      pdept_3d(:,:,1) = 0.5_wp * pe3w_3d(:,:,1) 
     157      DO jk = 2, jpk 
     158         pdepw_3d(:,:,jk) = pdepw_3d(:,:,jk-1) + pe3t_3d(:,:,jk-1)  
     159         pdept_3d(:,:,jk) = pdept_3d(:,:,jk-1) + pe3w_3d(:,:,jk  )  
    162160      END DO 
    163       DO jk = 2, jpk 
    164 !$OMP DO schedule(static) private(jj,ji) 
    165          DO jj = 1, jpj 
    166             DO ji = 1, jpi 
    167                pdepw_3d(ji,jj,jk) = pdepw_3d(ji,jj,jk-1) + pe3t_3d(ji,jj,jk-1)  
    168                pdept_3d(ji,jj,jk) = pdept_3d(ji,jj,jk-1) + pe3w_3d(ji,jj,jk  )  
    169             END DO 
    170          END DO 
    171       END DO 
    172 !$OMP END PARALLEL 
    173161      ! 
    174162   END SUBROUTINE e3_to_depth_3d 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r7698 r7753  
    133133      CALL dom_msk( ik_top, ik_bot )   ! Masks 
    134134      ! 
    135 !$OMP PARALLEL 
    136 !$OMP DO schedule(static) private(jj,ji,ik) 
    137135      DO jj = 1, jpj                   ! depth of the iceshelves 
    138136         DO ji = 1, jpi 
     
    142140      END DO 
    143141      ! 
    144 !$OMP END DO NOWAIT 
    145 !$OMP DO schedule(static) private(jj,ji) 
    146       DO jj = 1, jpj 
    147          DO ji = 1, jpi 
    148             ht_0(ji,jj) = 0._wp  ! Reference ocean thickness 
    149             hu_0(ji,jj) = 0._wp 
    150             hv_0(ji,jj) = 0._wp 
    151          END DO 
     142      ht_0(:,:) = 0._wp  ! Reference ocean thickness 
     143      hu_0(:,:) = 0._wp 
     144      hv_0(:,:) = 0._wp 
     145      DO jk = 1, jpk 
     146         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
     147         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 
     148         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 
    152149      END DO 
    153       DO jk = 1, jpk 
    154 !$OMP DO schedule(static) private(jj,ji,ik) 
    155          DO jj = 1, jpj 
    156             DO ji = 1, jpi 
    157                ht_0(ji,jj) = ht_0(ji,jj) + e3t_0(ji,jj,jk) * tmask(ji,jj,jk) 
    158                hu_0(ji,jj) = hu_0(ji,jj) + e3u_0(ji,jj,jk) * umask(ji,jj,jk) 
    159                hv_0(ji,jj) = hv_0(ji,jj) + e3v_0(ji,jj,jk) * vmask(ji,jj,jk) 
    160             END DO 
    161          END DO 
    162       END DO 
    163 !$OMP END PARALLEL 
    164150      ! 
    165151      !           !==  time varying part of coordinate system  ==! 
     
    180166             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          ! 
    181167         ! 
    182 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    183          DO jj =1, jpj 
    184             DO ji=1, jpi 
    185                z1_hu_0(ji,jj) = ssumask(ji,jj) / ( hu_0(ji,jj) + 1._wp - ssumask(ji,jj) )     ! _i mask due to ISF 
    186                z1_hv_0(ji,jj) = ssvmask(ji,jj) / ( hv_0(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    187             END DO 
    188          END DO 
     168         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF 
     169         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 
    189170         ! 
    190171         !        before       !          now          !       after         ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r7698 r7753  
    4040   !!---------------------------------------------------------------------- 
    4141   !! NEMO/OPA 3.7 , NEMO Consortium (2016) 
    42    !! $Id$ 
     42   !! $Id$  
    4343   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4444   !!---------------------------------------------------------------------- 
     
    117117      IF( iff == 0 ) THEN                 ! Coriolis parameter has not been defined  
    118118         IF(lwp) WRITE(numout,*) '          Coriolis parameter calculated on the sphere from gphif & gphit' 
    119 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    120          DO jj = 1, jpj 
    121             DO ji = 1, jpi 
    122                ff_f(ji,jj) = 2. * omega * SIN( rad * gphif(ji,jj) )     ! compute it on the sphere at f-point 
    123                ff_t(ji,jj) = 2. * omega * SIN( rad * gphit(ji,jj) )     !    -        -       -    at t-point 
    124             END DO 
    125          END DO 
     119         ff_f(:,:) = 2. * omega * SIN( rad * gphif(:,:) )     ! compute it on the sphere at f-point 
     120         ff_t(:,:) = 2. * omega * SIN( rad * gphit(:,:) )     !    -        -       -    at t-point 
    126121      ELSE 
    127122         IF( ln_read_cfg ) THEN 
     
    135130      !                             !==  associated horizontal metrics  ==! 
    136131      ! 
    137 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    138       DO jj = 1, jpj 
    139          DO ji = 1, jpi 
    140             r1_e1t(ji,jj) = 1._wp / e1t(ji,jj)   ;   r1_e2t (ji,jj) = 1._wp / e2t(ji,jj) 
    141             r1_e1u(ji,jj) = 1._wp / e1u(ji,jj)   ;   r1_e2u (ji,jj) = 1._wp / e2u(ji,jj) 
    142             r1_e1v(ji,jj) = 1._wp / e1v(ji,jj)   ;   r1_e2v (ji,jj) = 1._wp / e2v(ji,jj) 
    143             r1_e1f(ji,jj) = 1._wp / e1f(ji,jj)   ;   r1_e2f (ji,jj) = 1._wp / e2f(ji,jj) 
    144             ! 
    145             e1e2t (ji,jj) = e1t(ji,jj) * e2t(ji,jj)   ;   r1_e1e2t(ji,jj) = 1._wp / e1e2t(ji,jj) 
    146             e1e2f (ji,jj) = e1f(ji,jj) * e2f(ji,jj)   ;   r1_e1e2f(ji,jj) = 1._wp / e1e2f(ji,jj) 
    147          END DO 
    148       END DO 
     132      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
     133      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:) 
     134      r1_e1v(:,:) = 1._wp / e1v(:,:)   ;   r1_e2v (:,:) = 1._wp / e2v(:,:) 
     135      r1_e1f(:,:) = 1._wp / e1f(:,:)   ;   r1_e2f (:,:) = 1._wp / e2f(:,:) 
     136      ! 
     137      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
     138      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 
    149139      IF( ie1e2u_v == 0 ) THEN               ! u- & v-surfaces have not been defined 
    150140         IF(lwp) WRITE(numout,*) '          u- & v-surfaces calculated as e1 e2 product' 
    151 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    152          DO jj = 1, jpj 
    153             DO ji = 1, jpi 
    154                e1e2u (ji,jj) = e1u(ji,jj) * e2u(ji,jj)         ! compute them 
    155                e1e2v (ji,jj) = e1v(ji,jj) * e2v(ji,jj)  
    156             END DO 
    157          END DO 
     141         e1e2u (:,:) = e1u(:,:) * e2u(:,:)         ! compute them 
     142         e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
    158143      ELSE 
    159144         IF(lwp) WRITE(numout,*) '          u- & v-surfaces have been read in "mesh_mask" file:' 
    160145         IF(lwp) WRITE(numout,*) '                     grid size reduction in strait(s) is used' 
    161146      ENDIF 
    162 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    163       DO jj = 1, jpj 
    164          DO ji = 1, jpi 
    165             r1_e1e2u(ji,jj) = 1._wp / e1e2u(ji,jj)     ! compute their invert in any cases 
    166             r1_e1e2v(ji,jj) = 1._wp / e1e2v(ji,jj) 
    167             !    
    168             e2_e1u(ji,jj) = e2u(ji,jj) / e1u(ji,jj) 
    169             e1_e2v(ji,jj) = e1v(ji,jj) / e2v(ji,jj) 
    170          END DO 
    171       END DO 
     147      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in any cases 
     148      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 
     149      !    
     150      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
     151      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    172152      ! 
    173153      ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r7698 r7753  
    4747   !!---------------------------------------------------------------------- 
    4848   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    49    !! $Id$ 
     49   !! $Id$  
    5050   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5151   !!---------------------------------------------------------------------- 
     
    137137      ! ---------------------------- 
    138138      ! 
    139 !$OMP PARALLEL 
    140 !$OMP DO schedule(static) private(jk, jj, ji) 
    141       DO jk = 1, jpk 
    142          DO jj = 1, jpj 
    143             DO ji = 1, jpi 
    144                tmask(ji,jj,jk) = 0._wp 
    145             END DO 
    146          END DO 
    147       END DO 
    148 !$OMP DO schedule(static) private(jj, ji, iktop, ikbot) 
     139      tmask(:,:,:) = 0._wp 
    149140      DO jj = 1, jpj 
    150141         DO ji = 1, jpi 
     
    156147         END DO   
    157148      END DO   
    158 !$OMP END PARALLEL 
    159149!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 
    160150!!gm I don't understand why...   
     
    171161      ! ------------------------ 
    172162      IF ( ln_bdy .AND. ln_mask_file ) THEN 
    173 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    174163         DO jk = 1, jpkm1 
    175164            DO jj = 1, jpj 
     
    184173      ! ---------------------------------------- 
    185174      ! NB: at this point, fmask is designed for free slip lateral boundary condition 
    186 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    187175      DO jk = 1, jpk 
    188176         DO jj = 1, jpjm1 
     
    204192      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 
    205193      !----------------------------------------- 
    206 !$OMP PARALLEL 
    207 !$OMP DO schedule(static) private(jj, ji) 
    208       DO jj = 1, jpj 
    209          DO ji = 1, jpi 
    210             wmask (ji,jj,1) = tmask(ji,jj,1)     ! surface 
    211             wumask(ji,jj,1) = umask(ji,jj,1) 
    212             wvmask(ji,jj,1) = vmask(ji,jj,1) 
    213          END DO 
     194      wmask (:,:,1) = tmask(:,:,1)     ! surface 
     195      wumask(:,:,1) = umask(:,:,1) 
     196      wvmask(:,:,1) = vmask(:,:,1) 
     197      DO jk = 2, jpk                   ! interior values 
     198         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
     199         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
     200         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
    214201      END DO 
    215 !$OMP DO schedule(static) private(jk,jj,ji) 
    216       DO jk = 2, jpk                   ! interior values 
    217          DO jj = 1, jpj 
    218             DO ji = 1, jpi 
    219                wmask (ji,jj,jk) = tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
    220                wumask(ji,jj,jk) = umask(ji,jj,jk) * umask(ji,jj,jk-1)    
    221                wvmask(ji,jj,jk) = vmask(ji,jj,jk) * vmask(ji,jj,jk-1) 
    222             END DO 
    223          END DO 
    224       END DO 
    225 !$OMP END PARALLEL 
    226202 
    227203 
     
    240216      ! 
    241217      !                          ! halo mask : 0 on the halo and 1 elsewhere 
    242 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    243       DO jj = 1, jpj 
    244          DO ji = 1, jpi 
    245             tmask_h(ji,jj) = 1._wp                   
    246          END DO 
    247       END DO 
     218      tmask_h(:,:) = 1._wp                   
    248219      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
    249220      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
     
    270241      ! 
    271242      !                          ! interior mask : 2D ocean mask x halo mask  
    272 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    273       DO jj = 1, jpj 
    274          DO ji = 1, jpi 
    275             tmask_i(ji,jj) = ssmask(ji,jj) * tmask_h(ji,jj) 
    276          END DO 
    277       END DO 
     243      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
    278244 
    279245 
     
    284250         CALL wrk_alloc( jpi,jpj,   zwf ) 
    285251         ! 
    286 !$OMP PARALLEL 
    287252         DO jk = 1, jpk 
    288 !$OMP DO schedule(static) private(jj, ji) 
    289             DO jj = 1, jpj 
    290                DO ji = 1, jpi 
    291                   zwf(ji,jj) = fmask(ji,jj,jk)          
    292                END DO 
    293             END DO 
    294 !$OMP DO schedule(static) private(jj, ji) 
     253            zwf(:,:) = fmask(:,:,jk)          
    295254            DO jj = 2, jpjm1 
    296255               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    301260               END DO 
    302261            END DO 
    303 !$OMP DO schedule(static) private(jj) 
    304262            DO jj = 2, jpjm1 
    305263               IF( fmask(1,jj,jk) == 0._wp ) THEN 
     
    310268               ENDIF 
    311269            END DO          
    312 !$OMP DO schedule(static) private(ji) 
    313270            DO ji = 2, jpim1 
    314271               IF( fmask(ji,1,jk) == 0._wp ) THEN 
     
    320277            END DO 
    321278         END DO 
    322 !$OMP END PARALLEL 
    323279         ! 
    324280         CALL wrk_dealloc( jpi,jpj,   zwf ) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r7698 r7753  
    135135      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
    136136      CALL dom_vvl_rst( nit000, 'READ' ) 
    137 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    138       DO jj = 1, jpj 
    139          DO ji = 1, jpi 
    140             e3t_a(ji,jj,jpk) = e3t_0(ji,jj,jpk)  ! last level always inside the sea floor set one for all 
    141          END DO 
    142       END DO 
     137      e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
    143138      ! 
    144139      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
     
    158153      ! 
    159154      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep) 
    160 !$OMP PARALLEL 
    161 !$OMP DO schedule(static) private(jj,ji) 
    162       DO jj = 1, jpj 
    163          DO ji = 1, jpi 
    164             gdept_n(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1)       ! reference to the ocean surface (used for MLD and light penetration) 
    165             gdepw_n(ji,jj,1) = 0.0_wp 
    166             gde3w_n(ji,jj,1) = gdept_n(ji,jj,1) - sshn(ji,jj)  ! reference to a common level z=0 for hpg 
    167             gdept_b(ji,jj,1) = 0.5_wp * e3w_b(ji,jj,1) 
    168             gdepw_b(ji,jj,1) = 0.0_wp 
    169          END DO 
    170       END DO 
     155      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration) 
     156      gdepw_n(:,:,1) = 0.0_wp 
     157      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg 
     158      gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1) 
     159      gdepw_b(:,:,1) = 0.0_wp 
    171160      DO jk = 2, jpk                               ! vertical sum 
    172 !$OMP DO schedule(static) private(jj,ji,zcoef) 
    173161         DO jj = 1,jpj 
    174162            DO ji = 1,jpi 
     
    190178      ! 
    191179      !                    !==  thickness of the water column  !!   (ocean portion only) 
    192 !$OMP DO schedule(static) private(jj,ji) 
    193       DO jj = 1, jpj 
    194          DO ji = 1, jpi 
    195             ht_n(ji,jj) = e3t_n(ji,jj,1) * tmask(ji,jj,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
    196             hu_b(ji,jj) = e3u_b(ji,jj,1) * umask(ji,jj,1) 
    197             hu_n(ji,jj) = e3u_n(ji,jj,1) * umask(ji,jj,1) 
    198             hv_b(ji,jj) = e3v_b(ji,jj,1) * vmask(ji,jj,1) 
    199             hv_n(ji,jj) = e3v_n(ji,jj,1) * vmask(ji,jj,1) 
    200          END DO 
     180      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
     181      hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 
     182      hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1) 
     183      hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 
     184      hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 
     185      DO jk = 2, jpkm1 
     186         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
     187         hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
     188         hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 
     189         hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
     190         hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 
    201191      END DO 
    202       DO jk = 2, jpkm1 
    203 !$OMP DO schedule(static) private(jj,ji) 
    204          DO jj = 1, jpj 
    205             DO ji = 1, jpi 
    206                ht_n(ji,jj) = ht_n(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    207                hu_b(ji,jj) = hu_b(ji,jj) + e3u_b(ji,jj,jk) * umask(ji,jj,jk) 
    208                hu_n(ji,jj) = hu_n(ji,jj) + e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
    209                hv_b(ji,jj) = hv_b(ji,jj) + e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 
    210                hv_n(ji,jj) = hv_n(ji,jj) + e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
    211             END DO 
    212          END DO 
    213       END DO 
    214192      ! 
    215193      !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
    216 !$OMP DO schedule(static) private(jj,ji) 
    217       DO jj = 1, jpj 
    218          DO ji = 1, jpi 
    219             r1_hu_b(ji,jj) = ssumask(ji,jj) / ( hu_b(ji,jj) + 1._wp - ssumask(ji,jj) )    ! _i mask due to ISF 
    220             r1_hu_n(ji,jj) = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    221             r1_hv_b(ji,jj) = ssvmask(ji,jj) / ( hv_b(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    222             r1_hv_n(ji,jj) = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    223          END DO 
    224       END DO 
    225 !$OMP END PARALLEL 
     194      r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
     195      r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) 
     196      r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
     197      r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) 
     198 
    226199      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies) 
    227200      IF( ln_vvl_ztilde ) THEN 
     
    229202         !                                   ! Values in days provided via the namelist 
    230203         !                                   ! use rsmall to avoid possible division by zero errors with faulty settings 
    231 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    232          DO jj = 1, jpj 
    233             DO ji = 1, jpi 
    234                frq_rst_e3t(ji,jj) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp ) 
    235                frq_rst_hdv(ji,jj) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 
    236             END DO 
    237          END DO 
     204         frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp ) 
     205         frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 
    238206         ! 
    239207         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile 
    240 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    241             DO jj = 1, jpj 
    242                DO ji = 1, jpi 
    243                   frq_rst_e3t(ji,jj) = 0._wp               !Ignore namelist settings 
    244                   frq_rst_hdv(ji,jj) = 1._wp / rdt 
    245                END DO 
    246             END DO 
     208            frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings 
     209            frq_rst_hdv(:,:) = 1._wp / rdt 
    247210         ENDIF 
    248211         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator 
    249 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    250212            DO jj = 1, jpj 
    251213               DO ji = 1, jpi 
     
    343305      !                                                ! --------------------------------------------- ! 
    344306      ! 
    345 !$OMP PARALLEL 
    346 !$OMP DO schedule(static) private(jj,ji) 
    347       DO jj = 1, jpj 
    348          DO ji = 1, jpi 
    349             z_scale(ji,jj) = ( ssha(ji,jj) - sshb(ji,jj) ) * ssmask(ji,jj) / ( ht_0(ji,jj) + sshn(ji,jj) + 1. - ssmask(ji,jj) ) 
    350          END DO 
     307      z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
     308      DO jk = 1, jpkm1 
     309         ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0) 
     310         e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
    351311      END DO 
    352 !$OMP DO schedule(static) private(jk,jj,ji) 
    353       DO jk = 1, jpkm1 
    354          DO jj = 1, jpj 
    355             DO ji = 1, jpi 
    356                ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0) 
    357                e3t_a(ji,jj,jk) = e3t_b(ji,jj,jk) + e3t_n(ji,jj,jk) * z_scale(ji,jj) * tmask(ji,jj,jk) 
    358             END DO 
    359          END DO 
    360       END DO 
    361 !$OMP END PARALLEL 
    362312      ! 
    363313      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
     
    368318         ! 1 - barotropic divergence 
    369319         ! ------------------------- 
    370 !$OMP PARALLEL 
    371 !$OMP DO schedule(static) private(jj,ji) 
    372          DO jj = 1, jpj 
    373             DO ji = 1, jpi 
    374                zhdiv(ji,jj) = 0._wp 
    375                zht(ji,jj)   = 0._wp 
    376             END DO 
    377          END DO 
     320         zhdiv(:,:) = 0._wp 
     321         zht(:,:)   = 0._wp 
    378322         DO jk = 1, jpkm1 
    379 !$OMP DO schedule(static) private(jj,ji) 
    380             DO jj = 1, jpj 
    381                DO ji = 1, jpi 
    382                   zhdiv(ji,jj) = zhdiv(ji,jj) + e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) 
    383                   zht  (ji,jj) = zht  (ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    384                END DO 
    385             END DO 
    386          END DO 
    387 !$OMP DO schedule(static) private(jj,ji) 
    388          DO jj = 1, jpj 
    389             DO ji = 1, jpi 
    390                zhdiv(ji,jj) = zhdiv(ji,jj) / ( zht(ji,jj) + 1. - tmask_i(ji,jj) ) 
    391             END DO 
    392          END DO 
    393 !$OMP END PARALLEL 
     323            zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
     324            zht  (:,:) = zht  (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
     325         END DO 
     326         zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) 
    394327 
    395328         ! 2 - Low frequency baroclinic horizontal divergence  (z-tilde case only) 
     
    397330         IF( ln_vvl_ztilde ) THEN 
    398331            IF( kt > nit000 ) THEN 
    399 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    400332               DO jk = 1, jpkm1 
    401                   DO jj = 1, jpj 
    402                      DO ji = 1, jpi 
    403                         hdiv_lf(ji,jj,jk) = hdiv_lf(ji,jj,jk) - rdt * frq_rst_hdv(ji,jj)   & 
    404                            &          * ( hdiv_lf(ji,jj,jk) - e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) ) 
    405                      END DO 
    406                   END DO 
     333                  hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   & 
     334                     &          * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 
    407335               END DO 
    408336            ENDIF 
     
    411339         ! II - after z_tilde increments of vertical scale factors 
    412340         ! ======================================================= 
    413 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    414          DO jk = 1, jpk 
    415             DO jj = 1, jpj 
    416                DO ji = 1, jpi 
    417                   tilde_e3t_a(ji,jj,jk) = 0._wp  ! tilde_e3t_a used to store tendency terms 
    418                END DO 
    419             END DO 
    420          END DO 
     341         tilde_e3t_a(:,:,:) = 0._wp  ! tilde_e3t_a used to store tendency terms 
    421342 
    422343         ! 1 - High frequency divergence term 
    423344         ! ---------------------------------- 
    424345         IF( ln_vvl_ztilde ) THEN     ! z_tilde case 
    425 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    426346            DO jk = 1, jpkm1 
    427                DO jj = 1, jpj 
    428                   DO ji = 1, jpi 
    429                      tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - ( e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) - hdiv_lf(ji,jj,jk) ) 
    430                   END DO 
    431                END DO 
     347               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 
    432348            END DO 
    433349         ELSE                         ! layer case 
    434 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    435350            DO jk = 1, jpkm1 
    436                DO jj = 1, jpj 
    437                   DO ji = 1, jpi 
    438                      tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) -   e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) * tmask(ji,jj,jk) 
    439                   END DO 
    440                END DO 
     351               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 
    441352            END DO 
    442353         ENDIF 
     
    445356         ! ------------------ 
    446357         IF( ln_vvl_ztilde ) THEN 
    447 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    448358            DO jk = 1, jpk 
    449                DO jj = 1, jpj 
    450                   DO ji = 1, jpi 
    451                      tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - frq_rst_e3t(ji,jj) * tilde_e3t_b(ji,jj,jk) 
    452                   END DO 
    453                END DO 
     359               tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 
    454360            END DO 
    455361         ENDIF 
     
    457363         ! 3 - Thickness diffusion term 
    458364         ! ---------------------------- 
    459 !$OMP PARALLEL 
    460 !$OMP DO schedule(static) private(jj,ji) 
    461          DO jj = 1, jpj 
    462             DO ji = 1, jpi 
    463                zwu(ji,jj) = 0._wp 
    464                zwv(ji,jj) = 0._wp 
    465             END DO 
    466          END DO 
     365         zwu(:,:) = 0._wp 
     366         zwv(:,:) = 0._wp 
    467367         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes 
    468 !$OMP DO schedule(static) private(jj,ji) 
    469368            DO jj = 1, jpjm1 
    470369               DO ji = 1, fs_jpim1   ! vector opt. 
     
    478377            END DO 
    479378         END DO 
    480 !$OMP DO schedule(static) private(jj,ji) 
    481379         DO jj = 1, jpj          ! b - correction for last oceanic u-v points 
    482380            DO ji = 1, jpi 
     
    485383            END DO 
    486384         END DO 
    487 !$OMP DO schedule(static) private(jk,jj,ji) 
    488385         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes 
    489386            DO jj = 2, jpjm1 
     
    495392            END DO 
    496393         END DO 
    497 !$OMP END PARALLEL 
    498394         !                       ! d - thickness diffusion transport: boundary conditions 
    499395         !                             (stored for tracer advction and continuity equation) 
     
    511407         ENDIF 
    512408         CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    513 !$OMP PARALLEL  
    514 !$OMP DO schedule(static) private(jk,jj,ji) 
    515          DO jk = 1, jpk 
    516             DO jj = 1, jpj 
    517                DO ji = 1, jpi 
    518                   tilde_e3t_a(ji,jj,jk) = tilde_e3t_b(ji,jj,jk) + z2dt * tmask(ji,jj,jk) * tilde_e3t_a(ji,jj,jk) 
    519                END DO 
    520             END DO 
    521          END DO 
     409         tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
    522410 
    523411         ! Maximum deformation control 
    524412         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    525 !$OMP DO schedule(static) private(jj,ji) 
    526          DO jj = 1, jpj 
    527             DO ji = 1, jpi 
    528                ze3t(ji,jj,jpk) = 0._wp 
    529             END DO 
    530          END DO 
    531 !$OMP DO schedule(static) private(jk,jj,ji) 
     413         ze3t(:,:,jpk) = 0._wp 
    532414         DO jk = 1, jpkm1 
    533             DO jj = 1, jpj 
    534                DO ji = 1, jpi 
    535                   ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    536                END DO 
    537             END DO 
    538          END DO 
    539 !$OMP END PARALLEL 
     415            ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
     416         END DO 
    540417         z_tmax = MAXVAL( ze3t(:,:,:) ) 
    541418         IF( lk_mpp )   CALL mpp_max( z_tmax )                 ! max over the global domain 
     
    565442         ! - ML - end test 
    566443         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
    567 !$OMP PARALLEL 
    568 !$OMP DO schedule(static) private(jk,jj,ji) 
    569          DO jk = 1, jpk 
    570             DO jj = 1, jpj 
    571                DO ji = 1, jpi 
    572                   tilde_e3t_a(ji,jj,jk) = MIN( tilde_e3t_a(ji,jj,jk),   rn_zdef_max * e3t_0(ji,jj,jk) ) 
    573                   tilde_e3t_a(ji,jj,jk) = MAX( tilde_e3t_a(ji,jj,jk), - rn_zdef_max * e3t_0(ji,jj,jk) ) 
    574                END DO 
    575             END DO 
    576          END DO 
     444         tilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:),   rn_zdef_max * e3t_0(:,:,:) ) 
     445         tilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) ) 
    577446 
    578447         ! 
    579448         ! "tilda" change in the after scale factor 
    580449         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    581 !$OMP DO schedule(static) private(jk,jj,ji) 
    582450         DO jk = 1, jpkm1 
    583             DO jj = 1, jpj 
    584                DO ji = 1, jpi 
    585                   dtilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - tilde_e3t_b(ji,jj,jk) 
    586                END DO 
    587             END DO 
     451            dtilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk) 
    588452         END DO 
    589453         ! III - Barotropic repartition of the sea surface height over the baroclinic profile 
     
    593457         !        i.e. locally and not spread over the water column. 
    594458         !        (keep in mind that the idea is to reduce Eulerian velocity as much as possible) 
    595 !$OMP DO schedule(static) private(jj,ji) 
    596          DO jj = 1, jpj 
    597             DO ji = 1, jpi 
    598                zht(ji,jj) = 0. 
    599             END DO 
    600          END DO 
     459         zht(:,:) = 0. 
    601460         DO jk = 1, jpkm1 
    602 !$OMP DO schedule(static) private(jj,ji) 
    603             DO jj = 1, jpj 
    604                DO ji = 1, jpi 
    605                   zht(ji,jj)  = zht(ji,jj) + tilde_e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    606                END DO 
    607             END DO 
    608          END DO 
    609 !$OMP DO schedule(static) private(jj,ji) 
    610          DO jj = 1, jpj 
    611             DO ji = 1, jpi 
    612                z_scale(ji,jj) =  - zht(ji,jj) / ( ht_0(ji,jj) + sshn(ji,jj) + 1. - ssmask(ji,jj) ) 
    613             END DO 
    614          END DO 
    615 !$OMP DO schedule(static) private(jk,jj,ji) 
     461            zht(:,:)  = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
     462         END DO 
     463         z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
    616464         DO jk = 1, jpkm1 
    617             DO jj = 1, jpj 
    618                DO ji = 1, jpi 
    619                   dtilde_e3t_a(ji,jj,jk) = dtilde_e3t_a(ji,jj,jk) + e3t_n(ji,jj,jk) * z_scale(ji,jj) * tmask(ji,jj,jk) 
    620                END DO 
    621             END DO 
    622          END DO 
    623 !$OMP END PARALLEL 
     465            dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
     466         END DO 
     467 
    624468      ENDIF 
    625469 
    626470      IF( ln_vvl_ztilde .OR. ln_vvl_layer )  THEN   ! z_tilde or layer coordinate ! 
    627471      !                                           ! ---baroclinic part--------- ! 
    628 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    629472         DO jk = 1, jpkm1 
    630             DO jj = 1, jpj 
    631                DO ji = 1, jpi 
    632                   e3t_a(ji,jj,jk) = e3t_a(ji,jj,jk) + dtilde_e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    633                END DO 
    634             END DO 
     473            e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
    635474         END DO 
    636475      ENDIF 
     
    645484         END IF 
    646485         ! 
    647 !$OMP PARALLEL 
    648 !$OMP DO schedule(static) private(jj,ji) 
    649          DO jj = 1, jpj 
    650             DO ji = 1, jpi 
    651                zht(ji,jj) = 0.0_wp 
    652             END DO 
    653          END DO 
     486         zht(:,:) = 0.0_wp 
    654487         DO jk = 1, jpkm1 
    655 !$OMP DO schedule(static) private(jj,ji) 
    656             DO jj = 1, jpj 
    657                DO ji = 1, jpi 
    658                   zht(ji,jj) = zht(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    659                END DO 
    660             END DO 
    661          END DO 
    662 !$OMP END PARALLEL 
     488            zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
     489         END DO 
    663490         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 
    664491         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
    665492         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 
    666493         ! 
    667 !$OMP PARALLEL 
    668 !$OMP DO schedule(static) private(jj,ji) 
    669          DO jj = 1, jpj 
    670             DO ji = 1, jpi 
    671                zht(ji,jj) = 0.0_wp 
    672             END DO 
    673          END DO 
     494         zht(:,:) = 0.0_wp 
    674495         DO jk = 1, jpkm1 
    675 !$OMP DO schedule(static) private(jj,ji) 
    676             DO jj = 1, jpj 
    677                DO ji = 1, jpi 
    678                   zht(ji,jj) = zht(ji,jj) + e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    679                END DO 
    680             END DO 
    681          END DO 
    682 !$OMP END PARALLEL 
     496            zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk) 
     497         END DO 
    683498         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 
    684499         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
    685500         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 
    686501         ! 
    687 !$OMP PARALLEL 
    688 !$OMP DO schedule(static) private(jj,ji) 
    689          DO jj = 1, jpj 
    690             DO ji = 1, jpi 
    691                zht(ji,jj) = 0.0_wp 
    692             END DO 
    693          END DO 
     502         zht(:,:) = 0.0_wp 
    694503         DO jk = 1, jpkm1 
    695 !$OMP DO schedule(static) private(jj,ji) 
    696             DO jj = 1, jpj 
    697                DO ji = 1, jpi 
    698                   zht(ji,jj) = zht(ji,jj) + e3t_b(ji,jj,jk) * tmask(ji,jj,jk) 
    699                END DO 
    700             END DO 
    701          END DO 
    702 !$OMP END PARALLEL 
     504            zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk) 
     505         END DO 
    703506         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 
    704507         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
     
    729532      ! *********************************** ! 
    730533 
    731 !$OMP PARALLEL 
    732 !$OMP DO schedule(static) private(jj,ji) 
    733       DO jj = 1, jpj 
    734          DO ji = 1, jpi 
    735             hu_a(ji,jj) = e3u_a(ji,jj,1) * umask(ji,jj,1) 
    736             hv_a(ji,jj) = e3v_a(ji,jj,1) * vmask(ji,jj,1) 
    737          END DO 
    738       END DO 
     534      hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1) 
     535      hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1) 
    739536      DO jk = 2, jpkm1 
    740 !$OMP DO schedule(static) private(jj,ji) 
    741          DO jj = 1, jpj 
    742             DO ji = 1, jpi 
    743                hu_a(ji,jj) = hu_a(ji,jj) + e3u_a(ji,jj,jk) * umask(ji,jj,jk) 
    744                hv_a(ji,jj) = hv_a(ji,jj) + e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 
    745             END DO 
    746          END DO 
     537         hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk) 
     538         hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk) 
    747539      END DO 
    748540      !                                        ! Inverse of the local depth 
    749541!!gm BUG ?  don't understand the use of umask_i here ..... 
    750 !$OMP DO schedule(static) private(jj,ji) 
    751       DO jj = 1, jpj 
    752          DO ji = 1, jpi 
    753             r1_hu_a(ji,jj) = ssumask(ji,jj) / ( hu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    754             r1_hv_a(ji,jj) = ssvmask(ji,jj) / ( hv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    755          END DO 
    756       END DO 
    757 !$OMP END PARALLEL 
     542      r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) ) 
     543      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    758544      ! 
    759545      CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv ) 
     
    810596      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    811597         IF( neuler == 0 .AND. kt == nit000 ) THEN 
    812 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    813             DO jk = 1, jpk 
    814                DO jj = 1, jpj 
    815                   DO ji = 1, jpi 
    816                      tilde_e3t_b(ji,jj,jk) = tilde_e3t_n(ji,jj,jk) 
    817                   END DO 
    818                END DO 
    819             END DO 
     598            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
    820599         ELSE 
    821 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    822             DO jk = 1, jpk 
    823                DO jj = 1, jpj 
    824                   DO ji = 1, jpi 
    825                      tilde_e3t_b(ji,jj,jk) = tilde_e3t_n(ji,jj,jk) &  
    826                      &         + atfp * ( tilde_e3t_b(ji,jj,jk) - 2.0_wp * tilde_e3t_n(ji,jj,jk) + tilde_e3t_a(ji,jj,jk) ) 
    827                   END DO 
    828                END DO 
    829             END DO 
     600            tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) &  
     601            &         + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 
    830602         ENDIF 
    831 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    832          DO jk = 1, jpk 
    833             DO jj = 1, jpj 
    834                DO ji = 1, jpi 
    835                   tilde_e3t_n(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) 
    836                END DO 
    837             END DO 
    838          END DO 
    839       ENDIF 
    840 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    841       DO jk = 1, jpk 
    842          DO jj = 1, jpj 
    843             DO ji = 1, jpi 
    844                gdept_b(ji,jj,jk) = gdept_n(ji,jj,jk) 
    845                gdepw_b(ji,jj,jk) = gdepw_n(ji,jj,jk) 
    846          
    847                e3t_n(ji,jj,jk) = e3t_a(ji,jj,jk) 
    848                e3u_n(ji,jj,jk) = e3u_a(ji,jj,jk) 
    849                e3v_n(ji,jj,jk) = e3v_a(ji,jj,jk) 
    850             END DO 
    851          END DO 
    852       END DO 
     603         tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 
     604      ENDIF 
     605      gdept_b(:,:,:) = gdept_n(:,:,:) 
     606      gdepw_b(:,:,:) = gdepw_n(:,:,:) 
     607 
     608      e3t_n(:,:,:) = e3t_a(:,:,:) 
     609      e3u_n(:,:,:) = e3u_a(:,:,:) 
     610      e3v_n(:,:,:) = e3v_a(:,:,:) 
    853611 
    854612      ! Compute all missing vertical scale factor and depths 
     
    870628 
    871629      ! t- and w- points depth (set the isf depth as it is in the initial step) 
    872 ! !$OMP PARALLEL 
    873 ! !$OMP DO schedule(static) private(jj,ji) 
    874       DO jj = 1, jpj 
    875          DO ji = 1, jpi 
    876             gdept_n(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) 
    877             gdepw_n(ji,jj,1) = 0.0_wp 
    878             gde3w_n(ji,jj,1) = gdept_n(ji,jj,1) - sshn(ji,jj) 
    879          END DO 
    880       END DO 
     630      gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
     631      gdepw_n(:,:,1) = 0.0_wp 
     632      gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
    881633      DO jk = 2, jpk 
    882 ! !$OMP DO schedule(static) private(jj,ji,zcoef) 
    883634         DO jj = 1,jpj 
    884635            DO ji = 1,jpi 
     
    896647      ! Local depth and Inverse of the local depth of the water 
    897648      ! ------------------------------------------------------- 
    898 !$OMP PARALLEL 
    899 !$OMP DO schedule(static) private(jj,ji) 
    900       DO jj = 1, jpj 
    901          DO ji = 1, jpi 
    902             hu_n(ji,jj) = hu_a(ji,jj)   ;   r1_hu_n(ji,jj) = r1_hu_a(ji,jj) 
    903             hv_n(ji,jj) = hv_a(ji,jj)   ;   r1_hv_n(ji,jj) = r1_hv_a(ji,jj) 
    904             ! 
    905             ht_n(ji,jj) = e3t_n(ji,jj,1) * tmask(ji,jj,1) 
    906          END DO 
     649      hu_n(:,:) = hu_a(:,:)   ;   r1_hu_n(:,:) = r1_hu_a(:,:) 
     650      hv_n(:,:) = hv_a(:,:)   ;   r1_hv_n(:,:) = r1_hv_a(:,:) 
     651      ! 
     652      ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1) 
     653      DO jk = 2, jpkm1 
     654         ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
    907655      END DO 
    908       DO jk = 2, jpkm1 
    909 !$OMP DO schedule(static) private(jj,ji) 
    910          DO jj = 1, jpj 
    911             DO ji = 1, jpi 
    912                ht_n(ji,jj) = ht_n(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    913             END DO 
    914          END DO 
    915       END DO 
    916 !$OMP END PARALLEL 
     656 
    917657      ! write restart file 
    918658      ! ================== 
     
    954694         ! 
    955695      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean 
    956 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    957696         DO jk = 1, jpk 
    958697            DO jj = 1, jpjm1 
     
    965704         END DO 
    966705         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 
    967 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    968          DO jk = 1, jpk 
    969             DO jj = 1, jpj 
    970                DO ji = 1, jpi 
    971                   pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3u_0(ji,jj,jk) 
    972                END DO 
    973             END DO 
    974          END DO 
     706         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    975707         ! 
    976708      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean 
    977 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    978709         DO jk = 1, jpk 
    979710            DO jj = 1, jpjm1 
     
    986717         END DO 
    987718         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 
    988 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    989          DO jk = 1, jpk 
    990             DO jj = 1, jpj 
    991                DO ji = 1, jpi 
    992                   pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3v_0(ji,jj,jk) 
    993                END DO 
    994             END DO 
    995          END DO 
     719         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    996720         ! 
    997721      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
    998 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    999722         DO jk = 1, jpk 
    1000723            DO jj = 1, jpjm1 
     
    1008731         END DO 
    1009732         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 
    1010 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    1011          DO jk = 1, jpk 
    1012             DO jj = 1, jpj 
    1013                DO ji = 1, jpi 
    1014                   pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3f_0(ji,jj,jk) 
    1015                END DO 
    1016             END DO 
    1017          END DO 
     733         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
    1018734         ! 
    1019735      CASE( 'W' )                   !* from T- to W-point : vertical simple mean 
    1020736         ! 
    1021 !$OMP PARALLEL 
    1022 !$OMP DO schedule(static) private(jj,ji) 
    1023          DO jj = 1, jpj 
    1024             DO ji = 1, jpi 
    1025                pe3_out(ji,jj,1) = e3w_0(ji,jj,1) + pe3_in(ji,jj,1) - e3t_0(ji,jj,1) 
    1026             END DO 
    1027          END DO 
     737         pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 
    1028738         ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing 
    1029739!!gm BUG? use here wmask in case of ISF ?  to be checked 
    1030 !$OMP DO schedule(static) private(jk,jj,ji) 
    1031740         DO jk = 2, jpk 
    1032             DO jj = 1, jpj 
    1033                DO ji = 1, jpi 
    1034                   pe3_out(ji,jj,jk) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( tmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) )   & 
    1035                      &                            * ( pe3_in(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )                               & 
    1036                      &                            +            0.5_wp * ( tmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd )     & 
    1037                      &                            * ( pe3_in(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) ) 
    1038                END DO 
    1039             END DO 
    1040          END DO 
    1041 !$OMP END PARALLEL 
     741            pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   & 
     742               &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               & 
     743               &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     & 
     744               &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) ) 
     745         END DO 
    1042746         ! 
    1043747      CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean 
    1044748         ! 
    1045 !$OMP PARALLEL 
    1046 !$OMP DO schedule(static) private(jj,ji) 
    1047          DO jj = 1, jpj 
    1048             DO ji = 1, jpi 
    1049                pe3_out(ji,jj,1) = e3uw_0(ji,jj,1) + pe3_in(ji,jj,1) - e3u_0(ji,jj,1) 
    1050             END DO 
    1051          END DO 
     749         pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 
    1052750         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
    1053751!!gm BUG? use here wumask in case of ISF ?  to be checked 
    1054 !$OMP DO schedule(static) private(jk,jj,ji) 
    1055752         DO jk = 2, jpk 
    1056             DO jj = 1, jpj 
    1057                DO ji = 1, jpi 
    1058                   pe3_out(ji,jj,jk) = e3uw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
    1059                      &                             * ( pe3_in(ji,jj,jk-1) - e3u_0(ji,jj,jk-1) )                              & 
    1060                      &                             +            0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
    1061                      &                             * ( pe3_in(ji,jj,jk  ) - e3u_0(ji,jj,jk  ) ) 
    1062                END DO 
    1063             END DO 
    1064          END DO 
    1065 !$OMP END PARALLEL 
     753            pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
     754               &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              & 
     755               &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
     756               &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) ) 
     757         END DO 
    1066758         ! 
    1067759      CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean 
    1068760         ! 
    1069 !$OMP PARALLEL 
    1070 !$OMP DO schedule(static) private(jj,ji) 
    1071          DO jj = 1, jpj 
    1072             DO ji = 1, jpi 
    1073                pe3_out(ji,jj,1) = e3vw_0(ji,jj,1) + pe3_in(ji,jj,1) - e3v_0(ji,jj,1) 
    1074             END DO 
    1075          END DO 
     761         pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 
    1076762         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
    1077763!!gm BUG? use here wvmask in case of ISF ?  to be checked 
    1078 !$OMP DO schedule(static) private(jk,jj,ji) 
    1079764         DO jk = 2, jpk 
    1080             DO jj = 1, jpj 
    1081                DO ji = 1, jpi 
    1082                   pe3_out(ji,jj,jk) = e3vw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
    1083                      &                             * ( pe3_in(ji,jj,jk-1) - e3v_0(ji,jj,jk-1) )                              & 
    1084                      &                             +            0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
    1085                      &                             * ( pe3_in(ji,jj,jk  ) - e3v_0(ji,jj,jk  ) ) 
    1086                END DO 
    1087             END DO 
    1088          END DO 
    1089 !$OMP END PARALLEL 
     765            pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
     766               &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              & 
     767               &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
     768               &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) ) 
     769         END DO 
    1090770      END SELECT 
    1091771      ! 
     
    1225905                     sshb(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)           !!gm I don't understand that ! 
    1226906                     sshn(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
    1227                      ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)                      
     907                     ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
    1228908                  ENDIF 
    1229909                ENDDO 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r7698 r7753  
    7272      INTEGER, DIMENSION(:,:), INTENT(out) ::   k_top, k_bot   ! ocean first and last level indices 
    7373      ! 
    74       INTEGER  ::   ji, jj, jk                  ! dummy loop index 
     74      INTEGER  ::   jk                  ! dummy loop index 
    7575      INTEGER  ::   ioptio, ibat, ios   ! local integer 
    7676      REAL(wp) ::   zrefdep             ! depth of the reference level (~10m) 
     
    114114!!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears 
    115115      ! Compute gde3w_0 (vertical sum of e3w) 
    116 !$OMP PARALLEL 
    117 !$OMP DO schedule(static) private(jj, ji) 
    118       DO jj = 1, jpj 
    119          DO ji = 1, jpi 
    120             gde3w_0(ji,jj,1) = 0.5_wp * e3w_0(ji,jj,1) 
    121          END DO 
     116      gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
     117      DO jk = 2, jpk 
     118         gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
    122119      END DO 
    123       DO jk = 2, jpk 
    124 !$OMP DO schedule(static) private(jj, ji) 
    125          DO jj = 1, jpj 
    126             DO ji = 1, jpi 
    127                gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
    128             END DO 
    129          END DO 
    130       END DO 
    131 !$OMP END PARALLEL 
    132120      ! 
    133121      IF(lwp) THEN                     ! Control print 
     
    202190      INTEGER , DIMENSION(:,:)  , INTENT(out) ::   k_top , k_bot               ! first & last ocean level 
    203191      ! 
    204       INTEGER  ::   jk, jj, ji   ! dummy loop index 
     192      INTEGER  ::   jk     ! dummy loop index 
    205193      INTEGER  ::   inum   ! local logical unit 
    206194      REAL(WP) ::   z_zco, z_zps, z_sco, z_cav 
     
    266254      !                          !* ocean top and bottom level 
    267255      CALL iom_get( inum, jpdom_data, 'top_level'    , z2d  , lrowattr=ln_use_jattr )   ! 1st wet T-points (ISF) 
    268 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    269       DO jj = 1, jpj 
    270          DO ji = 1, jpi 
    271             k_top(ji,jj) = INT( z2d(ji,jj) ) 
    272          END DO 
    273       END DO 
     256      k_top(:,:) = INT( z2d(:,:) ) 
    274257      CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d  , lrowattr=ln_use_jattr )   ! last wet T-points 
    275 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    276       DO jj = 1, jpj 
    277          DO ji = 1, jpi 
    278             k_bot(ji,jj) = INT( z2d(ji,jj) ) 
    279          END DO 
    280       END DO 
     258      k_bot(:,:) = INT( z2d(:,:) ) 
    281259      ! 
    282260      ! bathymetry with orography (wetting and drying only) 
     
    317295      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~' 
    318296      ! 
    319 !$OMP PARALLEL 
    320 !$OMP DO schedule(static) private(jj, ji) 
    321       DO jj = 1, jpj 
    322          DO ji = 1, jpi 
    323             mikt(ji,jj) = MAX( k_top(ji,jj) , 1 )    ! top    ocean k-index of T-level (=1 over land) 
    324             ! 
    325             mbkt(ji,jj) = MAX( k_bot(ji,jj) , 1 )    ! bottom ocean k-index of T-level (=1 over land) 
    326          END DO 
    327       END DO 
     297      mikt(:,:) = MAX( k_top(:,:) , 1 )    ! top    ocean k-index of T-level (=1 over land) 
     298      ! 
     299      mbkt(:,:) = MAX( k_bot(:,:) , 1 )    ! bottom ocean k-index of T-level (=1 over land) 
     300  
    328301      !                                    ! N.B.  top     k-index of W-level = mikt 
    329302      !                                    !       bottom  k-index of W-level = mbkt+1 
    330 !$OMP DO schedule(static) private(jj, ji) 
    331303      DO jj = 1, jpjm1 
    332304         DO ji = 1, jpim1 
     
    340312      END DO 
    341313      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk  
    342 !$OMP DO schedule(static) private(jj, ji) 
    343       DO jj = 1, jpj 
    344          DO ji = 1, jpi 
    345             zk(ji,jj) = REAL( miku(ji,jj), wp ) 
    346          END DO 
    347       END DO 
    348 !$OMP END PARALLEL 
    349       CALL lbc_lnk( zk, 'U', 1. ) 
    350 !$OMP PARALLEL 
    351 !$OMP DO schedule(static) private(jj, ji) 
    352       DO jj = 1, jpj 
    353          DO ji = 1, jpi 
    354             miku(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 
    355          END DO 
    356       END DO 
    357 !$OMP DO schedule(static) private(jj, ji) 
    358       DO jj = 1, jpj 
    359          DO ji = 1, jpi 
    360             zk(ji,jj) = REAL( mikv(ji,jj), wp ) 
    361          END DO 
    362       END DO 
    363 !$OMP END PARALLEL 
    364       CALL lbc_lnk( zk, 'V', 1. ) 
    365 !$OMP PARALLEL 
    366 !$OMP DO schedule(static) private(jj, ji) 
    367       DO jj = 1, jpj 
    368          DO ji = 1, jpi 
    369             mikv(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 
    370          END DO 
    371       END DO 
    372 !$OMP DO schedule(static) private(jj, ji) 
    373       DO jj = 1, jpj 
    374          DO ji = 1, jpi 
    375             zk(ji,jj) = REAL( mikf(ji,jj), wp ) 
    376          END DO 
    377       END DO 
    378 !$OMP END PARALLEL 
    379       CALL lbc_lnk( zk, 'F', 1. ) 
    380 !$OMP PARALLEL 
    381 !$OMP DO schedule(static) private(jj, ji) 
    382       DO jj = 1, jpj 
    383          DO ji = 1, jpi 
    384             mikf(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 
    385          END DO 
    386       END DO 
    387       ! 
    388 !$OMP DO schedule(static) private(jj, ji) 
    389       DO jj = 1, jpj 
    390          DO ji = 1, jpi 
    391             zk(ji,jj) = REAL( mbku(ji,jj), wp ) 
    392          END DO 
    393       END DO 
    394 !$OMP END PARALLEL 
    395       CALL lbc_lnk( zk, 'U', 1. ) 
    396 !$OMP PARALLEL 
    397 !$OMP DO schedule(static) private(jj, ji) 
    398       DO jj = 1, jpj 
    399          DO ji = 1, jpi 
    400             mbku(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 
    401          END DO 
    402       END DO 
    403 !$OMP DO schedule(static) private(jj, ji) 
    404       DO jj = 1, jpj 
    405          DO ji = 1, jpi 
    406             zk(ji,jj) = REAL( mbkv(ji,jj), wp ) 
    407          END DO 
    408       END DO 
    409 !$OMP END PARALLEL 
    410       CALL lbc_lnk( zk, 'V', 1. ) 
    411 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    412       DO jj = 1, jpj 
    413          DO ji = 1, jpi 
    414             mbkv(ji,jj) = MAX( INT( zk(ji,jj) ), 1 ) 
    415          END DO 
    416       END DO 
     314      zk(:,:) = REAL( miku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   miku(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     315      zk(:,:) = REAL( mikv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mikv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     316      zk(:,:) = REAL( mikf(:,:), wp )   ;   CALL lbc_lnk( zk, 'F', 1. )   ;   mikf(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     317      ! 
     318      zk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk( zk, 'U', 1. )   ;   mbku(:,:) = MAX( INT( zk(:,:) ), 1 ) 
     319      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
    417320      ! 
    418321      CALL wrk_dealloc( jpi,jpj,   zk ) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r7698 r7753  
    161161         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea 
    162162         ii0 = 141   ;   ii1 = 155 
    163 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    164163         DO jj = mj0(ij0), mj1(ij1) 
    165164            DO ji = mi0(ii0), mi1(ii1) 
     
    182181!!gm end 
    183182      ! 
    184 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    185       DO jk = 1, jpk 
    186          DO jj = 1, jpj 
    187             DO ji = 1, jpi 
    188                ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk)    ! NO mask 
    189                ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 
    190             END DO 
    191          END DO 
    192       END DO 
     183      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask 
     184      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:)  
    193185      ! 
    194186      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     
    201193         ENDIF 
    202194         ! 
    203 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk, zl, jkk, zi) 
    204195         DO jj = 1, jpj                         ! vertical interpolation of T & S 
    205196            DO ji = 1, jpi 
     
    235226      ELSE                                !==   z- or zps- coordinate   ==! 
    236227         !                              
    237 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    238          DO jk = 1, jpk 
    239             DO jj = 1, jpj 
    240                DO ji = 1, jpi 
    241                   ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)    ! Mask 
    242                   ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
    243                END DO 
    244             END DO 
    245          END DO 
     228         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask 
     229         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 
    246230         ! 
    247231         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
    248 !$OMP PARALLEL DO schedule(static) private(jj, ji, ik, zl) 
    249232            DO jj = 1, jpj 
    250233               DO ji = 1, jpi 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r7698 r7753  
    5959      !! ** Purpose :   Initialization of the dynamics and tracer fields. 
    6060      !!---------------------------------------------------------------------- 
    61       INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     61      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    6262      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
    6363      !!---------------------------------------------------------------------- 
     
    7575!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
    7676!!gm 
    77 !$OMP PARALLEL 
    78       DO jn = 1, jpts 
    79 !$OMP DO schedule(static) private(jk, jj, ji) 
    80          DO jk = 1, jpk 
    81             DO jj = 1, jpj 
    82                DO ji = 1, jpi 
    83                   tsa  (ji,jj,jk,jn) = 0._wp                                       ! set one for all to 0 at level jpk 
    84                   rab_b(ji,jj,jk,jn) = 0._wp   ;   rab_n(ji,jj,jk,jn) = 0._wp      ! set one for all to 0 at level jpk 
    85                END DO 
    86             END DO 
    87          END DO 
    88       END DO 
    89 !$OMP DO schedule(static) private(jk, jj, ji) 
    90       DO jk = 1, jpk 
    91          DO jj = 1, jpj 
    92             DO ji = 1, jpi 
    93                rhd  (ji,jj,jk  ) = 0._wp   ;   rhop (ji,jj,jk  ) = 0._wp      ! set one for all to 0 at level jpk 
    94                rn2b (ji,jj,jk  ) = 0._wp   ;   rn2  (ji,jj,jk  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    95             END DO 
    96          END DO 
    97       END DO 
    98 !$OMP END PARALLEL 
     77 
     78      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
     79      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
     80      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk 
     81      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
    9982 
    10083      IF( ln_rstart ) THEN                    ! Restart from a file 
     
    11497            CALL dta_tsd( nit000, tsb )       ! read 3D T and S data at nit000 
    11598            ! 
    116 !$OMP PARALLEL 
    117 !$OMP DO schedule(static) private(jj, ji) 
    118             DO jj = 1, jpj 
    119                DO ji = 1, jpi 
    120                   sshb (ji,jj)   = 0._wp      ! set the ocean at rest 
    121                END DO 
    122             END DO 
    123 !$OMP END DO NOWAIT 
    124 !$OMP DO schedule(static) private(jk, jj, ji) 
    125             DO jk = 1, jpk 
    126                DO jj = 1, jpj 
    127                   DO ji = 1, jpi 
    128                      ub  (ji,jj,jk) = 0._wp 
    129                      vb  (ji,jj,jk) = 0._wp   
    130                   END DO 
    131                END DO 
    132             END DO 
    133 !$OMP END PARALLEL 
     99            sshb(:,:)   = 0._wp               ! set the ocean at rest 
     100            ub  (:,:,:) = 0._wp 
     101            vb  (:,:,:) = 0._wp   
    134102            ! 
    135103         ELSE                                 ! user defined initial T and S 
    136104            CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )          
    137105         ENDIF 
    138 !$OMP PARALLEL 
    139          DO jn = 1, jpts 
    140 !$OMP DO schedule(static) private(jk, jj, ji) 
    141             DO jk = 1, jpk 
    142                DO jj = 1, jpj 
    143                   DO ji = 1, jpi 
    144                      tsn  (ji,jj,jk,jn) = tsb (ji,jj,jk,jn)       ! set now values from to before ones 
    145                   END DO 
    146                END DO 
    147             END DO 
    148          END DO 
    149 !$OMP DO schedule(static) private(jk, jj, ji) 
    150          DO jk = 1, jpk 
    151             DO jj = 1, jpj 
    152                DO ji = 1, jpi 
    153                   un   (ji,jj,jk)   = ub  (ji,jj,jk) 
    154                   vn   (ji,jj,jk)   = vb  (ji,jj,jk) 
    155                END DO 
    156             END DO 
    157          END DO 
    158 !$OMP DO schedule(static) private(jj, ji) 
    159          DO jj = 1, jpj 
    160             DO ji = 1, jpi 
    161                sshn (ji,jj)     = sshb(ji,jj)    
    162                hdivn(ji,jj,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    163             END DO 
    164          END DO 
    165 !$OMP END PARALLEL 
     106         tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones 
     107         sshn (:,:)     = sshb(:,:)    
     108         un   (:,:,:)   = ub  (:,:,:) 
     109         vn   (:,:,:)   = vb  (:,:,:) 
     110         hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
    166111         CALL div_hor( 0 )                    ! compute interior hdivn value   
    167112!!gm                                    hdivn(:,:,:) = 0._wp 
     
    197142      ! Do it whatever the free surface method, these arrays being eventually used 
    198143      ! 
    199 !$OMP PARALLEL 
    200 !$OMP DO schedule(static) private(jj, ji) 
    201       DO jj = 1, jpj 
    202          DO ji = 1, jpi 
    203             un_b(ji,jj) = 0._wp   ;   vn_b(ji,jj) = 0._wp 
    204             ub_b(ji,jj) = 0._wp   ;   vb_b(ji,jj) = 0._wp 
    205          END DO 
    206       END DO 
     144      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp 
     145      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
    207146      ! 
    208147!!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked 
    209148      DO jk = 1, jpkm1 
    210 !$OMP DO schedule(static) private(jj, ji) 
    211149         DO jj = 1, jpj 
    212150            DO ji = 1, jpi 
     
    220158      END DO 
    221159      ! 
    222 !$OMP DO schedule(static) private(jj, ji) 
    223       DO jj = 1, jpj 
    224          DO ji = 1, jpi 
    225             un_b(ji,jj) = un_b(ji,jj) * r1_hu_n(ji,jj) 
    226             vn_b(ji,jj) = vn_b(ji,jj) * r1_hv_n(ji,jj) 
    227             ! 
    228             ub_b(ji,jj) = ub_b(ji,jj) * r1_hu_b(ji,jj) 
    229             vb_b(ji,jj) = vb_b(ji,jj) * r1_hv_b(ji,jj) 
    230          END DO 
    231       END DO 
    232 !$OMP END PARALLEL 
     160      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 
     161      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 
     162      ! 
     163      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
     164      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
    233165      ! 
    234166      IF( nn_timing == 1 )   CALL timing_stop('istate_init') 
Note: See TracChangeset for help on using the changeset viewer.