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 7753 for trunk/NEMOGCM/NEMO/OPA_SRC – NEMO

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

Reverting trunk to remove OpenMP

Location:
trunk/NEMOGCM/NEMO/OPA_SRC
Files:
71 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r7698 r7753  
    156156      USE lib_mpp, ONLY: ctl_warn, mpp_sum 
    157157      ! 
    158       INTEGER :: ji, jj         ! dummy loop indices 
    159158      INTEGER :: bdy_oce_alloc 
    160159      !!---------------------------------------------------------------------- 
    … …  
    164163      ! 
    165164      ! Initialize masks  
    166 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    167       DO jj = 1, jpj 
    168          DO ji = 1, jpi 
    169             bdytmask(ji,jj) = 1._wp 
    170             bdyumask(ji,jj) = 1._wp 
    171             bdyvmask(ji,jj) = 1._wp 
    172          END DO 
    173       END DO 
     165      bdytmask(:,:) = 1._wp 
     166      bdyumask(:,:) = 1._wp 
     167      bdyvmask(:,:) = 1._wp 
    174168      !  
    175169      IF( lk_mpp             )   CALL mpp_sum ( bdy_oce_alloc ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r7698 r7753  
    6262      INTEGER ::   ios                 ! Local integer output status for namelist read 
    6363      INTEGER ::   ierror              ! Local integer for memory allocation 
    64       INTEGER ::   ji, jj, jk 
    6564      ! 
    6665      NAMELIST/nam_dia25h/ ln_dia25h 
    … …  
    135134      ! ------------------------- ! 
    136135      cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible)  
    137 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    138          DO jk = 1, jpk 
    139             DO jj = 1, jpj 
    140                DO ji = 1, jpi 
    141                   tn_25h(ji,jj,jk) = tsb(ji,jj,jk,jp_tem) 
    142                   sn_25h(ji,jj,jk) = tsb(ji,jj,jk,jp_sal) 
    143                   sshn_25h(ji,jj) = sshb(ji,jj) 
    144                   un_25h(ji,jj,jk) = ub(ji,jj,jk) 
    145                   vn_25h(ji,jj,jk) = vb(ji,jj,jk) 
    146                   wn_25h(ji,jj,jk) = wn(ji,jj,jk) 
    147                   avt_25h(ji,jj,jk) = avt(ji,jj,jk) 
    148                   avm_25h(ji,jj,jk) = avm(ji,jj,jk) 
    149 # if defined key_zdfgls || defined key_zdftke 
    150                   en_25h(ji,jj,jk) = en(ji,jj,jk) 
     136      tn_25h(:,:,:) = tsb(:,:,:,jp_tem) 
     137      sn_25h(:,:,:) = tsb(:,:,:,jp_sal) 
     138      sshn_25h(:,:) = sshb(:,:) 
     139      un_25h(:,:,:) = ub(:,:,:) 
     140      vn_25h(:,:,:) = vb(:,:,:) 
     141      wn_25h(:,:,:) = wn(:,:,:) 
     142      avt_25h(:,:,:) = avt(:,:,:) 
     143      avm_25h(:,:,:) = avm(:,:,:) 
     144# if defined key_zdfgls || defined key_zdftke 
     145         en_25h(:,:,:) = en(:,:,:) 
    151146#endif 
    152147# if defined key_zdfgls 
    153                   rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 
    154 #endif 
    155                END DO 
    156             END DO 
    157          END DO 
     148         rmxln_25h(:,:,:) = mxln(:,:,:) 
     149#endif 
    158150#if defined key_lim3 || defined key_lim2 
    159151         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
    … …  
    231223         ENDIF 
    232224 
    233 !$OMP PARALLEL 
    234 !$OMP DO schedule(static) private(jj, ji) 
    235          DO jj = 1, jpj 
    236             DO ji = 1, jpi 
    237                sshn_25h(ji,jj)     = sshn_25h(ji,jj) + sshn (ji,jj) 
    238             END DO 
    239          END DO 
    240 !$OMP END DO NOWAIT 
    241 !$OMP DO schedule(static) private(jk, jj, ji) 
    242          DO jk = 1, jpk 
    243             DO jj = 1, jpj 
    244                DO ji = 1, jpi 
    245                   tn_25h(ji,jj,jk)        = tn_25h(ji,jj,jk) + tsn(ji,jj,jk,jp_tem) 
    246                   sn_25h(ji,jj,jk)        = sn_25h(ji,jj,jk) + tsn(ji,jj,jk,jp_sal) 
    247                   un_25h(ji,jj,jk)        = un_25h(ji,jj,jk) + un(ji,jj,jk) 
    248                   vn_25h(ji,jj,jk)        = vn_25h(ji,jj,jk) + vn(ji,jj,jk) 
    249                   wn_25h(ji,jj,jk)        = wn_25h(ji,jj,jk) + wn(ji,jj,jk) 
    250                   avt_25h(ji,jj,jk)       = avt_25h(ji,jj,jk) + avt(ji,jj,jk) 
    251                   avm_25h(ji,jj,jk)       = avm_25h(ji,jj,jk) + avm(ji,jj,jk) 
    252 # if defined key_zdfgls || defined key_zdftke 
    253                   en_25h(ji,jj,jk)        = en_25h(ji,jj,jk) + en(ji,jj,jk) 
     225         tn_25h(:,:,:)        = tn_25h(:,:,:) + tsn(:,:,:,jp_tem) 
     226         sn_25h(:,:,:)        = sn_25h(:,:,:) + tsn(:,:,:,jp_sal) 
     227         sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:) 
     228         un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:) 
     229         vn_25h(:,:,:)        = vn_25h(:,:,:) + vn(:,:,:) 
     230         wn_25h(:,:,:)        = wn_25h(:,:,:) + wn(:,:,:) 
     231         avt_25h(:,:,:)       = avt_25h(:,:,:) + avt(:,:,:) 
     232         avm_25h(:,:,:)       = avm_25h(:,:,:) + avm(:,:,:) 
     233# if defined key_zdfgls || defined key_zdftke 
     234         en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:) 
    254235#endif 
    255236# if defined key_zdfgls 
    256                   rmxln_25h(ji,jj,jk)      = rmxln_25h(ji,jj,jk) + mxln(ji,jj,jk) 
    257 #endif 
    258                END DO 
    259             END DO 
    260          END DO 
    261 !$OMP END PARALLEL 
     237         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
     238#endif 
    262239         cnt_25h = cnt_25h + 1 
    263240 
    … …  
    276253            ENDIF 
    277254 
    278 !$OMP PARALLEL 
    279 !$OMP DO schedule(static) private(jj, ji) 
    280          DO jj = 1, jpj 
    281             DO ji = 1, jpi 
    282                sshn_25h(ji,jj)     = sshn_25h(ji,jj) / 25.0_wp 
    283             END DO 
    284          END DO 
    285 !$OMP END DO NOWAIT 
    286 !$OMP DO schedule(static) private(jk, jj, ji) 
    287          DO jk = 1, jpk 
    288             DO jj = 1, jpj 
    289                DO ji = 1, jpi 
    290                   tn_25h(ji,jj,jk)        = tn_25h(ji,jj,jk) / 25.0_wp 
    291                   sn_25h(ji,jj,jk)        = sn_25h(ji,jj,jk) / 25.0_wp 
    292                   un_25h(ji,jj,jk)        = un_25h(ji,jj,jk) / 25.0_wp 
    293                   vn_25h(ji,jj,jk)        = vn_25h(ji,jj,jk) / 25.0_wp 
    294                   wn_25h(ji,jj,jk)        = wn_25h(ji,jj,jk) / 25.0_wp 
    295                   avt_25h(ji,jj,jk)       = avt_25h(ji,jj,jk) / 25.0_wp 
    296                   avm_25h(ji,jj,jk)       = avm_25h(ji,jj,jk) / 25.0_wp 
    297 # if defined key_zdfgls || defined key_zdftke 
    298                   en_25h(ji,jj,jk)        = en_25h(ji,jj,jk) / 25.0_wp 
     255            tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp 
     256            sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp 
     257            sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp 
     258            un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp 
     259            vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp 
     260            wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp 
     261            avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp 
     262            avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp 
     263# if defined key_zdfgls || defined key_zdftke 
     264            en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp 
    299265#endif 
    300266# if defined key_zdfgls 
    301                   rmxln_25h(ji,jj,jk)       = rmxln_25h(ji,jj,jk) / 25.0_wp 
    302 #endif 
    303                END DO 
    304             END DO 
    305          END DO 
    306 !$OMP END PARALLEL 
     267            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp 
     268#endif 
    307269 
    308270            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 
    309271            zmdi=1.e+20 !missing data indicator for masking 
    310272            ! write tracers (instantaneous) 
    311 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    312          DO jk = 1, jpk 
    313             DO jj = 1, jpj 
    314                DO ji = 1, jpi 
    315                   zw3d(ji,jj,jk) = tn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
    316                END DO 
    317             END DO 
    318          END DO 
     273            zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    319274            CALL iom_put("temper25h", zw3d)   ! potential temperature 
    320 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    321          DO jk = 1, jpk 
    322             DO jj = 1, jpj 
    323                DO ji = 1, jpi 
    324                   zw3d(ji,jj,jk) = sn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
    325                END DO 
    326             END DO 
    327          END DO 
     275            zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    328276            CALL iom_put( "salin25h", zw3d  )   ! salinity 
    329 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    330          DO jj = 1, jpj 
    331             DO ji = 1, jpi 
    332                zw2d(ji,jj) = sshn_25h(ji,jj)*tmask(ji,jj,1) + zmdi*(1.0-tmask(ji,jj,1)) 
    333             END DO 
    334          END DO 
     277            zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
    335278            CALL iom_put( "ssh25h", zw2d )   ! sea surface  
    336279 
    337280 
    338281            ! Write velocities (instantaneous) 
    339 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    340          DO jk = 1, jpk 
    341             DO jj = 1, jpj 
    342                DO ji = 1, jpi 
    343                   zw3d(ji,jj,jk) = un_25h(ji,jj,jk)*umask(ji,jj,jk) + zmdi*(1.0-umask(ji,jj,jk)) 
    344                END DO 
    345             END DO 
    346          END DO 
     282            zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 
    347283            CALL iom_put("vozocrtx25h", zw3d)    ! i-current 
    348 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    349          DO jk = 1, jpk 
    350             DO jj = 1, jpj 
    351                DO ji = 1, jpi 
    352                   zw3d(ji,jj,jk) = vn_25h(ji,jj,jk)*vmask(ji,jj,jk) + zmdi*(1.0-vmask(ji,jj,jk)) 
    353                END DO 
    354             END DO 
    355          END DO 
     284            zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 
    356285            CALL iom_put("vomecrty25h", zw3d  )   ! j-current 
    357 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    358          DO jk = 1, jpk 
    359             DO jj = 1, jpj 
    360                DO ji = 1, jpi 
    361                   zw3d(ji,jj,jk) = wn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
    362                END DO 
    363             END DO 
    364          END DO 
     286 
     287            zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    365288            CALL iom_put("vomecrtz25h", zw3d )   ! k-current 
    366 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    367          DO jk = 1, jpk 
    368             DO jj = 1, jpj 
    369                DO ji = 1, jpi 
    370                   zw3d(ji,jj,jk) = avt_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
    371                END DO 
    372             END DO 
    373          END DO 
     289            zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    374290            CALL iom_put("avt25h", zw3d )   ! diffusivity 
    375 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    376          DO jk = 1, jpk 
    377             DO jj = 1, jpj 
    378                DO ji = 1, jpi 
    379                   zw3d(ji,jj,jk) = avm_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
    380                END DO 
    381             END DO 
    382          END DO 
     291            zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    383292            CALL iom_put("avm25h", zw3d)   ! viscosity 
    384293#if defined key_zdftke || defined key_zdfgls  
    385 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    386          DO jk = 1, jpk 
    387             DO jj = 1, jpj 
    388                DO ji = 1, jpi 
    389                   zw3d(ji,jj,jk) = en_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
    390                END DO 
    391             END DO 
    392          END DO 
     294            zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    393295            CALL iom_put("tke25h", zw3d)   ! tke 
    394296#endif 
    395297#if defined key_zdfgls  
    396 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    397          DO jk = 1, jpk 
    398             DO jj = 1, jpj 
    399                DO ji = 1, jpi 
    400                   zw3d(ji,jj,jk) = rmxln_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
    401                END DO 
    402             END DO 
    403          END DO 
     298            zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
    404299            CALL iom_put( "mxln25h",zw3d) 
    405300#endif 
    406301 
    407302            ! After the write reset the values to cnt=1 and sum values equal current value  
    408 !$OMP PARALLEL 
    409 !$OMP DO schedule(static) private(jj, ji) 
    410          DO jj = 1, jpj 
    411             DO ji = 1, jpi 
    412                sshn_25h(ji,jj) = sshn (ji,jj) 
    413             END DO 
    414          END DO 
    415 !$OMP END DO NOWAIT 
    416 !$OMP DO schedule(static) private(jk, jj, ji) 
    417          DO jk = 1, jpk 
    418             DO jj = 1, jpj 
    419                DO ji = 1, jpi 
    420                   tn_25h(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) 
    421                   sn_25h(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 
    422                   un_25h(ji,jj,jk) = un(ji,jj,jk) 
    423                   vn_25h(ji,jj,jk) = vn(ji,jj,jk) 
    424                   wn_25h(ji,jj,jk) = wn(ji,jj,jk) 
    425                   avt_25h(ji,jj,jk) = avt(ji,jj,jk) 
    426                   avm_25h(ji,jj,jk) = avm(ji,jj,jk) 
    427 # if defined key_zdfgls || defined key_zdftke 
    428                   en_25h(ji,jj,jk) = en(ji,jj,jk) 
     303            tn_25h(:,:,:) = tsn(:,:,:,jp_tem) 
     304            sn_25h(:,:,:) = tsn(:,:,:,jp_sal) 
     305            sshn_25h(:,:) = sshn (:,:) 
     306            un_25h(:,:,:) = un(:,:,:) 
     307            vn_25h(:,:,:) = vn(:,:,:) 
     308            wn_25h(:,:,:) = wn(:,:,:) 
     309            avt_25h(:,:,:) = avt(:,:,:) 
     310            avm_25h(:,:,:) = avm(:,:,:) 
     311# if defined key_zdfgls || defined key_zdftke 
     312            en_25h(:,:,:) = en(:,:,:) 
    429313#endif 
    430314# if defined key_zdfgls 
    431                   rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 
    432 #endif 
    433                END DO 
    434             END DO 
    435          END DO 
    436 !$OMP END PARALLEL 
     315            rmxln_25h(:,:,:) = mxln(:,:,:) 
     316#endif 
    437317            cnt_25h = 1 
    438318            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r7698 r7753  
    8989         CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    9090         CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
    91 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    92          DO jj = 1, jpj 
    93             DO ji = 1, jpi 
    94                zarea_ssh(ji,jj) = area(ji,jj) * sshn(ji,jj) 
    95             END DO 
    96          END DO 
     91         zarea_ssh(:,:) = area(:,:) * sshn(:,:) 
    9792      ENDIF 
    9893      ! 
    … …  
    111106      IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN     
    112107         !                      
    113 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    114          DO jk = 1, jpk 
    115             DO jj = 1, jpj 
    116                DO ji = 1, jpi 
    117                   ztsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem)                    ! thermosteric ssh 
    118                   ztsn(ji,jj,jk,jp_sal) = sn0(ji,jj,jk) 
    119                END DO 
    120             END DO 
    121          END DO 
     108         ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
     109         ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    122110         CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity 
    123111         ! 
    124 !$OMP PARALLEL 
    125 !$OMP DO schedule(static) private(jj, ji) 
    126          DO jj = 1, jpj 
    127             DO ji = 1, jpi 
    128                zbotpres(ji,jj) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    129             END DO 
    130          END DO 
     112         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    131113         DO jk = 1, jpkm1 
    132 !$OMP DO schedule(static) private(jj, ji) 
    133             DO jj = 1, jpj 
    134                DO ji = 1, jpi 
    135                   zbotpres(ji,jj) = zbotpres(ji,jj) + e3t_n(ji,jj,jk) * zrhd(ji,jj,jk) 
    136                END DO 
    137             END DO 
    138          END DO 
    139 !$OMP END PARALLEL 
     114            zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
     115         END DO 
    140116         IF( ln_linssh ) THEN 
    141117            IF( ln_isfcav ) THEN 
    142 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    143118               DO ji = 1, jpi 
    144119                  DO jj = 1, jpj 
    … …  
    147122               END DO 
    148123            ELSE 
    149 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    150                DO ji = 1, jpi 
    151                   DO jj = 1, jpj 
    152                      zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,1) 
    153                   END DO 
    154                END DO 
     124               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
    155125            END IF 
    156126!!gm 
    … …  
    158128!!gm 
    159129         END IF 
    160          ! 
    161          zarho = SUM( area(:,:) * zbotpres(:,:) ) 
    162130         !                                          
     131         zarho = SUM( area(:,:) * zbotpres(:,:) )  
    163132         IF( lk_mpp )   CALL mpp_sum( zarho ) 
    164133         zssh_steric = - zarho / area_tot 
    … …  
    167136         !                                         ! steric sea surface height 
    168137         CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density 
    169 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    170          DO jj = 1, jpj 
    171             DO ji = 1, jpi 
    172                zrhop(ji,jj,jpk) = 0._wp 
    173             END DO 
    174          END DO 
     138         zrhop(:,:,jpk) = 0._wp 
    175139         CALL iom_put( 'rhop', zrhop ) 
    176140         ! 
    177 !$OMP PARALLEL 
    178 !$OMP DO schedule(static) private(jj, ji) 
    179          DO jj = 1, jpj 
    180             DO ji = 1, jpi 
    181                zbotpres(ji,jj) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    182             END DO 
    183          END DO 
     141         zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
    184142         DO jk = 1, jpkm1 
    185 !$OMP DO schedule(static) private(jj, ji) 
    186             DO jj = 1, jpj 
    187                DO ji = 1, jpi 
    188                   zbotpres(ji,jj) = zbotpres(ji,jj) + e3t_n(ji,jj,jk) * zrhd(ji,jj,jk) 
    189                END DO 
    190             END DO 
     143            zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
    191144         END DO 
    192145         IF( ln_linssh ) THEN 
    193146            IF ( ln_isfcav ) THEN 
    194 !$OMP DO schedule(static) private(jj, ji) 
    195147               DO ji = 1,jpi 
    196148                  DO jj = 1,jpj 
    … …  
    199151               END DO 
    200152            ELSE 
    201 !$OMP DO schedule(static) private(jj, ji) 
    202                DO jj = 1, jpj 
    203                   DO ji = 1, jpi 
    204                      zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,1) 
    205                   END DO 
    206                END DO 
     153               zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
    207154            END IF 
    208155         END IF 
    209 !$OMP END PARALLEL 
    210156         !     
    211          zarho = SUM( area(:,:) * zbotpres(:,:) ) 
     157         zarho = SUM( area(:,:) * zbotpres(:,:) )  
    212158         IF( lk_mpp )   CALL mpp_sum( zarho ) 
    213159         zssh_steric = - zarho / area_tot 
    … …  
    216162         !                                         ! ocean bottom pressure 
    217163         zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
    218 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    219          DO jj = 1, jpj 
    220             DO ji = 1, jpi 
    221                zbotpres(ji,jj) = zztmp * ( zbotpres(ji,jj) + sshn(ji,jj) + thick0(ji,jj) ) 
    222             END DO 
    223          END DO 
     164         zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
    224165         CALL iom_put( 'botpres', zbotpres ) 
    225166         ! 
    … …  
    272213      ! work is not being done against stratification 
    273214          CALL wrk_alloc( jpi, jpj, zpe ) 
    274 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    275           DO jj = 1, jpj 
    276              DO ji = 1, jpi 
    277                 zpe(ji,jj) = 0._wp 
    278              END DO 
    279           END DO 
     215          zpe(:,:) = 0._wp 
    280216          IF( lk_zdfddm ) THEN 
    281 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk,zrw,zaw,zbw) 
    282217             DO ji=1,jpi 
    283218                DO jj=1,jpj 
    … …  
    297232             ENDDO 
    298233          ELSE 
    299 !$OMP PARALLEL DO schedule(static) private(ji,jj,jk) 
    300234             DO ji = 1, jpi 
    301235                DO jj = 1, jpj 
    … …  
    389323      INTEGER  ::   ik 
    390324      INTEGER  ::   ji, jj, jk  ! dummy loop indices 
    391       REAL(wp) ::   zztmp, zsum  
     325      REAL(wp) ::   zztmp   
    392326      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity 
    393327      ! 
    … …  
    407341         IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    408342 
    409 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    410          DO jj = 1, jpj 
    411             DO ji = 1, jpi 
    412                area(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) 
    413             END DO 
    414          END DO 
     343         area(:,:) = e1e2t(:,:) * tmask_i(:,:) 
    415344 
    416345         area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot ) 
    417346 
    418347         vol0        = 0._wp 
    419 !$OMP PARALLEL 
    420 !$OMP DO schedule(static) private(jj, ji) 
    421          DO jj = 1, jpj 
    422             DO ji = 1, jpi 
    423                thick0(ji,jj) = 0._wp 
    424             END DO 
    425          END DO 
     348         thick0(:,:) = 0._wp 
    426349         DO jk = 1, jpkm1 
    427 !$OMP DO schedule(static) private(jj, ji, zsum) 
    428             DO jj = 1, jpj 
    429                DO ji = 1, jpi 
    430                   zsum = area (ji,jj) * tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    431                END DO 
    432             END DO 
    433             vol0        = vol0        + zsum 
    434 !$OMP DO schedule(static) private(jj, ji) 
    435             DO jj = 1, jpj 
    436                DO ji = 1, jpi 
    437                   thick0(ji,jj) = thick0(ji,jj) + tmask_i(ji,jj) * tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
    438                END DO 
    439             END DO 
    440          END DO 
    441 !$OMP END PARALLEL 
     350            vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 
     351            thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 
     352         END DO 
    442353         IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    443354 
    … …  
    447358         CALL iom_close( inum ) 
    448359 
    449 !$OMP PARALLEL 
    450 !$OMP DO schedule(static) private(jk, jj, ji) 
    451          DO jk = 1, jpk 
    452             DO jj = 1, jpj 
    453                DO ji = 1, jpi 
    454                   sn0(ji,jj,jk) = 0.5_wp * ( zsaldta(ji,jj,jk,1) + zsaldta(ji,jj,jk,2) )         
    455                   sn0(ji,jj,jk) = sn0(ji,jj,jk) * tmask(ji,jj,jk) 
    456                END DO 
    457             END DO 
    458          END DO 
     360         sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
     361         sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
    459362         IF( ln_zps ) THEN               ! z-coord. partial steps 
    460 !$OMP DO schedule(static) private(jj, ji, ik, zztmp) 
    461363            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    462364               DO ji = 1, jpi 
    … …  
    469371            END DO 
    470372         ENDIF 
    471 !$OMP END PARALLEL 
    472373         ! 
    473374         CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90

    r7698 r7753  
    7171 
    7272             ! calculate Courant numbers 
    73 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    7473         DO jk = 1, jpk 
    7574            DO jj = 1, jpj 
    … …  
    173172      !!---------------------------------------------------------------------- 
    174173 
    175       INTEGER  :: ji, jj, jk                                ! dummy loop indices 
    176174 
    177175      IF( nn_diacfl == 1 ) THEN 
    … …  
    183181 
    184182         ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 
    185 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    186          DO jk = 1, jpk 
    187             DO jj = 1, jpj 
    188                DO ji = 1, jpi 
    189                   zcu_cfl(ji,jj,jk)=0.0 
    190                   zcv_cfl(ji,jj,jk)=0.0 
    191                   zcw_cfl(ji,jj,jk)=0.0 
    192                END DO 
    193             END DO 
    194          END DO 
     183 
     184         zcu_cfl(:,:,:)=0.0 
     185         zcv_cfl(:,:,:)=0.0 
     186         zcw_cfl(:,:,:)=0.0 
     187 
    195188         IF( lwp ) THEN 
    196189            WRITE(numout,*) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r7698 r7753  
    8888      CALL wrk_alloc( jpi,jpj,   z2d0, z2d1 ) 
    8989      ! 
    90 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    91       DO jk = 1, jpk 
    92          DO jj = 1, jpj 
    93             DO ji = 1, jpi 
    94                tsn(ji,jj,jk,1) = tsn(ji,jj,jk,1) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,1) = tsb(ji,jj,jk,1) * tmask(ji,jj,jk)  
    95                tsn(ji,jj,jk,2) = tsn(ji,jj,jk,2) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,2) = tsb(ji,jj,jk,2) * tmask(ji,jj,jk) 
    96             END DO 
    97          END DO 
    98       END DO 
     90      tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 
     91      tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; 
    9992      ! ------------------------- ! 
    10093      ! 1 - Trends due to forcing ! 
    … …  
    115108      IF( ln_linssh ) THEN 
    116109         IF( ln_isfcav ) THEN 
    117 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    118110            DO ji=1,jpi 
    119111               DO jj=1,jpj 
    … …  
    123115            END DO 
    124116         ELSE 
    125 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    126             DO ji=1,jpi 
    127                DO jj=1,jpj 
    128                   z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_tem) 
    129                   z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_sal) 
    130                END DO 
    131             END DO 
     117            z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 
     118            z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) 
    132119         END IF 
    133120         z_wn_trd_t = - glob_sum( z2d0 )  
    … …  
    158145      IF( ln_linssh ) THEN 
    159146         IF( ln_isfcav ) THEN 
    160 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    161147            DO ji = 1, jpi 
    162148               DO jj = 1, jpj 
    … …  
    166152            END DO 
    167153         ELSE 
    168 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    169             DO jj = 1, jpj 
    170                DO ji = 1, jpi 
    171                   z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) )  
    172                   z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) )  
    173                END DO 
    174             END DO 
     154            z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) )  
     155            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )  
    175156         END IF 
    176157         z_ssh_hc = glob_sum_full( z2d0 )  
    … …  
    294275          IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 
    295276          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    296 !$OMP PARALLEL 
    297 !$OMP DO schedule(static) private(jj,ji) 
    298           DO jj = 1, jpj 
    299              DO ji = 1, jpi 
    300                 surf_ini(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj)         ! initial ocean surface 
    301                 ssh_ini(ji,jj) = sshn(ji,jj)                          ! initial ssh 
    302              END DO 
     277          surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
     278          ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
     279          DO jk = 1, jpk 
     280             ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
     281             e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
     282             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
     283             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
    303284          END DO 
    304 !$OMP DO schedule(static) private(jk,jj,ji) 
    305           DO jk = 1, jpk 
    306              DO jj = 1, jpj 
    307                 DO ji = 1, jpi 
    308                    ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
    309                    e3t_ini   (ji,jj,jk) = e3t_n(ji,jj,jk)                      * tmask(ji,jj,jk)  ! initial vertical scale factors 
    310                    hc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! initial heat content 
    311                    sc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! initial salt content 
    312                 END DO 
    313              END DO 
    314           END DO 
    315 !$OMP END PARALLEL 
    316285          frc_v = 0._wp                                           ! volume       trend due to forcing 
    317286          frc_t = 0._wp                                           ! heat content   -    -   -    -    
    … …  
    319288          IF( ln_linssh ) THEN 
    320289             IF ( ln_isfcav ) THEN 
    321 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    322290                DO ji=1,jpi 
    323291                   DO jj=1,jpj 
    … …  
    327295                ENDDO 
    328296             ELSE 
    329 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    330                 DO jj = 1, jpj 
    331                    DO ji = 1, jpi 
    332                       ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_tem) * sshn(ji,jj)   ! initial heat content in ssh 
    333                       ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_sal) * sshn(ji,jj)   ! initial salt content in ssh 
    334                    ENDDO 
    335                 ENDDO 
     297                ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
     298                ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
    336299             END IF 
    337300             frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface 
    … …  
    382345      INTEGER ::   ierror   ! local integer 
    383346      INTEGER ::   ios 
    384       INTEGER ::   ji, jj, jk   ! dummy loop indices 
    385347      !! 
    386348      NAMELIST/namhsb/ ln_diahsb 
    … …  
    422384      ! 2 - Time independant variables and file opening ! 
    423385      ! ----------------------------------------------- ! 
    424 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    425       DO jj = 1, jpj 
    426          DO ji = 1, jpi 
    427             surf(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! masked surface grid cell area 
    428          END DO 
    429       END DO 
     386      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)      ! masked surface grid cell area 
    430387      surf_tot  = glob_sum( surf(:,:) )                   ! total ocean surface area 
    431388 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r7698 r7753  
    6666   !!---------------------------------------------------------------------- 
    6767   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    68    !! $Id$ 
     68   !! $Id$  
    6969   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7070   !!---------------------------------------------------------------------- 
    … …  
    384384      !! ** Purpose :   Initialization, namelist read 
    385385      !!---------------------------------------------------------------------- 
    386       INTEGER ::  jn, jj, ji   ! local integers 
     386      INTEGER ::  jn           ! local integers 
    387387      INTEGER ::  inum, ierr   ! local integers 
    388388      INTEGER ::  ios          ! Local integer output status for namelist read 
    … …  
    434434            CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin 
    435435            CALL iom_close( inum ) 
    436 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    437             DO jj = 1, jpj 
    438                DO ji = 1, jpi 
    439                   btmsk(ji,jj,5) = MAX ( btmsk(ji,jj,3), btmsk(ji,jj,4) )          ! Indo-Pacific basin 
    440                   IF( gphit(ji,jj) < -30._wp) THEN   ;   btm30(ji,jj) = 0._wp      ! mask out Southern Ocean 
    441                   ELSE                               ;   btm30(ji,jj) = ssmask(ji,jj) 
    442                   END IF 
    443                END DO 
    444             END DO 
     436            btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin 
     437            WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean 
     438            ELSE WHERE                     ;   btm30(:,:) = ssmask(:,:) 
     439            END WHERE 
    445440         ENDIF 
    446441    
    447 !$OMP PARALLEL 
    448 !$OMP DO schedule(static) private(jj,ji) 
    449          DO jj = 1, jpj 
    450            DO ji = 1, jpi 
    451               btmsk(ji,jj,1) = tmask_i(ji,jj)                          ! global ocean 
    452            END DO 
    453          END DO 
     442         btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean 
    454443       
    455444         DO jn = 1, nptr 
    456 !$OMP DO schedule(static) private(jj,ji) 
    457             DO jj = 1, jpj 
    458                DO ji = 1, jpi 
    459                   btmsk(ji,jj,jn) = btmsk(ji,jj,jn) * tmask_i(ji,jj)               ! interior domain only 
    460                END DO 
    461             END DO 
     445            btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only 
    462446         END DO 
    463447 
    464448         ! Initialise arrays to zero because diatpr is called before they are first calculated 
    465449         ! Note that this means diagnostics will not be exactly correct when model run is restarted. 
    466 !$OMP DO schedule(static) private(jj,ji) 
    467          DO jj = 1, jpj 
    468             DO ji = 1, jpi 
    469                htr_adv(ji,jj) = 0._wp  ;  str_adv(ji,jj) =  0._wp  
    470                htr_ldf(ji,jj) = 0._wp  ;  str_ldf(ji,jj) =  0._wp  
    471                htr_eiv(ji,jj) = 0._wp  ;  str_eiv(ji,jj) =  0._wp  
    472                htr_ove(ji,jj) = 0._wp  ;   str_ove(ji,jj) =  0._wp 
    473                htr_btr(ji,jj) = 0._wp  ;   str_btr(ji,jj) =  0._wp 
    474              END DO 
    475          END DO 
    476               ! 
    477 !$OMP END PARALLEL 
     450         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp  
     451         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp  
     452         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp  
     453         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp 
     454         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp 
     455         ! 
    478456      ENDIF  
    479457      !  

  • trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7698 r7753  
    161161      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
    162162      IF ( iom_use("sbt") ) THEN 
    163 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    164163         DO jj = 1, jpj 
    165164            DO ji = 1, jpi 
    … …  
    174173      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
    175174      IF ( iom_use("sbs") ) THEN 
    176 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    177175         DO jj = 1, jpj 
    178176            DO ji = 1, jpi 
    … …  
    185183 
    186184      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    187 !$OMP PARALLEL 
    188 !$OMP DO schedule(static) private(jj, ji) 
    189          DO jj = 1, jpj 
    190             DO ji = 1, jpi 
    191                z2d(ji,jj) = 0._wp 
    192             END DO 
    193          END DO 
    194 !$OMP DO schedule(static) private(jj, ji, zztmpx,zztmpy) 
     185         z2d(:,:) = 0._wp 
    195186         DO jj = 2, jpjm1 
    196187            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    203194            ENDDO 
    204195         ENDDO 
    205 !$OMP END PARALLEL 
    206196         CALL lbc_lnk( z2d, 'T', 1. ) 
    207197         CALL iom_put( "taubot", z2d )            
    … …  
    211201      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current 
    212202      IF ( iom_use("sbu") ) THEN 
    213 !$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    214203         DO jj = 1, jpj 
    215204            DO ji = 1, jpi 
    … …  
    224213      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current 
    225214      IF ( iom_use("sbv") ) THEN 
    226 !$OMP PARALLEL DO schedule(static) private(jj, ji,jkbot) 
    227215         DO jj = 1, jpj 
    228216            DO ji = 1, jpi 
    … …  
    237225      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    238226         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    239 !$OMP PARALLEL 
    240 !$OMP DO schedule(static) private(jj, ji) 
    241          DO jj = 1, jpj 
    242             DO ji = 1, jpi 
    243                z2d(ji,jj) = rau0 * e1e2t(ji,jj) 
    244             END DO 
    245          END DO 
    246 !$OMP DO schedule(static) private(jk,jj,ji) 
     227         z2d(:,:) = rau0 * e1e2t(:,:) 
    247228         DO jk = 1, jpk 
    248             DO jj = 1, jpj 
    249                DO ji = 1, jpi 
    250                   z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj) 
    251                END DO 
    252             END DO 
    253          END DO 
    254 !$OMP END PARALLEL 
     229            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     230         END DO 
    255231         CALL iom_put( "w_masstr" , z3d )   
    256232         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
    … …  
    265241 
    266242      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
    267 !$OMP PARALLEL DO schedule(static) private(jj, ji, zztmp, zztmpx, zztmpy) 
    268243         DO jj = 2, jpjm1                                    ! sst gradient 
    269244            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    277252         CALL lbc_lnk( z2d, 'T', 1. ) 
    278253         CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
    279 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    280          DO jj = 1, jpj 
    281             DO ji = 1, jpi 
    282                z2d(ji,jj) = SQRT( z2d(ji,jj) ) 
    283             END DO 
    284          END DO 
     254         z2d(:,:) = SQRT( z2d(:,:) ) 
    285255         CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    286256      ENDIF 
    … …  
    288258      ! clem: heat and salt content 
    289259      IF( iom_use("heatc") ) THEN 
    290 !$OMP PARALLEL 
    291 !$OMP DO schedule(static) private(jj, ji) 
    292          DO jj = 1, jpj 
    293             DO ji = 1, jpi 
    294                z2d(ji,jj) = 0._wp 
    295             END DO 
    296          END DO 
     260         z2d(:,:)  = 0._wp  
    297261         DO jk = 1, jpkm1 
    298 !$OMP DO schedule(static) private(jj, ji) 
    299262            DO jj = 1, jpj 
    300263               DO ji = 1, jpi 
    … …  
    303266            END DO 
    304267         END DO 
    305 !$OMP END PARALLEL 
    306268         CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2) 
    307269      ENDIF 
    308270 
    309271      IF( iom_use("saltc") ) THEN 
    310 !$OMP PARALLEL 
    311 !$OMP DO schedule(static) private(jj, ji) 
    312          DO jj = 1, jpj 
    313             DO ji = 1, jpi 
    314                z2d(ji,jj) = 0._wp 
    315             END DO 
    316          END DO 
     272         z2d(:,:)  = 0._wp  
    317273         DO jk = 1, jpkm1 
    318 !$OMP DO schedule(static) private(jj, ji) 
    319274            DO jj = 1, jpj 
    320275               DO ji = 1, jpi 
    … …  
    323278            END DO 
    324279         END DO 
    325 !$OMP END PARALLEL 
    326280         CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2) 
    327281      ENDIF 
    328282      ! 
    329283      IF ( iom_use("eken") ) THEN 
    330 !$OMP PARALLEL 
    331 !$OMP DO schedule(static) private(jj, ji) 
    332          DO jj = 1, jpj 
    333             DO ji = 1, jpi 
    334                rke(ji,jj,jk) = 0._wp                               !      kinetic energy  
    335             END DO 
    336          END DO 
    337 !$OMP DO schedule(static) private(jk, jj, ji, zztmp, zztmpx, zztmpy) 
     284         rke(:,:,jk) = 0._wp                               !      kinetic energy  
    338285         DO jk = 1, jpkm1 
    339286            DO jj = 2, jpjm1 
    … …  
    353300            ENDDO 
    354301         ENDDO 
    355 !$OMP END PARALLEL 
    356302         CALL lbc_lnk( rke, 'T', 1. ) 
    357303         CALL iom_put( "eken", rke )            
    … …  
    361307      ! 
    362308      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    363 !$OMP PARALLEL 
    364 !$OMP DO schedule(static) private(jj, ji) 
    365          DO jj = 1, jpj 
    366             DO ji = 1, jpi 
    367                z3d(ji,jj,jpk) = 0.e0 
    368                z2d(ji,jj) = 0.e0 
    369             END DO 
    370          END DO 
     309         z3d(:,:,jpk) = 0.e0 
     310         z2d(:,:) = 0.e0 
    371311         DO jk = 1, jpkm1 
    372 !$OMP DO schedule(static) private(jj, ji) 
    373             DO jj = 1, jpj 
    374                DO ji = 1, jpi 
    375                   z3d(ji,jj,jk) = rau0 * un(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
    376                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) 
    377                END DO 
    378             END DO 
    379          END DO 
    380 !$OMP END PARALLEL 
     312            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
     313            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
     314         END DO 
    381315         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
    382316         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum 
    … …  
    384318       
    385319      IF( iom_use("u_heattr") ) THEN 
    386 !$OMP PARALLEL 
    387 !$OMP DO schedule(static) private(jj, ji) 
    388          DO jj = 1, jpj 
    389             DO ji = 1, jpi 
    390                z2d(ji,jj) = 0.e0 
    391             END DO 
    392          END DO 
     320         z2d(:,:) = 0.e0  
    393321         DO jk = 1, jpkm1 
    394 !$OMP DO schedule(static) private(jj, ji) 
    395322            DO jj = 2, jpjm1 
    396323               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    399326            END DO 
    400327         END DO 
    401 !$OMP END PARALLEL 
    402328         CALL lbc_lnk( z2d, 'U', -1. ) 
    403329         CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction 
    … …  
    405331 
    406332      IF( iom_use("u_salttr") ) THEN 
    407 !$OMP PARALLEL 
    408 !$OMP DO schedule(static) private(jj, ji) 
    409          DO jj = 1, jpj 
    410             DO ji = 1, jpi 
    411                z2d(ji,jj) = 0.e0 
    412             END DO 
    413          END DO 
     333         z2d(:,:) = 0.e0  
    414334         DO jk = 1, jpkm1 
    415 !$OMP DO schedule(static) private(jj, ji) 
    416335            DO jj = 2, jpjm1 
    417336               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    420339            END DO 
    421340         END DO 
    422 !$OMP END PARALLEL 
    423341         CALL lbc_lnk( z2d, 'U', -1. ) 
    424342         CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction 
    … …  
    427345       
    428346      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
    429 !$OMP PARALLEL 
    430 !$OMP DO schedule(static) private(jj, ji) 
    431          DO jj = 1, jpj 
    432             DO ji = 1, jpi 
    433                z3d(ji,jj,jpk) = 0.e0 
    434             END DO 
    435          END DO 
    436 !$OMP DO schedule(static) private(jk,jj,ji) 
     347         z3d(:,:,jpk) = 0.e0 
    437348         DO jk = 1, jpkm1 
    438             DO jj = 1, jpj 
    439                DO ji = 1, jpi 
    440                   z3d(ji,jj,jk) = rau0 * vn(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
    441                END DO 
    442             END DO 
    443          END DO 
    444 !$OMP END PARALLEL 
     349            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
     350         END DO 
    445351         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
    446352      ENDIF 
    447353       
    448354      IF( iom_use("v_heattr") ) THEN 
    449 !$OMP PARALLEL 
    450 !$OMP DO schedule(static) private(jj, ji) 
    451          DO jj = 1, jpj 
    452             DO ji = 1, jpi 
    453                z2d(ji,jj) = 0.e0 
    454             END DO 
    455          END DO 
     355         z2d(:,:) = 0.e0  
    456356         DO jk = 1, jpkm1 
    457 !$OMP DO schedule(static) private(jj, ji) 
    458357            DO jj = 2, jpjm1 
    459358               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    462361            END DO 
    463362         END DO 
    464 !$OMP END PARALLEL 
    465363         CALL lbc_lnk( z2d, 'V', -1. ) 
    466364         CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction 
    … …  
    468366 
    469367      IF( iom_use("v_salttr") ) THEN 
    470 !$OMP PARALLEL 
    471 !$OMP DO schedule(static) private(jj, ji) 
    472          DO jj = 1, jpj 
    473             DO ji = 1, jpi 
    474                z2d(ji,jj) = 0.e0 
    475             END DO 
    476          END DO 
     368         z2d(:,:) = 0.e0  
    477369         DO jk = 1, jpkm1 
    478 !$OMP DO schedule(static) private(jj, ji) 
    479370            DO jj = 2, jpjm1 
    480371               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    483374            END DO 
    484375         END DO 
    485 !$OMP END PARALLEL 
    486376         CALL lbc_lnk( z2d, 'V', -1. ) 
    487377         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
    … …  
    490380      ! Vertical integral of temperature 
    491381      IF( iom_use("tosmint") ) THEN 
    492 !$OMP PARALLEL 
    493 !$OMP DO schedule(static) private(jj, ji) 
    494          DO jj = 1, jpj 
    495             DO ji = 1, jpi 
    496                z2d(ji,jj) = 0.e0 
    497             END DO 
    498          END DO 
     382         z2d(:,:)=0._wp 
    499383         DO jk = 1, jpkm1 
    500 !$OMP DO schedule(static) private(jj, ji) 
    501384            DO jj = 2, jpjm1 
    502385               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    505388            END DO 
    506389         END DO 
    507 !$OMP END PARALLEL 
    508390         CALL lbc_lnk( z2d, 'T', -1. ) 
    509391         CALL iom_put( "tosmint", z2d )  
    … …  
    512394      ! Vertical integral of salinity 
    513395      IF( iom_use("somint") ) THEN 
    514 !$OMP PARALLEL 
    515 !$OMP DO schedule(static) private(jj, ji) 
    516          DO jj = 1, jpj 
    517             DO ji = 1, jpi 
    518                z2d(ji,jj) = 0.e0 
    519             END DO 
    520          END DO 
     396         z2d(:,:)=0._wp 
    521397         DO jk = 1, jpkm1 
    522 !$OMP DO schedule(static) private(jj, ji) 
    523398            DO jj = 2, jpjm1 
    524399               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    527402            END DO 
    528403         END DO 
    529 !$OMP END PARALLEL 
    530404         CALL lbc_lnk( z2d, 'T', -1. ) 
    531405         CALL iom_put( "somint", z2d )  
    … …  
    918792      ENDIF 
    919793      IF( .NOT.ln_linssh ) THEN 
    920 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    921          DO jk = 1, jpk 
    922             DO jj = 1, jpj 
    923                DO ji = 1, jpi 
    924                   zw3d(ji,jj,jk) = ( ( e3t_n(ji,jj,jk) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100 * tmask(ji,jj,jk) ) ** 2 
    925                END DO 
    926             END DO 
    927          END DO 
     794         zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
    928795         CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness 
    929796         CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth 
    … …  
    937804                                                                                  ! in linear free surface case) 
    938805      IF( ln_linssh ) THEN 
    939 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    940          DO jj = 1, jpj 
    941             DO ji = 1, jpi 
    942                zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_tem) 
    943             END DO 
    944          END DO 
     806         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 
    945807         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst 
    946 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    947          DO jj = 1, jpj 
    948             DO ji = 1, jpi 
    949                zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_sal) 
    950             END DO 
    951          END DO 
     808         zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 
    952809         CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss 
    953810      ENDIF 
    … …  
    985842         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    986843         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    987          IF( ln_ssr ) THEN 
    988 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    989             DO jj = 1, jpj 
    990                DO ji = 1, jpi 
    991                   zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 
    992                END DO 
    993             END DO 
    994          END IF 
     844         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    995845         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    996846      ENDIF 
    … …  
    998848         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    999849         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    1000          IF( ln_ssr ) THEN 
    1001 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    1002             DO jj = 1, jpj 
    1003                DO ji = 1, jpi 
    1004                   zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 
    1005                END DO 
    1006             END DO 
    1007          END IF 
     850         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    1008851         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    1009852      ENDIF 

  • 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') 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r7698 r7753  
    7272      ENDIF 
    7373      ! 
    74 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    7574      DO jk = 1, jpkm1                                      !==  Horizontal divergence  ==! 
    7675         DO jj = 2, jpjm1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r7698 r7753  
    4747      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    4848      !!  
    49       INTEGER  ::   jk, ji, jj       ! dummy loop indexes 
     49      INTEGER  ::   ji, jj       ! dummy loop indexes 
    5050      INTEGER  ::   ikbu, ikbv   ! local integers 
    5151      REAL(wp) ::   zm1_2dt      ! local scalar 
    … …  
    6565        IF( l_trddyn ) THEN      ! trends: store the input trends 
    6666           CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    67 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    68            DO jk = 1, jpk 
    69               DO jj = 1, jpj 
    70                  DO ji = 1, jpi 
    71                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    72                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    73                  END DO 
    74               END DO 
    75            END DO 
     67           ztrdu(:,:,:) = ua(:,:,:) 
     68           ztrdv(:,:,:) = va(:,:,:) 
    7669        ENDIF 
    7770 
    7871 
    79 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    8072        DO jj = 2, jpjm1 
    8173           DO ji = 2, jpim1 
    … …  
    9082        ! 
    9183        IF( ln_isfcav ) THEN        ! ocean cavities 
    92 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    9384           DO jj = 2, jpjm1 
    9485              DO ji = 2, jpim1 
    … …  
    10899        ! 
    109100        IF( l_trddyn ) THEN      ! trends: send trends to trddyn for further diagnostics 
    110 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    111            DO jk = 1, jpk 
    112               DO jj = 1, jpj 
    113                  DO ji = 1, jpi 
    114                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    115                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    116                  END DO 
    117               END DO 
    118            END DO 
     101           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     102           ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    119103           CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 
    120104           CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r7698 r7753  
    8484      !!---------------------------------------------------------------------- 
    8585      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    86       INTEGER ::  jk, jj, ji 
    8786      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    8887      !!---------------------------------------------------------------------- 
    … …  
    9291      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
    9392         CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    94 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    95          DO jk = 1, jpk 
    96             DO jj = 1, jpj 
    97                DO ji = 1, jpi 
    98                   ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    99                   ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    100                END DO 
    101             END DO 
    102          END DO 
     93         ztrdu(:,:,:) = ua(:,:,:) 
     94         ztrdv(:,:,:) = va(:,:,:) 
    10395      ENDIF 
    10496      ! 
    … …  
    113105      ! 
    114106      IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 
    115 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    116          DO jk = 1, jpk 
    117             DO jj = 1, jpj 
    118                DO ji = 1, jpi 
    119                   ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    120                   ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    121                END DO 
    122             END DO 
    123          END DO 
     107         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     108         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    124109         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 
    125110         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    … …  
    213198      !  
    214199      ! initialisation of ice shelf load 
    215       IF ( .NOT. ln_isfcav ) THEN 
    216 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    217          DO jj = 1, jpj 
    218             DO ji = 1, jpi 
    219                riceload(ji,jj)=0.0 
    220             END DO 
    221          END DO 
    222       END IF 
     200      IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 
    223201      IF (       ln_isfcav ) THEN 
    224202         CALL wrk_alloc( jpi,jpj, 2,  ztstop)  
    … …  
    234212          
    235213         ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
    236 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    237          DO jj = 1, jpj 
    238             DO ji = 1, jpi 
    239                ztstop(ji,jj,1)=-1.9_wp 
    240                ztstop(ji,jj,2)=34.4_wp 
    241             END DO 
    242          END DO 
     214         ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 
    243215 
    244216         ! compute density of the water displaced by the ice shelf  
    … …  
    254226         ! divided by 2 later 
    255227         ziceload = 0._wp 
    256 !$OMP PARALLEL 
    257 !$OMP DO schedule(static) private(jj,ji,ikt,jk) 
    258228         DO jj = 1, jpj 
    259229            DO ji = 1, jpi 
    … …  
    268238            END DO 
    269239         END DO 
    270 !$OMP DO schedule(static) private(jj, ji) 
    271          DO jj = 1, jpj 
    272             DO ji = 1, jpi 
    273                riceload(ji,jj)=ziceload(ji,jj)  ! need to be saved for diaar5 
    274             END DO 
    275          END DO 
    276 !$OMP END PARALLEL 
     240         riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5 
    277241 
    278242         CALL wrk_dealloc( jpi,jpj, 2,  ztstop)  
    … …  
    318282 
    319283      ! Surface value 
    320 !$OMP PARALLEL 
    321 !$OMP DO schedule(static) private(ji,jj, zcoef1) 
    322284      DO jj = 2, jpjm1 
    323285         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    335297      ! interior value (2=<jk=<jpkm1) 
    336298      DO jk = 2, jpkm1 
    337 !$OMP DO schedule(static) private(ji,jj, zcoef1) 
    338299         DO jj = 2, jpjm1 
    339300            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    352313            END DO 
    353314         END DO 
    354 !$OMP END DO NOWAIT 
    355       END DO 
    356 !$OMP END PARALLEL 
     315      END DO 
    357316      ! 
    358317      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    … …  
    392351 
    393352      !  Surface value (also valid in partial step case) 
    394 !$OMP PARALLEL 
    395 !$OMP DO schedule(static) private(ji,jj,zcoef1) 
    396353      DO jj = 2, jpjm1 
    397354         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    408365      ! interior value (2=<jk=<jpkm1) 
    409366      DO jk = 2, jpkm1 
    410 !$OMP DO schedule(static) private(ji,jj, zcoef1) 
    411367         DO jj = 2, jpjm1 
    412368            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    428384 
    429385      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90) 
    430 !$OMP DO schedule(static) private(ji,jj,iku,ikv,zcoef2,zcoef3) 
    431386      DO jj = 2, jpjm1 
    432387         DO ji = 2, jpim1 
    … …  
    449404         END DO 
    450405      END DO 
    451 !$OMP END PARALLEL 
    452406      ! 
    453407      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r7698 r7753  
    9696      IF( l_trddyn ) THEN           ! Save ua and va trends 
    9797         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    98 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    99          DO jk = 1, jpk 
    100             DO jj = 1, jpj 
    101                DO ji = 1, jpi 
    102                   ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    103                   ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    104                END DO 
    105             END DO 
    106          END DO 
     98         ztrdu(:,:,:) = ua(:,:,:)  
     99         ztrdv(:,:,:) = va(:,:,:)  
    107100      ENDIF 
    108 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    109       DO jj = 1, jpj 
    110          DO ji = 1, jpi 
    111             zhke(ji,jj,jpk) = 0._wp 
    112          END DO 
    113       END DO 
     101       
     102      zhke(:,:,jpk) = 0._wp 
    114103       
    115104      IF (ln_bdy) THEN 
    … …  
    144133      ! 
    145134      CASE ( nkeg_C2 )                          !--  Standard scheme  --! 
    146 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 
    147135         DO jk = 1, jpkm1 
    148136            DO jj = 2, jpj 
    … …  
    158146         ! 
    159147      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
    160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 
    161148         DO jk = 1, jpkm1 
    162149            DO jj = 2, jpjm1        
    … …  
    181168      IF (ln_bdy) THEN 
    182169         ! restore velocity masks at points outside boundary 
    183 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    184          DO jk = 1, jpk 
    185             DO jj = 1, jpj 
    186                DO ji = 1, jpi 
    187                   un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk) 
    188                   vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk) 
    189                END DO  
    190             END DO 
    191          END DO 
    192       ENDIF 
    193  
    194       ! 
    195 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     170         un(:,:,:) = un(:,:,:) * umask(:,:,:) 
     171         vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 
     172      ENDIF       
     173 
     174 
     175      ! 
    196176      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
    197177         DO jj = 2, jpjm1 
    … …  
    204184      ! 
    205185      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
    206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    207            DO jk = 1, jpk 
    208               DO jj = 1, jpj 
    209                  DO ji = 1, jpi 
    210                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    211                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    212                  END DO 
    213               END DO 
    214            END DO 
     186         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     187         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    215188         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    216189         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r7698 r7753  
    6161      !!---------------------------------------------------------------------- 
    6262      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    63       INTEGER ::   jk, jj, ji 
    6463      ! 
    6564      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    … …  
    7069      IF( l_trddyn )   THEN                      ! temporary save of momentum trends 
    7170         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    72 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    73          DO jk = 1, jpk 
    74             DO jj = 1, jpj 
    75                DO ji = 1, jpi 
    76                   ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    77                   ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    78                END DO 
    79             END DO 
    80          END DO 
     71         ztrdu(:,:,:) = ua(:,:,:)  
     72         ztrdv(:,:,:) = va(:,:,:)  
    8173      ENDIF 
    8274 
    … …  
    9082 
    9183      IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics 
    92 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    93            DO jk = 1, jpk 
    94               DO jj = 1, jpj 
    95                  DO ji = 1, jpi 
    96                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    97                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    98                  END DO 
    99               END DO 
    100            END DO 
     84         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     85         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    10186         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 
    10287         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90

    r7698 r7753  
    7575      ! 
    7676      !                                                ! =============== 
    77 !$OMP PARALLEL 
    7877      DO jk = 1, jpkm1                                 ! Horizontal slab 
    7978         !                                             ! =============== 
    80 !$OMP DO schedule(static) private(jj, ji) 
    8179         DO jj = 2, jpj 
    8280            DO ji = fs_2, jpi   ! vector opt. 
    … …  
    9593         END DO   
    9694         ! 
    97 !$OMP DO schedule(static) private(jj, ji) 
    9895         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div ) 
    9996            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    109106         !                                             ! =============== 
    110107      END DO                                           !   End of slab 
    111 !$OMP END PARALLEL 
    112108      !                                                ! =============== 
    113109      CALL wrk_dealloc( jpi, jpj, zcur, zdiv )  
    … …  
    132128      !!---------------------------------------------------------------------- 
    133129      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    134       INTEGER                                         ::   jk, jj, ji 
    135130      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields 
    136131      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend 
    … …  
    149144      ENDIF 
    150145      ! 
    151 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    152       DO jk = 1, jpk 
    153          DO jj = 1, jpj 
    154             DO ji = 1, jpi 
    155                zulap(ji,jj,jk) = 0._wp 
    156                zvlap(ji,jj,jk) = 0._wp 
    157             END DO 
    158          END DO 
    159       END DO 
     146      zulap(:,:,:) = 0._wp 
     147      zvlap(:,:,:) = 0._wp 
    160148      ! 
    161149      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r7698 r7753  
    115115         ! Ensure below that barotropic velocities match time splitting estimate 
    116116         ! Compute actual transport and replace it with ts estimate at "after" time step 
    117 !$OMP PARALLEL 
    118 !$OMP DO schedule(static) private(jj, ji) 
    119          DO jj = 1, jpj 
    120             DO ji = 1, jpi 
    121                zue(ji,jj) = e3u_a(ji,jj,1) * ua(ji,jj,1) * umask(ji,jj,1) 
    122                zve(ji,jj) = e3v_a(ji,jj,1) * va(ji,jj,1) * vmask(ji,jj,1) 
    123             END DO 
     117         zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
     118         zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
     119         DO jk = 2, jpkm1 
     120            zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     121            zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
    124122         END DO 
    125          DO jk = 2, jpkm1 
    126 !$OMP DO schedule(static) private(jj,ji) 
    127             DO jj = 1, jpj 
    128                DO ji = 1, jpi 
    129                   zue(ji,jj) = zue(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    130                   zve(ji,jj) = zve(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
    131                END DO 
    132             END DO 
     123         DO jk = 1, jpkm1 
     124            ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
     125            va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
    133126         END DO 
    134 !$OMP DO schedule(static) private(jk,jj,ji) 
    135          DO jk = 1, jpkm1 
    136             DO jj = 1, jpj 
    137                DO ji = 1, jpi 
    138                   ua(ji,jj,jk) = ( ua(ji,jj,jk) - zue(ji,jj) * r1_hu_a(ji,jj) + ua_b(ji,jj) ) * umask(ji,jj,jk) 
    139                   va(ji,jj,jk) = ( va(ji,jj,jk) - zve(ji,jj) * r1_hv_a(ji,jj) + va_b(ji,jj) ) * vmask(ji,jj,jk) 
    140                END DO 
    141             END DO 
    142          END DO 
    143 !$OMP END PARALLEL 
    144127         ! 
    145128         IF( .NOT.ln_bt_fw ) THEN 
    … …  
    148131            ! In the forward case, this is done below after asselin filtering    
    149132            ! so that asselin contribution is removed at the same time  
    150 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    151133            DO jk = 1, jpkm1 
    152                DO jj = 1, jpj 
    153                   DO ji = 1, jpi 
    154                      un(ji,jj,jk) = ( un(ji,jj,jk) - un_adv(ji,jj) + un_b(ji,jj) )*umask(ji,jj,jk) 
    155                      vn(ji,jj,jk) = ( vn(ji,jj,jk) - vn_adv(ji,jj) + vn_b(ji,jj) )*vmask(ji,jj,jk) 
    156                   END DO 
    157                END DO 
    158             END DO 
    159  
     134               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 
     135               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
     136            END DO   
    160137         ENDIF 
    161138      ENDIF 
    … …  
    184161         ! 
    185162         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends 
    186 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    187             DO jk = 1, jpk 
    188                DO jj = 1, jpj 
    189                   DO ji = 1, jpi 
    190                      zua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_2dt 
    191                      zva(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_2dt 
    192                   END DO 
    193                END DO 
    194             END DO 
     163            zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 
     164            zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 
    195165            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter 
    196166            CALL iom_put( "vtrd_tot", zva ) 
    197167         ENDIF 
    198168         ! 
    199 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    200          DO jk = 1, jpk 
    201             DO jj = 1, jpj 
    202                DO ji = 1, jpi 
    203                   zua(ji,jj,jk) = un(ji,jj,jk)             ! save the now velocity before the asselin filter 
    204                   zva(ji,jj,jk) = vn(ji,jj,jk)             ! (caution: there will be a shift by 1 timestep in the 
    205                         !                                  !  computation of the asselin filter trends) 
    206                END DO 
    207             END DO 
    208          END DO 
     169         zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter 
     170         zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the 
     171         !                                  !  computation of the asselin filter trends) 
    209172      ENDIF 
    210173 
    … …  
    212175      ! ------------------------------------------ 
    213176      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap 
    214 !$OMP PARALLEL 
    215 !$OMP DO schedule(static) private(jk,jj,ji) 
    216177         DO jk = 1, jpkm1 
    217             DO jj = 1, jpj 
    218                DO ji = 1, jpi 
    219                   un(ji,jj,jk) = ua(ji,jj,jk)                          ! un <-- ua 
    220                   vn(ji,jj,jk) = va(ji,jj,jk) 
    221                END DO 
     178            un(:,:,jk) = ua(:,:,jk)                          ! un <-- ua 
     179            vn(:,:,jk) = va(:,:,jk) 
     180         END DO 
     181         IF(.NOT.ln_linssh ) THEN 
     182            DO jk = 1, jpkm1 
     183               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     184               e3u_b(:,:,jk) = e3u_n(:,:,jk) 
     185               e3v_b(:,:,jk) = e3v_n(:,:,jk) 
    222186            END DO 
    223          END DO 
    224 !$OMP END DO NOWAIT 
    225          IF(.NOT.ln_linssh ) THEN 
    226 !$OMP DO schedule(static) private(jk,jj,ji) 
    227             DO jk = 1, jpkm1 
    228                DO jj = 1, jpj 
    229                   DO ji = 1, jpi 
    230                      e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) 
    231                      e3u_b(ji,jj,jk) = e3u_n(ji,jj,jk) 
    232                      e3v_b(ji,jj,jk) = e3v_n(ji,jj,jk) 
    233                   END DO 
    234                END DO 
    235             END DO 
    236          ENDIF 
    237 !$OMP END PARALLEL 
     187         ENDIF 
    238188      ELSE                                             !* Leap-Frog : Asselin filter and swap 
    239189         !                                ! =============! 
    240190         IF( ln_linssh ) THEN             ! Fixed volume ! 
    241191            !                             ! =============! 
    242 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 
    243192            DO jk = 1, jpkm1                               
    244193               DO jj = 1, jpj 
    … …  
    261210            ! ---------------------------------------------------- 
    262211            IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN    ! No asselin filtering on thicknesses if forward time splitting 
    263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    264                DO jj = 1, jpj 
    265                   DO ji = 1, jpi 
    266                      e3t_b(ji,jj,1:jpkm1) = e3t_n(ji,jj,1:jpkm1) 
    267                   END DO 
    268                END DO 
     212               e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 
    269213            ELSE 
    270 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    271214               DO jk = 1, jpkm1 
    272                   DO jj = 1, jpj 
    273                      DO ji = 1, jpi 
    274                         e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) + atfp * ( e3t_b(ji,jj,jk) - 2._wp * e3t_n(ji,jj,jk) + e3t_a(ji,jj,jk) ) 
    275                      END DO 
    276                   END DO 
     215                  e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
    277216               END DO 
    278217               ! Add volume filter correction: compatibility with tracer advection scheme 
    … …  
    280219               zcoef = atfp * rdt * r1_rau0 
    281220               IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting 
    282 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    283                   DO jj = 1, jpj 
    284                      DO ji = 1, jpi 
    285                         e3t_b(ji,jj,1) = e3t_b(ji,jj,1) - zcoef * ( emp_b(ji,jj) - emp(ji,jj) & 
    286                                  &                      - rnf_b(ji,jj) + rnf(ji,jj) ) * tmask(ji,jj,1) 
    287                      END DO 
    288                   END DO 
     221                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 
     222                                 &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
    289223               ELSE                     ! if ice shelf melting 
    290 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikt) 
    291224                  DO jj = 1, jpj 
    292225                     DO ji = 1, jpi 
    … …  
    304237               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
    305238               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
    306 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 
    307239               DO jk = 1, jpkm1 
    308240                  DO jj = 1, jpj 
    … …  
    325257               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
    326258               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 
    327 !$OMP PARALLEL  
    328 !$OMP DO schedule(static) private(jk, jj, ji, zue3a, zve3a, zue3n, zve3n, zue3b, zve3b, zuf, zvf) 
    329259               DO jk = 1, jpkm1 
    330260                  DO jj = 1, jpj 
    … …  
    347277                  END DO 
    348278               END DO 
    349 !$OMP DO schedule(static) private(jj, ji) 
    350                   DO jj = 1, jpj 
    351                      DO ji = 1, jpi 
    352                         e3u_b(ji,jj,1:jpkm1) = ze3u_f(ji,jj,1:jpkm1)        ! e3u_b <-- filtered scale factor 
    353                         e3v_b(ji,jj,1:jpkm1) = ze3v_f(ji,jj,1:jpkm1) 
    354                      END DO 
    355                   END DO 
    356 !$OMP END PARALLEL 
     279               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor 
     280               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
    357281               ! 
    358282               CALL wrk_dealloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
    … …  
    364288            ! Revert "before" velocities to time split estimate 
    365289            ! Doing it here also means that asselin filter contribution is removed   
    366 !$OMP PARALLEL  
    367 !$OMP DO schedule(static) private(jj, ji) 
    368             DO jj = 1, jpj 
    369                DO ji = 1, jpi 
    370                   zue(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 
    371                   zve(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 
    372                END DO 
     290            zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
     291            zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)     
     292            DO jk = 2, jpkm1 
     293               zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
     294               zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
    373295            END DO 
    374             DO jk = 2, jpkm1 
    375 !$OMP DO schedule(static) private(jj, ji) 
    376                DO jj = 1, jpj 
    377                   DO ji = 1, jpi 
    378                      zue(ji,jj) = zue(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
    379                      zve(ji,jj) = zve(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
    380                   END DO 
    381                END DO 
     296            DO jk = 1, jpkm1 
     297               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 
     298               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk) 
    382299            END DO 
    383 !$OMP DO schedule(static) private(jk,jj,ji) 
    384             DO jk = 1, jpkm1 
    385                DO jj = 1, jpj 
    386                   DO ji = 1, jpi 
    387                      ub(ji,jj,jk) = ub(ji,jj,jk) - (zue(ji,jj) * r1_hu_n(ji,jj) - un_b(ji,jj)) * umask(ji,jj,jk) 
    388                      vb(ji,jj,jk) = vb(ji,jj,jk) - (zve(ji,jj) * r1_hv_n(ji,jj) - vn_b(ji,jj)) * vmask(ji,jj,jk) 
    389                   END DO 
    390                END DO 
    391             END DO 
    392 !$OMP END PARALLEL 
    393300         ENDIF 
    394301         ! 
    … …  
    401308      ! 
    402309      IF(.NOT.ln_linssh ) THEN 
    403 !$OMP PARALLEL  
    404 !$OMP DO schedule(static) private(jj, ji) 
    405          DO jj = 1, jpj 
    406             DO ji = 1, jpi 
    407                hu_b(ji,jj) = e3u_b(ji,jj,1) * umask(ji,jj,1) 
    408                hv_b(ji,jj) = e3v_b(ji,jj,1) * vmask(ji,jj,1) 
    409             END DO 
     310         hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 
     311         hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 
     312         DO jk = 2, jpkm1 
     313            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
     314            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
    410315         END DO 
    411          DO jk = 2, jpkm1 
    412 !$OMP DO schedule(static) private(jj, ji) 
    413             DO jj = 1, jpj 
    414                DO ji = 1, jpi 
    415                   hu_b(ji,jj) = hu_b(ji,jj) + e3u_b(ji,jj,jk) * umask(ji,jj,jk) 
    416                   hv_b(ji,jj) = hv_b(ji,jj) + e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 
    417                END DO 
    418             END DO 
    419          END DO 
    420 !$OMP DO schedule(static) private(jj, ji) 
    421          DO jj = 1, jpj 
    422             DO ji = 1, jpi 
    423                r1_hu_b(ji,jj) = ssumask(ji,jj) / ( hu_b(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    424                r1_hv_b(ji,jj) = ssvmask(ji,jj) / ( hv_b(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    425             END DO 
    426          END DO 
    427 !$OMP END PARALLEL 
    428       ENDIF 
    429       ! 
    430 !$OMP PARALLEL 
    431 !$OMP DO schedule(static) private(jj, ji) 
    432       DO jj = 1, jpj 
    433          DO ji = 1, jpi 
    434             un_b(ji,jj) = e3u_a(ji,jj,1) * un(ji,jj,1) * umask(ji,jj,1) 
    435             ub_b(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 
    436             vn_b(ji,jj) = e3v_a(ji,jj,1) * vn(ji,jj,1) * vmask(ji,jj,1) 
    437             vb_b(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 
    438          END DO 
     316         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 
     317         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
     318      ENDIF 
     319      ! 
     320      un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1) 
     321      ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
     322      vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1) 
     323      vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 
     324      DO jk = 2, jpkm1 
     325         un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 
     326         ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
     327         vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk) 
     328         vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 
    439329      END DO 
    440       DO jk = 2, jpkm1 
    441 !$OMP DO schedule(static) private(jj, ji) 
    442          DO jj = 1, jpj 
    443             DO ji = 1, jpi 
    444                un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
    445                ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
    446                vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
    447                vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
    448             END DO 
    449          END DO 
    450       END DO 
    451 !$OMP DO schedule(static) private(jj, ji) 
    452       DO jj = 1, jpj 
    453          DO ji = 1, jpi 
    454             un_b(ji,jj) = un_b(ji,jj) * r1_hu_a(ji,jj) 
    455             vn_b(ji,jj) = vn_b(ji,jj) * r1_hv_a(ji,jj) 
    456             ub_b(ji,jj) = ub_b(ji,jj) * r1_hu_b(ji,jj) 
    457             vb_b(ji,jj) = vb_b(ji,jj) * r1_hv_b(ji,jj) 
    458          END DO 
    459       END DO 
    460 !$OMP END PARALLEL 
     330      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 
     331      vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 
     332      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
     333      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
    461334      ! 
    462335      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents 
    … …  
    465338      ENDIF 
    466339      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
    467 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    468          DO jk = 1, jpkm1 
    469             DO jj = 1, jpj 
    470                DO ji = 1, jpi 
    471                   zua(ji,jj,jk) = ( ub(ji,jj,jk) - zua(ji,jj,jk) ) * z1_2dt 
    472                   zva(ji,jj,jk) = ( vb(ji,jj,jk) - zva(ji,jj,jk) ) * z1_2dt 
    473                END DO 
    474             END DO 
    475          END DO 
     340         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
     341         zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 
    476342         CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 
    477343      ENDIF 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r7698 r7753  
    8383      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    8484         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
    85 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    86         DO jk = 1, jpk 
    87            DO jj = 1, jpj 
    88               DO ji = 1, jpi 
    89                  ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    90                  ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    91               END DO 
    92            END DO 
    93         END DO 
     85         ztrdu(:,:,:) = ua(:,:,:) 
     86         ztrdv(:,:,:) = va(:,:,:) 
    9487      ENDIF 
    9588      ! 
    … …  
    9891         .OR.  nn_ice_embd == 2  ) THEN                                      ! embedded sea-ice 
    9992         ! 
    100 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    10193         DO jj = 2, jpjm1 
    10294            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    108100         IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==! 
    109101            zg_2 = grav * 0.5 
    110 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    111102            DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh 
    112103               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    124115            CALL upd_tide( kt )                      ! update tide potential 
    125116            ! 
    126 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    127117            DO jj = 2, jpjm1                         ! add tide potential forcing 
    128118               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    138128            zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
    139129            zgrau0r     = - grav * r1_rau0 
    140 !$OMP PARALLEL 
    141 !$OMP DO schedule(static) private(jj, ji) 
    142             DO jj = 1, jpj 
    143                DO ji = 1, jpi 
    144                   zpice(ji,jj) = (  zintp * snwice_mass(ji,jj) + ( 1.- zintp ) * snwice_mass_b(ji,jj)  ) * zgrau0r 
    145                END DO 
    146             END DO 
    147 !$OMP DO schedule(static) private(jj, ji) 
     130            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
    148131            DO jj = 2, jpjm1 
    149132               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    152135               END DO 
    153136            END DO 
    154 !$OMP END PARALLEL 
    155137            ! 
    156138            CALL wrk_dealloc( jpi,jpj,   zpice )          
    157139         ENDIF 
    158140         ! 
    159 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    160141         DO jk = 1, jpkm1                    !== Add all terms to the general trend 
    161142            DO jj = 2, jpjm1 
    … …  
    177158      !                     
    178159      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics 
    179 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    180            DO jk = 1, jpk 
    181               DO jj = 1, jpj 
    182                  DO ji = 1, jpi 
    183                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    184                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    185                  END DO 
    186               END DO 
    187            END DO 
     160         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     161         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    188162         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
    189163         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )  

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r7698 r7753  
    223223            SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
    224224            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    225 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    226225               DO jj = 1, jpjm1 
    227226                  DO ji = 1, jpim1 
    … …  
    232231               END DO 
    233232            CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    234 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    235233               DO jj = 1, jpjm1 
    236234                  DO ji = 1, jpim1 
    … …  
    245243            CALL lbc_lnk( zwz, 'F', 1._wp ) 
    246244            ! 
    247 !$OMP PARALLEL 
    248 !$OMP DO schedule(static) private(jj) 
    249             DO jj = 1, jpj 
    250                ftne(1,jj) = 0._wp ; ftnw(1,jj) = 0._wp ; ftse(1,jj) = 0._wp ; ftsw(1,jj) = 0._wp 
    251             END DO 
    252 !$OMP DO schedule(static) private(jj, ji) 
     245            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
    253246            DO jj = 2, jpj 
    254247               DO ji = 2, jpi 
    … …  
    259252               END DO 
    260253            END DO 
    261 !$OMP END PARALLEL 
    262254            ! 
    263255         ELSE                                !== all other schemes (ENE, ENS, MIX) 
    264 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    265             DO jj = 1, jpj 
    266                DO ji = 1, jpi 
    267                   zwz(ji,jj) = 0._wp 
    268                   zhf(ji,jj) = 0._wp 
    269                END DO 
    270             END DO 
     256            zwz(:,:) = 0._wp 
     257            zhf(:,:) = 0._wp 
    271258             
    272259!!gm  assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed  
    … …  
    288275               ELSE 
    289276                 !zhf(:,:) = hbatf(:,:) 
    290 !$OMP PARALLEL DO schedule(static) private(ji,jj) 
    291277                 DO jj = 1, jpjm1 
    292278                   DO ji = 1, jpim1 
    … …  
    303289              END IF 
    304290   
    305 !$OMP PARALLEL  
    306 !$OMP DO schedule(static) private(ji,jj) 
    307291              DO jj = 1, jpjm1 
    308                  DO ji = 1, jpim1 
    309                     zhf(ji,jj) = zhf(ji,jj) * (1._wp- umask(ji,jj,1) * umask(ji,jj+1,1)) 
    310                  END DO 
     292                 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 
    311293              END DO 
    312294!!gm end 
    313295 
    314296            DO jk = 1, jpkm1 
    315 !$OMP DO schedule(static) private(ji,jj) 
    316297               DO jj = 1, jpjm1 
    317                   DO ji = 1, jpi 
    318                      zhf(ji,jj) = zhf(ji,jj) + e3f_n(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj+1,jk) 
    319                   END DO 
    320                END DO 
    321             END DO 
    322 !$OMP END PARALLEL  
     298                  zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
     299               END DO 
     300            END DO 
    323301            CALL lbc_lnk( zhf, 'F', 1._wp ) 
    324302            ! JC: TBC. hf should be greater than 0  
    325 !$OMP PARALLEL  
    326 !$OMP DO schedule(static) private(jj, ji) 
    327303            DO jj = 1, jpj 
    328304               DO ji = 1, jpi 
    … …  
    330306               END DO 
    331307            END DO 
    332 !$OMP DO schedule(static) private(jj, ji) 
    333             DO jj = 1, jpj 
    334                DO ji = 1, jpi 
    335                   zwz(ji,jj) = ff_f(ji,jj) * zwz(ji,jj) 
    336                END DO 
    337             END DO 
    338 !$OMP END PARALLEL 
     308            zwz(:,:) = ff_f(:,:) * zwz(:,:) 
    339309         ENDIF 
    340310      ENDIF 
    … …  
    354324      !                                   !* e3*d/dt(Ua) (Vertically integrated) 
    355325      !                                   ! -------------------------------------------------- 
    356 !$OMP PARALLEL 
    357 !$OMP DO schedule(static) private(jj, ji) 
    358       DO jj = 1, jpj 
    359          DO ji = 1, jpi 
    360             zu_frc(ji,jj) = 0._wp 
    361             zv_frc(ji,jj) = 0._wp 
    362          END DO 
     326      zu_frc(:,:) = 0._wp 
     327      zv_frc(:,:) = 0._wp 
     328      ! 
     329      DO jk = 1, jpkm1 
     330         zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
     331         zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)          
    363332      END DO 
    364333      ! 
    365       DO jk = 1, jpkm1 
    366 !$OMP DO schedule(static) private(jj,ji) 
    367          DO jj=1,jpj 
    368             DO ji=1,jpi 
    369                zu_frc(ji,jj) = zu_frc(ji,jj) + e3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
    370                zv_frc(ji,jj) = zv_frc(ji,jj) + e3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
    371             END DO 
    372          END DO 
    373       END DO 
    374       ! 
    375 !$OMP DO schedule(static) private(jj, ji) 
    376       DO jj = 1, jpj 
    377          DO ji = 1, jpi 
    378             zu_frc(ji,jj) = zu_frc(ji,jj) * r1_hu_n(ji,jj) 
    379             zv_frc(ji,jj) = zv_frc(ji,jj) * r1_hv_n(ji,jj) 
    380          END DO 
    381       END DO 
     334      zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 
     335      zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 
     336      ! 
    382337      ! 
    383338      !                                   !* baroclinic momentum trend (remove the vertical mean trend) 
    384 !$OMP DO schedule(static) private(jk,jj,ji) 
    385339      DO jk = 1, jpkm1                    ! ----------------------------------------------------------- 
    386340         DO jj = 2, jpjm1 
    … …  
    391345         END DO 
    392346      END DO 
    393 !$OMP END DO NOWAIT 
    394347       
    395348!!gm  Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum.... 
    … …  
    399352      !                                   !* barotropic Coriolis trends (vorticity scheme dependent) 
    400353      !                                   ! -------------------------------------------------------- 
    401 !$OMP DO schedule(static) private(jj, ji) 
    402       DO jj = 1, jpj 
    403          DO ji = 1, jpi 
    404             zwx(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj)        ! now fluxes  
    405             zwy(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 
    406          END DO 
    407       END DO 
    408 !$OMP END PARALLEL 
     354      zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
     355      zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 
    409356      ! 
    410357      IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      ! energy conserving or mixed scheme 
    411 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 
    412358         DO jj = 2, jpjm1 
    413359            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    423369         ! 
    424370      ELSEIF ( ln_dynvor_ens ) THEN                    ! enstrophy conserving scheme 
    425 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zx1) 
    426371         DO jj = 2, jpjm1 
    427372            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    436381         ! 
    437382      ELSEIF ( ln_dynvor_een ) THEN  ! enstrophy and energy conserving scheme 
    438 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    439383         DO jj = 2, jpjm1 
    440384            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    456400      IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient 
    457401        IF( ln_wd ) THEN                        ! Calculating and applying W/D gravity filters 
    458 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 
    459402           DO jj = 2, jpjm1 
    460403              DO ji = 2, jpim1  
    … …  
    497440           END DO 
    498441  
    499 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    500442           DO jj = 2, jpjm1 
    501443              DO ji = 2, jpim1 
    … …  
    509451         ELSE 
    510452 
    511 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    512453           DO jj = 2, jpjm1 
    513454              DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    520461      ENDIF 
    521462 
    522 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    523463      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend 
    524464         DO ji = fs_2, fs_jpim1 
    … …  
    530470      !                 ! Add bottom stress contribution from baroclinic velocities:       
    531471      IF (ln_bt_fw) THEN 
    532 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 
    533472         DO jj = 2, jpjm1                           
    534473            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    540479         END DO 
    541480      ELSE 
    542 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 
    543481         DO jj = 2, jpjm1 
    544482            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    553491      ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 
    554492      IF( ln_wd ) THEN 
    555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    556          DO jj = 1, jpj 
    557             DO ji = 1, jpi   ! vector opt. 
    558                zu_frc(ji,jj) = zu_frc(ji,jj) + MAX(r1_hu_n(ji,jj) * bfrua(ji,jj),-1._wp / rdtbt) * zwx(ji,jj) 
    559                zv_frc(ji,jj) = zv_frc(ji,jj) + MAX(r1_hv_n(ji,jj) * bfrva(ji,jj),-1._wp / rdtbt) * zwy(ji,jj) 
    560             END DO 
    561          END DO 
     493        zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) 
     494        zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) 
    562495      ELSE 
    563 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    564          DO jj = 1, jpj 
    565             DO ji = 1, jpi 
    566                zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * bfrua(ji,jj) * zwx(ji,jj) 
    567                zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * bfrva(ji,jj) * zwy(ji,jj) 
    568             END DO 
    569          END DO 
     496        zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 
     497        zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 
    570498      END IF 
    571499      ! 
    572500      !                                         ! Add top stress contribution from baroclinic velocities:       
    573501      IF( ln_bt_fw ) THEN 
    574 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv) 
    575502         DO jj = 2, jpjm1 
    576503            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    582509         END DO 
    583510      ELSE 
    584 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv) 
    585511         DO jj = 2, jpjm1 
    586512            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    594520      ! 
    595521      ! Note that the "unclipped" top friction parameter is used even with explicit drag 
    596 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    597       DO jj = 1, jpj 
    598          DO ji = 1, jpi 
    599             zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * tfrua(ji,jj) * zwx(ji,jj) 
    600             zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * tfrva(ji,jj) * zwy(ji,jj) 
    601          END DO 
    602       END DO 
     522      zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 
     523      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 
    603524      !        
    604525      IF (ln_bt_fw) THEN                        ! Add wind forcing 
    605 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    606          DO jj = 1, jpj 
    607             DO ji = 1, jpi 
    608                zu_frc(ji,jj) =  zu_frc(ji,jj) + zraur * utau(ji,jj) * r1_hu_n(ji,jj) 
    609                zv_frc(ji,jj) =  zv_frc(ji,jj) + zraur * vtau(ji,jj) * r1_hv_n(ji,jj) 
    610             END DO 
    611          END DO 
     526         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 
     527         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 
    612528      ELSE 
    613 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    614          DO jj = 1, jpj 
    615             DO ji = 1, jpi 
    616                zu_frc(ji,jj) =  zu_frc(ji,jj) + zraur * z1_2 * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 
    617                zv_frc(ji,jj) =  zv_frc(ji,jj) + zraur * z1_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 
    618             END DO 
    619          END DO 
     529         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 
     530         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 
    620531      ENDIF   
    621532      ! 
    622533      IF ( ln_apr_dyn ) THEN                    ! Add atm pressure forcing 
    623534         IF (ln_bt_fw) THEN 
    624 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    625535            DO jj = 2, jpjm1               
    626536               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    632542            END DO 
    633543         ELSE 
    634 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    635544            DO jj = 2, jpjm1               
    636545               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    649558      !                                         ! Surface net water flux and rivers 
    650559      IF (ln_bt_fw) THEN 
    651 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    652          DO jj = 1, jpj 
    653             DO ji = 1, jpi 
    654                zssh_frc(ji,jj) = zraur * ( emp(ji,jj) - rnf(ji,jj) + fwfisf(ji,jj) ) 
    655             END DO 
    656          END DO 
     560         zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 
    657561      ELSE 
    658 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    659          DO jj = 1, jpj 
    660             DO ji = 1, jpi 
    661                zssh_frc(ji,jj) = zraur * z1_2 * (  emp(ji,jj) + emp_b(ji,jj) - rnf(ji,jj) - rnf_b(ji,jj)   & 
    662                 &                        + fwfisf(ji,jj) + fwfisf_b(ji,jj) ) 
    663             END DO 
    664          END DO 
     562         zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   & 
     563                &                        + fwfisf(:,:) + fwfisf_b(:,:)                     ) 
    665564      ENDIF 
    666565      ! 
    667566      IF( ln_sdw ) THEN                         ! Stokes drift divergence added if necessary 
    668 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    669          DO jj = 1, jpj 
    670             DO ji = 1, jpi 
    671                zssh_frc(ji,jj) = zssh_frc(ji,jj) + div_sd(ji,jj) 
    672             END DO 
    673          END DO 
     567         zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 
    674568      ENDIF 
    675569      ! 
    … …  
    677571      !                                         ! Include the IAU weighted SSH increment 
    678572      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    679 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    680          DO jj = 1, jpj 
    681             DO ji = 1, jpi 
    682                zssh_frc(ji,jj) = zssh_frc(ji,jj) - ssh_iau(ji,jj) 
    683             END DO 
    684          END DO 
     573         zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 
    685574      ENDIF 
    686575#endif 
    … …  
    700589      ! Initialize barotropic variables:       
    701590      IF( ll_init )THEN 
    702 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    703          DO jj = 1, jpj 
    704             DO ji = 1, jpi 
    705                sshbb_e(ji,jj) = 0._wp 
    706                ubb_e  (ji,jj) = 0._wp 
    707                vbb_e  (ji,jj) = 0._wp 
    708                sshb_e (ji,jj) = 0._wp 
    709                ub_e   (ji,jj) = 0._wp 
    710                vb_e   (ji,jj) = 0._wp 
    711             END DO 
    712          END DO 
     591         sshbb_e(:,:) = 0._wp 
     592         ubb_e  (:,:) = 0._wp 
     593         vbb_e  (:,:) = 0._wp 
     594         sshb_e (:,:) = 0._wp 
     595         ub_e   (:,:) = 0._wp 
     596         vb_e   (:,:) = 0._wp 
    713597      ENDIF 
    714598 
    715599      ! 
    716600      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    717 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    718          DO jj = 1, jpj 
    719             DO ji = 1, jpi 
    720                sshn_e(ji,jj) =    sshn(ji,jj) 
    721                un_e  (ji,jj) =    un_b(ji,jj) 
    722                vn_e  (ji,jj) =    vn_b(ji,jj) 
    723                 ! 
    724                hu_e  (ji,jj) =    hu_n(ji,jj) 
    725                hv_e  (ji,jj) =    hv_n(ji,jj) 
    726                hur_e (ji,jj) = r1_hu_n(ji,jj) 
    727                hvr_e (ji,jj) = r1_hv_n(ji,jj) 
    728             END DO 
    729          END DO 
     601         sshn_e(:,:) =    sshn(:,:)             
     602         un_e  (:,:) =    un_b(:,:)             
     603         vn_e  (:,:) =    vn_b(:,:) 
     604         ! 
     605         hu_e  (:,:) =    hu_n(:,:)        
     606         hv_e  (:,:) =    hv_n(:,:)  
     607         hur_e (:,:) = r1_hu_n(:,:)     
     608         hvr_e (:,:) = r1_hv_n(:,:) 
    730609      ELSE                                ! CENTRED integration: start from BEFORE fields 
    731 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    732          DO jj = 1, jpj 
    733             DO ji = 1, jpi 
    734                sshn_e(ji,jj) =    sshb(ji,jj) 
    735                un_e  (ji,jj) =    ub_b(ji,jj) 
    736                vn_e  (ji,jj) =    vb_b(ji,jj) 
    737                  ! 
    738                hu_e  (ji,jj) =    hu_b(ji,jj) 
    739                hv_e  (ji,jj) =    hv_b(ji,jj) 
    740                hur_e (ji,jj) = r1_hu_b(ji,jj) 
    741                hvr_e (ji,jj) = r1_hv_b(ji,jj) 
    742             END DO 
    743          END DO 
     610         sshn_e(:,:) =    sshb(:,:) 
     611         un_e  (:,:) =    ub_b(:,:)          
     612         vn_e  (:,:) =    vb_b(:,:) 
     613         ! 
     614         hu_e  (:,:) =    hu_b(:,:)        
     615         hv_e  (:,:) =    hv_b(:,:)  
     616         hur_e (:,:) = r1_hu_b(:,:)     
     617         hvr_e (:,:) = r1_hv_b(:,:) 
    744618      ENDIF 
    745619      ! 
    … …  
    747621      ! 
    748622      ! Initialize sums: 
    749 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    750       DO jj = 1, jpj 
    751          DO ji = 1, jpi 
    752             ua_b  (ji,jj) = 0._wp       ! After barotropic velocities (or transport if flux form)           
    753             va_b  (ji,jj) = 0._wp 
    754             ssha  (ji,jj) = 0._wp       ! Sum for after averaged sea level 
    755             un_adv(ji,jj) = 0._wp       ! Sum for now transport issued from ts loop 
    756             vn_adv(ji,jj) = 0._wp 
    757          END DO 
    758       END DO 
     623      ua_b  (:,:) = 0._wp       ! After barotropic velocities (or transport if flux form)           
     624      va_b  (:,:) = 0._wp 
     625      ssha  (:,:) = 0._wp       ! Sum for after averaged sea level 
     626      un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop 
     627      vn_adv(:,:) = 0._wp 
    759628      !                                             ! ==================== ! 
    760629      DO jn = 1, icycle                             !  sub-time-step loop  ! 
    … …  
    780649 
    781650         ! Extrapolate barotropic velocities at step jit+0.5: 
    782 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    783          DO jj = 1, jpj 
    784             DO ji = 1, jpi 
    785                ua_e(ji,jj) = za1 * un_e(ji,jj) + za2 * ub_e(ji,jj) + za3 * ubb_e(ji,jj) 
    786                va_e(ji,jj) = za1 * vn_e(ji,jj) + za2 * vb_e(ji,jj) + za3 * vbb_e(ji,jj) 
    787             END DO 
    788          END DO 
     651         ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 
     652         va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 
    789653 
    790654         IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only) 
    791655            !                                             !  ------------------ 
    792656            ! Extrapolate Sea Level at step jit+0.5: 
    793 !$OMP PARALLEL  
    794 !$OMP DO schedule(static) private(jj,ji) 
    795             DO jj = 1, jpj 
    796                DO ji = 1, jpi 
    797                   zsshp2_e(ji,jj) = za1 * sshn_e(ji,jj)  + za2 * sshb_e(ji,jj) + za3 * sshbb_e(ji,jj) 
    798                END DO 
    799             END DO 
     657            zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 
    800658            ! 
    801 !$OMP DO schedule(static) private(jj,ji) 
    802659            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points 
    803660               DO ji = 2, fs_jpim1   ! Vector opt. 
    … …  
    810667               END DO 
    811668            END DO 
    812 !$OMP END PARALLEL 
    813669            CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 
    814670            ! 
    815 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    816             DO jj = 1, jpj 
    817                DO ji = 1, jpi 
    818                   zhup2_e (ji,jj) = hu_0(ji,jj) + zwx(ji,jj)                ! Ocean depth at U- and V-points 
    819                   zhvp2_e (ji,jj) = hv_0(ji,jj) + zwy(ji,jj) 
    820                END DO 
    821             END DO 
     671            zhup2_e (:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points 
     672            zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 
    822673         ELSE 
    823 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    824             DO jj = 1, jpj 
    825                DO ji = 1, jpi 
    826                   zhup2_e (ji,jj) = hu_n(ji,jj) 
    827                   zhvp2_e (ji,jj) = hv_n(ji,jj) 
    828                END DO 
    829             END DO 
     674            zhup2_e (:,:) = hu_n(:,:) 
     675            zhvp2_e (:,:) = hv_n(:,:) 
    830676         ENDIF 
    831677         !                                                !* after ssh 
    … …  
    834680         ! considering fluxes below: 
    835681         ! 
    836 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    837          DO jj = 1, jpj 
    838             DO ji = 1, jpi 
    839                zwx(ji,jj) = e2u(ji,jj) * ua_e(ji,jj) * zhup2_e(ji,jj)         ! fluxes at jn+0.5 
    840                zwy(ji,jj) = e1v(ji,jj) * va_e(ji,jj) * zhvp2_e(ji,jj) 
    841             END DO 
    842          END DO 
    843  
     682         zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5 
     683         zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 
    844684         ! 
    845685#if defined key_agrif 
    … …  
    872712         ! Sum over sub-time-steps to compute advective velocities 
    873713         za2 = wgtbtp2(jn) 
    874 !$OMP PARALLEL 
    875 !$OMP DO schedule(static) private(jj,ji) 
    876          DO jj = 1, jpj 
    877             DO ji = 1, jpi 
    878                un_adv(ji,jj) = un_adv(ji,jj) + za2 * zwx(ji,jj) * r1_e2u(ji,jj) 
    879                vn_adv(ji,jj) = vn_adv(ji,jj) + za2 * zwy(ji,jj) * r1_e1v(ji,jj) 
    880             END DO 
    881          END DO 
    882 !$OMP END DO NOWAIT 
     714         un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 
     715         vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 
    883716         ! 
    884717         ! Set next sea level: 
    885 !$OMP DO schedule(static) private(jj,ji) 
    886718         DO jj = 2, jpjm1                                  
    887719            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    890722            END DO 
    891723         END DO 
    892 !$OMP DO schedule(static) private(jj,ji) 
    893          DO jj = 1, jpj 
    894             DO ji = 1, jpi 
    895                ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv(ji,jj) )  ) * ssmask(ji,jj) 
    896             END DO 
    897          END DO 
    898 !$OMP END PARALLEL 
     724         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:) 
     725          
    899726         CALL lbc_lnk( ssha_e, 'T',  1._wp ) 
    900727 
    … …  
    907734         ! Sea Surface Height at u-,v-points (vvl case only) 
    908735         IF( .NOT.ln_linssh ) THEN                                 
    909 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    910736            DO jj = 2, jpjm1 
    911737               DO ji = 2, jpim1      ! NO Vector Opt. 
    … …  
    940766         ENDIF 
    941767         ! 
    942 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    943          DO jj = 1, jpj 
    944             DO ji = 1, jpi 
    945                zsshp2_e(ji,jj) = za0 *  ssha_e(ji,jj) + za1 *  sshn_e (ji,jj) & 
    946                 &              + za2 *  sshb_e(ji,jj) + za3 *  sshbb_e(ji,jj) 
    947             END DO 
    948          END DO 
     768         zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:) & 
     769          &            + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:) 
    949770         IF( ln_wd ) THEN                   ! Calculating and applying W/D gravity filters 
    950 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 
    951771           DO jj = 2, jpjm1 
    952772              DO ji = 2, jpim1  
    … …  
    993813         IF( .NOT.ln_linssh  .AND. .NOT.ln_dynadv_vec ) THEN   !* Vector form 
    994814            !                                         
    995 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 
    996815            DO jj = 2, jpjm1                             
    997816               DO ji = 2, jpim1 
    … …  
    1007826            END DO 
    1008827 
    1009             IF( ln_wd ) THEN 
    1010 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1011                DO jj = 1, jpj 
    1012                   DO ji = 1, jpi   ! vector opt. 
    1013                      zhust_e(ji,jj) = MAX(zhust_e (ji,jj), rn_wdmin1 ) 
    1014                      zhvst_e(ji,jj) = MAX(zhvst_e (ji,jj), rn_wdmin1 ) 
    1015                   END DO 
    1016                END DO 
    1017             END IF 
    1018828         ENDIF 
    1019829         ! 
    … …  
    1026836         ! 
    1027837         IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN     !==  energy conserving or mixed scheme  ==! 
    1028 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 
    1029838            DO jj = 2, jpjm1 
    1030839               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    1039848            ! 
    1040849         ELSEIF ( ln_dynvor_ens ) THEN                   !==  enstrophy conserving scheme  ==! 
    1041 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 
    1042850            DO jj = 2, jpjm1 
    1043851               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    1052860            ! 
    1053861         ELSEIF ( ln_dynvor_een ) THEN                   !==  energy and enstrophy conserving scheme  ==! 
    1054 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1055862            DO jj = 2, jpjm1 
    1056863               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    1070877         ! Add tidal astronomical forcing if defined 
    1071878         IF ( ln_tide .AND. ln_tide_pot ) THEN 
    1072 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    1073879            DO jj = 2, jpjm1 
    1074880               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    1082888         ! 
    1083889         ! Add bottom stresses: 
    1084 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1085          DO jj = 1, jpj 
    1086             DO ji = 1, jpi 
    1087                zu_trd(ji,jj) = zu_trd(ji,jj) + bfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
    1088                zv_trd(ji,jj) = zv_trd(ji,jj) + bfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
    1089                ! 
    1090                ! Add top stresses: 
    1091                zu_trd(ji,jj) = zu_trd(ji,jj) + tfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
    1092                zv_trd(ji,jj) = zv_trd(ji,jj) + tfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
    1093             END DO 
    1094          END DO 
    1095  
     890         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 
     891         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
     892         ! 
     893         ! Add top stresses: 
     894         zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 
     895         zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
    1096896         ! 
    1097897         ! Surface pressure trend: 
    1098898 
    1099899         IF( ln_wd ) THEN 
    1100 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    1101900           DO jj = 2, jpjm1 
    1102901              DO ji = 2, jpim1  
    … …  
    1109908           END DO 
    1110909         ELSE 
    1111 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    1112910           DO jj = 2, jpjm1 
    1113911              DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    1124922         ! Set next velocities: 
    1125923         IF( ln_dynadv_vec .OR. ln_linssh ) THEN   !* Vector form 
    1126 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1127924            DO jj = 2, jpjm1 
    1128925               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    1142939            ! 
    1143940         ELSE                                      !* Flux form 
    1144 !$OMP PARALLEL DO schedule(static) private(jj,ji,zhura,zhvra) 
    1145941            DO jj = 2, jpjm1 
    1146942               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    1173969         IF( .NOT.ln_linssh ) THEN                     !* Update ocean depth (variable volume case only) 
    1174970            IF( ln_wd ) THEN 
    1175 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1176                DO jj = 1, jpj 
    1177                   DO ji = 1, jpi   ! vector opt. 
    1178                      hu_e (ji,jj) = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1) 
    1179                      hv_e (ji,jj) = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1) 
    1180                   END DO 
    1181                END DO 
     971              hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1) 
     972              hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1) 
    1182973            ELSE 
    1183 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1184                DO jj = 1, jpj 
    1185                   DO ji = 1, jpi 
    1186                      hu_e (ji,jj) = hu_0(ji,jj) + zsshu_a(ji,jj) 
    1187                      hv_e (ji,jj) = hv_0(ji,jj) + zsshv_a(ji,jj) 
    1188                   END DO 
    1189                END DO 
     974              hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 
     975              hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 
    1190976            END IF 
    1191 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1192             DO jj = 1, jpj 
    1193                DO ji = 1, jpi 
    1194                   hur_e(ji,jj) = ssumask(ji,jj) / ( hu_e(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    1195                   hvr_e(ji,jj) = ssvmask(ji,jj) / ( hv_e(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    1196                END DO 
    1197             END DO 
     977            hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 
     978            hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 
    1198979            ! 
    1199980         ENDIF 
    … …  
    1208989         !                                             !* Swap 
    1209990         !                                             !  ---- 
    1210 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1211          DO jj = 1, jpj 
    1212             DO ji = 1, jpi 
    1213                ubb_e  (ji,jj) = ub_e  (ji,jj) 
    1214                ub_e   (ji,jj) = un_e  (ji,jj) 
    1215                un_e   (ji,jj) = ua_e  (ji,jj) 
    1216                ! 
    1217                vbb_e  (ji,jj) = vb_e  (ji,jj) 
    1218                vb_e   (ji,jj) = vn_e  (ji,jj) 
    1219                vn_e   (ji,jj) = va_e  (ji,jj) 
    1220                ! 
    1221                sshbb_e(ji,jj) = sshb_e(ji,jj) 
    1222                sshb_e (ji,jj) = sshn_e(ji,jj) 
    1223                sshn_e (ji,jj) = ssha_e(ji,jj) 
    1224             END DO 
    1225          END DO 
     991         ubb_e  (:,:) = ub_e  (:,:) 
     992         ub_e   (:,:) = un_e  (:,:) 
     993         un_e   (:,:) = ua_e  (:,:) 
     994         ! 
     995         vbb_e  (:,:) = vb_e  (:,:) 
     996         vb_e   (:,:) = vn_e  (:,:) 
     997         vn_e   (:,:) = va_e  (:,:) 
     998         ! 
     999         sshbb_e(:,:) = sshb_e(:,:) 
     1000         sshb_e (:,:) = sshn_e(:,:) 
     1001         sshn_e (:,:) = ssha_e(:,:) 
    12261002 
    12271003         !                                             !* Sum over whole bt loop 
    … …  
    12291005         za1 = wgtbtp1(jn)                                     
    12301006         IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities 
    1231 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1232             DO jj = 1, jpj 
    1233                DO ji = 1, jpi 
    1234                   ua_b  (ji,jj) = ua_b  (ji,jj) + za1 * ua_e  (ji,jj) 
    1235                   va_b  (ji,jj) = va_b  (ji,jj) + za1 * va_e  (ji,jj) 
    1236                END DO 
    1237             END DO 
     1007            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:)  
     1008            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:)  
    12381009         ELSE                                              ! Sum transports 
    1239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1240             DO jj = 1, jpj 
    1241                DO ji = 1, jpi 
    1242                   ua_b  (ji,jj) = ua_b  (ji,jj) + za1 * ua_e  (ji,jj) * hu_e (ji,jj) 
    1243                   va_b  (ji,jj) = va_b  (ji,jj) + za1 * va_e  (ji,jj) * hv_e (ji,jj) 
    1244                END DO 
    1245             END DO 
     1010            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) 
     1011            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) 
    12461012         ENDIF 
    12471013         !                                   ! Sum sea level 
    1248 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1249          DO jj = 1, jpj 
    1250             DO ji = 1, jpi 
    1251                ssha(ji,jj) = ssha(ji,jj) + za1 * ssha_e(ji,jj) 
    1252             END DO 
    1253          END DO 
     1014         ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 
    12541015         !                                                 ! ==================== ! 
    12551016      END DO                                               !        end loop      ! 
    … …  
    12601021      ! 
    12611022      ! Set advection velocity correction: 
    1262 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1263       DO jj = 1, jpj 
    1264          DO ji = 1, jpi 
    1265             zwx(ji,jj) = un_adv(ji,jj) 
    1266             zwy(ji,jj) = vn_adv(ji,jj) 
    1267          END DO 
    1268       END DO 
     1023      zwx(:,:) = un_adv(:,:) 
     1024      zwy(:,:) = vn_adv(:,:) 
    12691025      IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN      
    1270 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1271          DO jj = 1, jpj 
    1272             DO ji = 1, jpi 
    1273                un_adv(ji,jj) = zwx(ji,jj) * r1_hu_n(ji,jj) 
    1274                vn_adv(ji,jj) = zwy(ji,jj) * r1_hv_n(ji,jj) 
    1275             END DO 
    1276          END DO 
     1026         un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 
     1027         vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 
    12771028      ELSE 
    1278 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1279          DO jj = 1, jpj 
    1280             DO ji = 1, jpi 
    1281                un_adv(ji,jj) = z1_2 * ( ub2_b(ji,jj) + zwx(ji,jj) ) * r1_hu_n(ji,jj) 
    1282                vn_adv(ji,jj) = z1_2 * ( vb2_b(ji,jj) + zwy(ji,jj) ) * r1_hv_n(ji,jj) 
    1283             END DO 
    1284          END DO 
     1029         un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 
     1030         vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 
    12851031      END IF 
    12861032 
    12871033      IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 
    1288 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1289          DO jj = 1, jpj 
    1290             DO ji = 1, jpi 
    1291                ub2_b(ji,jj) = zwx(ji,jj) 
    1292                vb2_b(ji,jj) = zwy(ji,jj) 
    1293             END DO 
    1294          END DO 
     1034         ub2_b(:,:) = zwx(:,:) 
     1035         vb2_b(:,:) = zwy(:,:) 
    12951036      ENDIF 
    12961037      ! 
    12971038      ! Update barotropic trend: 
    12981039      IF( ln_dynadv_vec .OR. ln_linssh ) THEN 
    1299 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    13001040         DO jk=1,jpkm1 
    1301             DO jj = 1, jpj 
    1302                DO ji = 1, jpi 
    1303                   ua(ji,jj,jk) = ua(ji,jj,jk) + ( ua_b(ji,jj) - ub_b(ji,jj) ) * z1_2dt_b 
    1304                   va(ji,jj,jk) = va(ji,jj,jk) + ( va_b(ji,jj) - vb_b(ji,jj) ) * z1_2dt_b 
    1305                END DO 
    1306             END DO 
     1041            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 
     1042            va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 
    13071043         END DO 
    13081044      ELSE 
    13091045         ! At this stage, ssha has been corrected: compute new depths at velocity points 
    1310 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    13111046         DO jj = 1, jpjm1 
    13121047            DO ji = 1, jpim1      ! NO Vector Opt. 
    … …  
    13211056         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    13221057         ! 
    1323 !$OMP PARALLEL 
    1324 !$OMP DO schedule(static) private(jk,jj,ji) 
    13251058         DO jk=1,jpkm1 
    1326             DO jj = 1, jpj 
    1327                DO ji = 1, jpi 
    1328                   ua(ji,jj,jk) = ua(ji,jj,jk) + r1_hu_n(ji,jj) * ( ua_b(ji,jj) - ub_b(ji,jj) * hu_b(ji,jj) ) * z1_2dt_b 
    1329                   va(ji,jj,jk) = va(ji,jj,jk) + r1_hv_n(ji,jj) * ( va_b(ji,jj) - vb_b(ji,jj) * hv_b(ji,jj) ) * z1_2dt_b 
    1330                END DO 
    1331             END DO 
     1059            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 
     1060            va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 
    13321061         END DO 
    1333 !$OMP END DO NOWAIT 
    13341062         ! Save barotropic velocities not transport: 
    1335 !$OMP DO schedule(static) private(jj,ji) 
    1336          DO jj = 1, jpj 
    1337             DO ji = 1, jpi 
    1338                ua_b(ji,jj) =  ua_b(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    1339                va_b(ji,jj) =  va_b(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    1340             END DO 
    1341          END DO 
    1342 !$OMP END PARALLEL 
    1343       ENDIF 
    1344       ! 
    1345 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     1063         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 
     1064         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 
     1065      ENDIF 
     1066      ! 
    13461067      DO jk = 1, jpkm1 
    1347          DO jj = 1, jpj 
    1348             DO ji = 1, jpi 
    1349                ! Correct velocities: 
    1350                un(ji,jj,jk) = ( un(ji,jj,jk) + un_adv(ji,jj) - un_b(ji,jj) ) * umask(ji,jj,jk) 
    1351                vn(ji,jj,jk) = ( vn(ji,jj,jk) + vn_adv(ji,jj) - vn_b(ji,jj) ) * vmask(ji,jj,jk) 
    1352                ! 
    1353             END DO 
    1354          END DO 
     1068         ! Correct velocities: 
     1069         un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 
     1070         vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 
     1071         ! 
    13551072      END DO 
    13561073      ! 
    … …  
    13641081      IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 
    13651082         IF( Agrif_NbStepint() == 0 ) THEN 
    1366 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1367             DO jj = 1, jpj 
    1368                DO ji = 1, jpi 
    1369                   ub2_i_b(ji,jj) = 0._wp 
    1370                   vb2_i_b(ji,jj) = 0._wp 
    1371                END DO 
    1372             END DO 
     1083            ub2_i_b(:,:) = 0._wp 
     1084            vb2_i_b(:,:) = 0._wp 
    13731085         END IF 
    13741086         ! 
    13751087         za1 = 1._wp / REAL(Agrif_rhot(), wp) 
    1376 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1377          DO jj = 1, jpj 
    1378             DO ji = 1, jpi 
    1379                ub2_i_b(ji,jj) = ub2_i_b(ji,jj) + za1 * ub2_b(ji,jj) 
    1380                vb2_i_b(ji,jj) = vb2_i_b(ji,jj) + za1 * vb2_b(ji,jj) 
    1381             END DO 
    1382          END DO 
     1088         ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 
     1089         vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 
    13831090      ENDIF 
    13841091#endif       

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r7698 r7753  
    9797      !!---------------------------------------------------------------------- 
    9898      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    99       INTEGER ::   jk, jj, ji 
    10099      ! 
    101100      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    … …  
    110109      CASE ( np_ENE )                                 !* energy conserving scheme 
    111110         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    112 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    113             DO jk = 1, jpk 
    114                DO jj = 1, jpj 
    115                   DO ji = 1, jpi 
    116                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    117                      ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    118                   END DO 
    119                END DO 
    120             END DO 
     111            ztrdu(:,:,:) = ua(:,:,:) 
     112            ztrdv(:,:,:) = va(:,:,:) 
    121113            CALL vor_ene( kt, nrvm, un , vn , ua, va )                    ! relative vorticity or metric trend 
    122 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    123             DO jk = 1, jpk 
    124                DO jj = 1, jpj 
    125                   DO ji = 1, jpi 
    126                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    127                      ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    128                   END DO 
    129                END DO 
    130             END DO 
     114            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     115            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    131116            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    132 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    133             DO jk = 1, jpk 
    134                DO jj = 1, jpj 
    135                   DO ji = 1, jpi 
    136                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    137                      ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    138                   END DO 
    139                END DO 
    140             END DO 
     117            ztrdu(:,:,:) = ua(:,:,:) 
     118            ztrdv(:,:,:) = va(:,:,:) 
    141119            CALL vor_ene( kt, ncor, un , vn , ua, va )                    ! planetary vorticity trend 
    142 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    143             DO jk = 1, jpk 
    144                DO jj = 1, jpj 
    145                   DO ji = 1, jpi 
    146                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    147                      ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    148                   END DO 
    149                END DO 
    150             END DO 
     120            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     121            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    151122            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    152123         ELSE                                               ! total vorticity trend 
    … …  
    157128      CASE ( np_ENS )                                 !* enstrophy conserving scheme 
    158129         IF( l_trddyn ) THEN                                ! trend diagnostics: splitthe trend in two     
    159 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    160             DO jk = 1, jpk 
    161                DO jj = 1, jpj 
    162                   DO ji = 1, jpi 
    163                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    164                      ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    165                   END DO 
    166                END DO 
    167             END DO 
     130            ztrdu(:,:,:) = ua(:,:,:) 
     131            ztrdv(:,:,:) = va(:,:,:) 
    168132            CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend 
    169 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    170             DO jk = 1, jpk 
    171                DO jj = 1, jpj 
    172                   DO ji = 1, jpi 
    173                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    174                      ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    175                   END DO 
    176                END DO 
    177             END DO 
     133            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     134            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    178135            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    179 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    180             DO jk = 1, jpk 
    181                DO jj = 1, jpj 
    182                   DO ji = 1, jpi 
    183                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    184                      ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    185                   END DO 
    186                END DO 
    187             END DO 
     136            ztrdu(:,:,:) = ua(:,:,:) 
     137            ztrdv(:,:,:) = va(:,:,:) 
    188138            CALL vor_ens( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend 
    189 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    190             DO jk = 1, jpk 
    191                DO jj = 1, jpj 
    192                   DO ji = 1, jpi 
    193                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    194                      ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    195                   END DO 
    196                END DO 
    197             END DO 
     139            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     140            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    198141            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    199142         ELSE                                               ! total vorticity trend 
    … …  
    204147      CASE ( np_MIX )                                 !* mixed ene-ens scheme 
    205148         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    206 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    207             DO jk = 1, jpk 
    208                DO jj = 1, jpj 
    209                   DO ji = 1, jpi 
    210                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    211                      ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    212                   END DO 
    213                END DO 
    214             END DO 
     149            ztrdu(:,:,:) = ua(:,:,:) 
     150            ztrdv(:,:,:) = va(:,:,:) 
    215151            CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend (ens) 
    216 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    217             DO jk = 1, jpk 
    218                DO jj = 1, jpj 
    219                   DO ji = 1, jpi 
    220                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    221                      ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    222                   END DO 
    223                END DO 
    224             END DO 
     152            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     153            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    225154            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    226 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    227             DO jk = 1, jpk 
    228                DO jj = 1, jpj 
    229                   DO ji = 1, jpi 
    230                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    231                      ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    232                   END DO 
    233                END DO 
    234             END DO 
     155            ztrdu(:,:,:) = ua(:,:,:) 
     156            ztrdv(:,:,:) = va(:,:,:) 
    235157            CALL vor_ene( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend (ene) 
    236 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    237             DO jk = 1, jpk 
    238                DO jj = 1, jpj 
    239                   DO ji = 1, jpi 
    240                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    241                      ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    242                   END DO 
    243                END DO 
    244             END DO 
     158            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     159            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    245160            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    246161         ELSE                                               ! total vorticity trend 
    … …  
    252167      CASE ( np_EEN )                                 !* energy and enstrophy conserving scheme 
    253168         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    254 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    255             DO jk = 1, jpk 
    256                DO jj = 1, jpj 
    257                   DO ji = 1, jpi 
    258                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    259                      ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    260                   END DO 
    261                END DO 
    262             END DO 
     169            ztrdu(:,:,:) = ua(:,:,:) 
     170            ztrdv(:,:,:) = va(:,:,:) 
    263171            CALL vor_een( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend 
    264 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    265             DO jk = 1, jpk 
    266                DO jj = 1, jpj 
    267                   DO ji = 1, jpi 
    268                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    269                      ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    270                   END DO 
    271                END DO 
    272             END DO 
     172            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     173            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    273174            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    274 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    275             DO jk = 1, jpk 
    276                DO jj = 1, jpj 
    277                   DO ji = 1, jpi 
    278                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    279                      ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    280                   END DO 
    281                END DO 
    282             END DO 
     175            ztrdu(:,:,:) = ua(:,:,:) 
     176            ztrdv(:,:,:) = va(:,:,:) 
    283177            CALL vor_een( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend 
    284 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    285             DO jk = 1, jpk 
    286                DO jj = 1, jpj 
    287                   DO ji = 1, jpi 
    288                      ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    289                      ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    290                   END DO 
    291                END DO 
    292             END DO 
     178            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     179            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    293180            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    294181         ELSE                                               ! total vorticity trend 
    … …  
    357244         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    358245         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    359 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    360             DO jj = 1, jpj 
    361                DO ji = 1, jpi 
    362                   zwz(ji,jj) = ff_f(ji,jj) 
    363                END DO 
    364             END DO  
     246            zwz(:,:) = ff_f(:,:)  
    365247         CASE ( np_RVO )                           !* relative vorticity 
    366 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    367248            DO jj = 1, jpjm1 
    368249               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    372253            END DO 
    373254         CASE ( np_MET )                           !* metric term 
    374 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    375255            DO jj = 1, jpjm1 
    376256               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    381261            END DO 
    382262         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    383 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    384263            DO jj = 1, jpjm1 
    385264               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    390269            END DO 
    391270         CASE ( np_CME )                           !* Coriolis + metric 
    392 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    393271            DO jj = 1, jpjm1 
    394272               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    404282         ! 
    405283         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    406 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    407284            DO jj = 1, jpjm1 
    408285               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    413290 
    414291         IF( ln_sco ) THEN 
    415 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    416             DO jj = 1, jpj 
    417                DO ji = 1, jpi 
    418                   zwz(ji,jj) = zwz(ji,jj) / e3f_n(ji,jj,jk) 
    419                   zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 
    420                   zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 
    421                END DO 
    422             END DO 
     292            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 
     293            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 
     294            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 
    423295         ELSE 
    424 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    425             DO jj = 1, jpj 
    426                DO ji = 1, jpi 
    427                   zwx(ji,jj) = e2u(ji,jj) * pun(ji,jj,jk) 
    428                   zwy(ji,jj) = e1v(ji,jj) * pvn(ji,jj,jk) 
    429                END DO 
    430             END DO 
     296            zwx(:,:) = e2u(:,:) * pun(:,:,jk) 
     297            zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 
    431298         ENDIF 
    432299         !                                   !==  compute and add the vorticity term trend  =! 
    433 !$OMP PARALLEL DO schedule(static) private(jj, ji, zy1, zy2, zx1, zx2) 
    434300         DO jj = 2, jpjm1 
    435301            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    621487         SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point 
    622488         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    623 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3) 
    624489            DO jj = 1, jpjm1 
    625490               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    632497            END DO 
    633498         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    634 !$OMP PARALLEL DO schedule(static) private(jj,ji,ze3,zmsk) 
    635499            DO jj = 1, jpjm1 
    636500               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    648512         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    649513         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    650 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    651514            DO jj = 1, jpjm1 
    652515               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    655518            END DO 
    656519         CASE ( np_RVO )                           !* relative vorticity 
    657 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    658520            DO jj = 1, jpjm1 
    659521               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    664526            END DO 
    665527         CASE ( np_MET )                           !* metric term 
    666 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    667528            DO jj = 1, jpjm1 
    668529               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    673534            END DO 
    674535         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
    675 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    676536            DO jj = 1, jpjm1 
    677537               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    682542            END DO 
    683543         CASE ( np_CME )                           !* Coriolis + metric 
    684 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    685544            DO jj = 1, jpjm1 
    686545               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    696555         ! 
    697556         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
    698 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    699557            DO jj = 1, jpjm1 
    700558               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    707565         ! 
    708566         !                                   !==  horizontal fluxes  ==! 
    709 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    710          DO jj = 1, jpj 
    711             DO ji = 1, jpi 
    712                zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 
    713                zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 
    714             END DO 
    715          END DO 
     567         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 
     568         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 
    716569 
    717570         !                                   !==  compute and add the vorticity term trend  =! 
    718571         jj = 2 
    719572         ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
    720  
    721573         DO ji = 2, jpi          ! split in 2 parts due to vector opt. 
    722574               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
    … …  
    725577               ztsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
    726578         END DO 
    727 !$OMP PARALLEL 
    728 !$OMP DO schedule(static) private(jj,ji) 
    729579         DO jj = 3, jpj 
    730580            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3 
    … …  
    735585            END DO 
    736586         END DO 
    737 !$OMP DO schedule(static) private(jj,ji,zua,zva) 
    738587         DO jj = 2, jpjm1 
    739588            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    746595            END DO   
    747596         END DO   
    748 !$OMP END PARALLEL  
    749597         !                                             ! =============== 
    750598      END DO                                           !   End of slab 
    … …  
    801649      IF(lwp) WRITE(numout,*) '      change fmask value in the angles (T)           ln_vorlat = ', ln_vorlat 
    802650      IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 
    803 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    804651         DO jk = 1, jpk 
    805652            DO jj = 2, jpjm1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r7698 r7753  
    7777      IF( l_trddyn )   THEN         ! Save ua and va trends 
    7878         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    79 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    80         DO jk = 1, jpk 
    81            DO jj = 1, jpj 
    82               DO ji = 1, jpi 
    83                  ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    84                  ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    85               END DO 
    86            END DO 
    87         END DO 
     79         ztrdu(:,:,:) = ua(:,:,:)  
     80         ztrdv(:,:,:) = va(:,:,:)  
    8881      ENDIF 
    8982       
    90 !$OMP PARALLEL 
    9183      DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical 
    92 !$OMP DO schedule(static) private(jj, ji) 
    9384         DO jj = 2, jpj                   ! vertical fluxes  
    9485            DO ji = fs_2, jpi             ! vector opt. 
    … …  
    9687            END DO 
    9788         END DO 
    98 !$OMP DO schedule(static) private(jj, ji) 
    9989         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point 
    10090            DO ji = fs_2, fs_jpim1        ! vector opt. 
    … …  
    10494         END DO    
    10595      END DO 
    106 !$OMP END PARALLEL 
    10796      ! 
    10897      ! Surface and bottom advective fluxes set to zero 
    10998      IF ( ln_isfcav ) THEN 
    110 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    11199         DO jj = 2, jpjm1 
    112100            DO ji = fs_2, fs_jpim1           ! vector opt. 
    … …  
    118106         END DO 
    119107      ELSE 
    120 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    121108         DO jj = 2, jpjm1         
    122109            DO ji = fs_2, fs_jpim1           ! vector opt. 
    … …  
    129116      END IF 
    130117 
    131 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zua, zva) 
    132118      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points 
    133119         DO jj = 2, jpjm1 
    … …  
    144130 
    145131      IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
    146 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    147            DO jk = 1, jpk 
    148               DO jj = 1, jpj 
    149                  DO ji = 1, jpi 
    150                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
    151                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
    152                  END DO 
    153               END DO 
    154            END DO 
     132         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     133         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    155134         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    156135         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r7698 r7753  
    5353      !! 
    5454      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    55       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    5655      ! 
    5756      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    … …  
    6766      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    6867         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    69 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    70          DO jk = 1, jpk 
    71             DO jj = 1, jpj 
    72                DO ji = 1, jpi 
    73                   ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
    74                   ztrdv(ji,jj,jk) = va(ji,jj,jk) 
    75                END DO 
    76             END DO 
    77          END DO 
     68         ztrdu(:,:,:) = ua(:,:,:) 
     69         ztrdv(:,:,:) = va(:,:,:) 
    7870      ENDIF 
    7971 
    … …  
    8678 
    8779      IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    88 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    89          DO jk = 1, jpk 
    90             DO jj = 1, jpj 
    91                DO ji = 1, jpi 
    92                   ztrdu(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) / r2dt - ztrdu(ji,jj,jk) 
    93                   ztrdv(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) / r2dt - ztrdv(ji,jj,jk) 
    94                END DO 
    95             END DO 
    96          END DO 
     80         ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 
     81         ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 
    9782         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 
    9883         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r7698 r7753  
    9292      ! 
    9393      IF( ln_dynadv_vec .OR. ln_linssh ) THEN      ! applied on velocity 
    94 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    9594         DO jk = 1, jpkm1 
    96             DO jj = 1, jpj 
    97                DO ji = 1, jpi 
    98                   ua(ji,jj,jk) = ( ub(ji,jj,jk) + p2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk) 
    99                   va(ji,jj,jk) = ( vb(ji,jj,jk) + p2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk) 
    100                END DO 
    101             END DO 
     95            ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 
     96            va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 
    10297         END DO 
    10398      ELSE                                         ! applied on thickness weighted velocity 
    104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    10599         DO jk = 1, jpkm1 
    106             DO jj = 1, jpj 
    107                DO ji = 1, jpi 
    108                   ua(ji,jj,jk) = (         e3u_b(ji,jj,jk) * ub(ji,jj,jk)  & 
    109                      &          + p2dt * e3u_n(ji,jj,jk) * ua(ji,jj,jk)  ) / e3u_a(ji,jj,jk) * umask(ji,jj,jk) 
    110                   va(ji,jj,jk) = (         e3v_b(ji,jj,jk) * vb(ji,jj,jk)  & 
    111                      &          + p2dt * e3v_n(ji,jj,jk) * va(ji,jj,jk)  ) / e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 
    112                END DO 
    113             END DO 
     100            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  & 
     101               &          + p2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
     102            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  & 
     103               &          + p2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
    114104         END DO 
    115105      ENDIF 
    … …  
    122112      ! 
    123113      IF( ln_bfrimp ) THEN 
    124 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    125114         DO jj = 2, jpjm1 
    126115            DO ji = 2, jpim1 
    … …  
    132121         END DO 
    133122         IF ( ln_isfcav ) THEN 
    134 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    135123            DO jj = 2, jpjm1 
    136124               DO ji = 2, jpim1 
    … …  
    150138      ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 
    151139      IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN 
    152 !$OMP PARALLEL 
    153 !$OMP DO schedule(static) private(jk,jj,ji) 
    154140         DO jk = 1, jpkm1        ! remove barotropic velocities 
    155             DO jj = 1, jpj 
    156                DO ji = 1, jpi 
    157                   ua(ji,jj,jk) = ( ua(ji,jj,jk) - ua_b(ji,jj) ) * umask(ji,jj,jk) 
    158                   va(ji,jj,jk) = ( va(ji,jj,jk) - va_b(ji,jj) ) * vmask(ji,jj,jk) 
    159                END DO 
    160             END DO 
    161          END DO 
    162 !$OMP DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va) 
     141            ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 
     142            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 
     143         END DO 
    163144         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only 
    164145            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    171152            END DO 
    172153         END DO 
    173 !$OMP END DO NOWAIT 
    174 !$OMP END PARALLEL 
    175154         IF( ln_isfcav ) THEN    ! Ocean cavities (ISF) 
    176 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va) 
    177155            DO jj = 2, jpjm1         
    178156               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    194172      ! non zero value at the ocean bottom depending on the bottom friction used. 
    195173      ! 
    196 !$OMP PARALLEL 
    197 !$OMP DO schedule(static) private(jk, jj, ji, ze3ua, zzwi, zzws) 
    198174      DO jk = 1, jpkm1        ! Matrix 
    199175         DO jj = 2, jpjm1  
    … …  
    208184         END DO 
    209185      END DO 
    210 !$OMP DO schedule(static) private(jj, ji) 
    211186      DO jj = 2, jpjm1        ! Surface boundary conditions 
    212187         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    232207      ! 
    233208      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
    234 !$OMP DO schedule(static) private(jj, ji) 
    235209         DO jj = 2, jpjm1    
    236210            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    238212            END DO 
    239213         END DO 
    240 !$OMP END DO NOWAIT 
    241       END DO 
    242       ! 
    243 !$OMP DO schedule(static) private(jj, ji, ze3ua) 
     214      END DO 
     215      ! 
    244216      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    245217         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    250222      END DO 
    251223      DO jk = 2, jpkm1 
    252 !$OMP DO schedule(static) private(jj, ji) 
    253224         DO jj = 2, jpjm1 
    254225            DO ji = fs_2, fs_jpim1 
    … …  
    258229      END DO 
    259230      ! 
    260 !$OMP DO schedule(static) private(jj, ji) 
    261231      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==! 
    262232         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    265235      END DO 
    266236      DO jk = jpk-2, 1, -1 
    267 !$OMP DO schedule(static) private(jj, ji) 
    268237         DO jj = 2, jpjm1 
    269238            DO ji = fs_2, fs_jpim1 
    … …  
    279248      ! non zero value at the ocean bottom depending on the bottom friction used 
    280249      ! 
    281 !$OMP DO schedule(static) private(jk, jj, ji, ze3va, zzwi, zzws) 
    282250      DO jk = 1, jpkm1        ! Matrix 
    283251         DO jj = 2, jpjm1    
    … …  
    292260         END DO 
    293261      END DO 
    294 !$OMP DO schedule(static) private(jj, ji) 
    295262      DO jj = 2, jpjm1        ! Surface boundary conditions 
    296263         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    316283      ! 
    317284      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
    318 !$OMP DO schedule(static) private(jj, ji) 
    319285         DO jj = 2, jpjm1    
    320286            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    322288            END DO 
    323289         END DO 
    324 !$OMP END DO NOWAIT 
    325       END DO 
    326       ! 
    327 !$OMP DO schedule(static) private(jj, ji, ze3va) 
     290      END DO 
     291      ! 
    328292      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    329293         DO ji = fs_2, fs_jpim1   ! vector opt.           
    … …  
    334298      END DO 
    335299      DO jk = 2, jpkm1 
    336 !$OMP DO schedule(static) private(jj, ji) 
    337300         DO jj = 2, jpjm1 
    338301            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    342305      END DO 
    343306      ! 
    344 !$OMP DO schedule(static) private(jj, ji) 
    345307      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==! 
    346308         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    349311      END DO 
    350312      DO jk = jpk-2, 1, -1 
    351 !$OMP DO schedule(static) private(jj, ji) 
    352313         DO jj = 2, jpjm1 
    353314            DO ji = fs_2, fs_jpim1 
    … …  
    355316            END DO 
    356317         END DO 
    357 !$OMP END DO NOWAIT 
    358       END DO 
    359 !$OMP END PARALLEL  
     318      END DO 
    360319       
    361320      ! J. Chanut: Lines below are useless ? 
    … …  
    363322      !!gm  I almost sure it is !!!! 
    364323      IF( ln_bfrimp ) THEN 
    365 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    366324        DO jj = 2, jpjm1 
    367325           DO ji = 2, jpim1 
    … …  
    373331        END DO 
    374332        IF (ln_isfcav) THEN 
    375 !$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    376333           DO jj = 2, jpjm1 
    377334              DO ji = 2, jpim1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r7698 r7753  
    7272      INTEGER, INTENT(in) ::   kt   ! time step 
    7373      !  
    74       INTEGER  ::   jk, jj, ji            ! dummy loop indice 
     74      INTEGER  ::   jk            ! dummy loop indice 
    7575      REAL(wp) ::   z2dt, zcoef   ! local scalars 
    7676      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace 
    … …  
    9595      !                                           !------------------------------! 
    9696      IF(ln_wd) THEN 
    97         CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 
    98       END IF 
    99  
    100       CALL div_hor( kt )                              ! Horizontal divergence 
    101       ! 
    102 !$OMP PARALLEL 
    103 !$OMP DO schedule(static) private(jj, ji) 
    104       DO jj = 1, jpj 
    105          DO ji = 1, jpi 
    106             zhdiv(ji,jj) = 0._wp 
    107          END DO 
    108       END DO            
     97         CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 
     98      ENDIF 
     99 
     100      CALL div_hor( kt )                               ! Horizontal divergence 
     101      ! 
     102      zhdiv(:,:) = 0._wp 
    109103      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    110 !$OMP DO schedule(static) private(jj, ji) 
    111          DO jj = 1, jpj 
    112             DO ji = 1, jpi 
    113                zhdiv(ji,jj) = zhdiv(ji,jj) + e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) 
    114             END DO 
    115          END DO            
     104        zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
    116105      END DO 
    117106      !                                                ! Sea surface elevation time stepping 
    … …  
    119108      ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 
    120109      !  
    121 !$OMP DO schedule(static) private(jj, ji) 
    122       DO jj = 1, jpj 
    123          DO ji = 1, jpi 
    124             ssha(ji,jj) = (  sshb(ji,jj) - z2dt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) )  ) * ssmask(ji,jj) 
    125          END DO 
    126       END DO            
    127 !$OMP END PARALLEL 
     110      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
     111 
    128112      IF ( .NOT.ln_dynspg_ts ) THEN 
    129113         ! These lines are not necessary with time splitting since 
    … …  
    141125      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN     ! Include the IAU weighted SSH increment 
    142126         CALL ssh_asm_inc( kt ) 
    143 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    144          DO jj = 1, jpj 
    145             DO ji = 1, jpi 
    146                ssha(ji,jj) = ssha(ji,jj) + z2dt * ssh_iau(ji,jj) 
    147             END DO 
    148          END DO            
     127         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
    149128      ENDIF 
    150129#endif 
    … …  
    192171         IF(lwp) WRITE(numout,*) '~~~~~ ' 
    193172         ! 
    194 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    195          DO jj = 1, jpj 
    196             DO ji = 1, jpi 
    197                wn(ji,jj,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
    198             END DO 
    199          END DO            
     173         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
    200174      ENDIF 
    201175      !                                           !------------------------------! 
    … …  
    207181      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases 
    208182         CALL wrk_alloc( jpi, jpj, jpk, zhdiv )  
    209 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    210183         ! 
    211184         DO jk = 1, jpkm1 
    … …  
    223196         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    224197            ! computation of w 
    225 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    226             DO jj = 1, jpj 
    227                DO ji = 1, jpi   ! vector opt. 
    228                   wn(ji,jj,jk) = wn(ji,jj,jk+1) - ( e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) + zhdiv(ji,jj,jk)    & 
    229                   &                         + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) )     ) * tmask(ji,jj,jk) 
    230                END DO 
    231             END DO 
     198            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    & 
     199               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )     ) * tmask(:,:,jk) 
    232200         END DO 
    233201         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 
    … …  
    235203      ELSE   ! z_star and linear free surface cases 
    236204         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    237 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    238             DO jj = 1, jpj 
    239                DO ji = 1, jpi   ! vector opt. 
    240                   ! computation of w 
    241                   wn(ji,jj,jk) = wn(ji,jj,jk+1) - (  e3t_n(ji,jj,jk) * hdivn(ji,jj,jk)                 & 
    242                   &                         + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) )  ) * tmask(ji,jj,jk) 
    243                 END DO 
    244             END DO 
     205            ! computation of w 
     206            wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 & 
     207               &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk) 
    245208         END DO 
    246209      ENDIF 
    247210 
    248211      IF( ln_bdy ) THEN 
    249 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    250212         DO jk = 1, jpkm1 
    251             DO jj = 1, jpj 
    252                DO ji = 1, jpi 
    253                   wn(ji,jj,jk) = wn(ji,jj,jk) * bdytmask(ji,jj) 
    254                END DO 
    255             END DO 
     213            wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
    256214         END DO 
    257215      ENDIF 
    … …  
    283241      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    284242      ! 
    285       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    286243      REAL(wp) ::   zcoef   ! local scalar 
    287244      !!---------------------------------------------------------------------- 
    … …  
    297254      IF(  ( neuler == 0 .AND. kt == nit000 ) .OR.    & 
    298255         & ( ln_bt_fw    .AND. ln_dynspg_ts )      ) THEN  
    299 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    300          DO jj = 1, jpj 
    301             DO ji = 1, jpi 
    302                sshb(ji,jj) = sshn(ji,jj)                              ! before <-- now 
    303                sshn(ji,jj) = ssha(ji,jj)                              ! now    <-- after  (before already = now) 
    304             END DO 
    305          END DO            
     256         sshb(:,:) = sshn(:,:)                              ! before <-- now 
     257         sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now) 
    306258         ! 
    307259      ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==! 
    308260         !                                                  ! before <-- now filtered 
    309 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    310          DO jj = 1, jpj 
    311             DO ji = 1, jpi 
    312                sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) 
    313             END DO 
    314          END DO            
     261         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 
    315262         IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed 
    316263            zcoef = atfp * rdt * r1_rau0 
    317 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    318             DO jj = 1, jpj 
    319                DO ji = 1, jpi 
    320                   sshb(ji,jj) = sshb(ji,jj) - zcoef * (     emp_b(ji,jj) - emp   (ji,jj)   & 
    321                   &                             -    rnf_b(ji,jj) + rnf   (ji,jj)   & 
    322                   &                             + fwfisf_b(ji,jj) - fwfisf(ji,jj)   ) * ssmask(ji,jj) 
    323                END DO 
    324             END DO            
     264            sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   & 
     265               &                             -    rnf_b(:,:) + rnf   (:,:)   & 
     266               &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:) 
    325267         ENDIF 
    326 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    327          DO jj = 1, jpj 
    328             DO ji = 1, jpi 
    329                sshn(ji,jj) = ssha(ji,jj)                              ! now <-- after 
    330             END DO 
    331          END DO            
     268         sshn(:,:) = ssha(:,:)                              ! now <-- after 
    332269      ENDIF 
    333270      ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r7698 r7753  
    8585      first_width (:) = SQRT(  rn_initial_mass(:) / ( rn_LoW_ratio * rn_rho_bergs * rn_initial_thickness(:) )  ) 
    8686      first_length(:) = rn_LoW_ratio * first_width(:) 
    87 !$OMP PARALLEL 
    88 !$OMP DO schedule(static) private(jj, ji) 
    89       DO jj = 1, jpj 
    90          DO ji = 1, jpi 
    91             berg_grid%calving      (ji,jj)   = 0._wp 
    92             berg_grid%calving_hflx (ji,jj)   = 0._wp 
    93             berg_grid%stored_heat  (ji,jj)   = 0._wp 
    94             berg_grid%floating_melt(ji,jj)   = 0._wp 
    95             berg_grid%maxclass     (ji,jj)   = nclasses 
    96             berg_grid%tmp          (ji,jj)   = 0._wp 
    97             src_calving            (ji,jj)   = 0._wp 
    98             src_calving_hflx       (ji,jj)   = 0._wp 
    99          END DO 
    100       END DO 
    101       DO jn = 1, nclasses 
    102 !$OMP DO schedule(static) private(jj, ji) 
    103          DO jj = 1, jpj 
    104             DO ji = 1, jpi 
    105                berg_grid%stored_ice   (ji,jj,jn) = 0._wp 
    106             END DO 
    107          END DO 
    108       END DO 
    109 !$OMP END PARALLEL 
     87 
     88      berg_grid%calving      (:,:)   = 0._wp 
     89      berg_grid%calving_hflx (:,:)   = 0._wp 
     90      berg_grid%stored_heat  (:,:)   = 0._wp 
     91      berg_grid%floating_melt(:,:)   = 0._wp 
     92      berg_grid%maxclass     (:,:)   = nclasses 
     93      berg_grid%stored_ice   (:,:,:) = 0._wp 
     94      berg_grid%tmp          (:,:)   = 0._wp 
     95      src_calving            (:,:)   = 0._wp 
     96      src_calving_hflx       (:,:)   = 0._wp 
     97 
    11098      !                          ! domain for icebergs 
    11199      IF( lk_mpp .AND. jpni == 1 )   CALL ctl_stop( 'icbinit: having ONE processor in x currently does not work' ) 
    … …  
    120108      nicbfldproc(:) = -1 
    121109 
    122 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    123110      DO jj = 1, jpj 
    124111         DO ji = 1, jpi 
    … …  
    231218         CALL flush(numicb) 
    232219      ENDIF 
    233 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    234       DO jj = 1, jpj 
    235          DO ji = 1, jpi 
    236             src_calving     (ji,jj) = 0._wp 
    237             src_calving_hflx(ji,jj) = 0._wp 
    238          END DO 
    239       END DO 
     220       
     221      src_calving     (:,:) = 0._wp 
     222      src_calving_hflx(:,:) = 0._wp 
     223 
    240224      ! assign each new iceberg with a unique number constructed from the processor number 
    241225      ! and incremented by the total number of processors 
    … …  
    252236         IF( ivar > 0 ) THEN 
    253237            CALL iom_get  ( inum, jpdom_data, 'maxclass', src_calving )   ! read the max distribution array 
    254 !$OMP PARALLEL 
    255 !$OMP DO schedule(static) private(jj, ji) 
    256             DO jj = 1, jpj 
    257                DO ji = 1, jpi 
    258                   berg_grid%maxclass(ji,jj) = INT( src_calving(ji,jj) ) 
    259                END DO 
    260             END DO 
    261 !$OMP DO schedule(static) private(jj, ji) 
    262             DO jj = 1, jpj 
    263                DO ji = 1, jpi 
    264                   src_calving(ji,jj) = 0._wp 
    265                END DO 
    266             END DO 
    267 !$OMP END PARALLEL 
     238            berg_grid%maxclass(:,:) = INT( src_calving ) 
     239            src_calving(:,:) = 0._wp 
    268240         ENDIF 
    269241         CALL iom_close( inum )                                     ! close file 

  • trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r7698 r7753  
    381381         ! 
    382382         ! WARNING ptab is defined only between nld and nle 
    383 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    384383         DO jk = 1, jpk 
    385384            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    … …  
    400399         !                                        !* Cyclic east-west 
    401400         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    402 !$OMP PARALLEL DO schedule(static) private(jk, jj) 
    403             DO jk = 1, jpk 
    404                DO jj = 1, jpj 
    405                   ptab( 1 ,jj,jk) = ptab(jpim1,jj,jk) 
    406                   ptab(jpi,jj,jk) = ptab(  2  ,jj,jk) 
    407                END DO 
    408             END DO 
     401            ptab( 1 ,:,:) = ptab(jpim1,:,:) 
     402            ptab(jpi,:,:) = ptab(  2  ,:,:) 
    409403         ELSE                                     !* closed 
    410             IF( .NOT. cd_type == 'F' ) THEN 
    411 !$OMP PARALLEL DO schedule(static) private(jk, jj) 
    412                DO jk = 1, jpk 
    413                   DO jj = 1, jpj 
    414                      ptab(     1       :jpreci,jj,jk) = zland    ! south except F-point 
    415                   END DO 
    416                END DO 
    417             END IF 
    418 !$OMP PARALLEL DO schedule(static) private(jk, jj) 
    419             DO jk = 1, jpk 
    420                DO jj = 1, jpj 
    421                   ptab(nlci-jpreci+1:jpi   ,jj,jk) = zland    ! north 
    422                END DO 
    423             END DO 
     404            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
     405                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
    424406         ENDIF 
    425407                                          ! North-south cyclic 
    426408         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south only with no mpp split in latitude 
    427 !$OMP PARALLEL DO schedule(static) private(jk, ji) 
    428             DO jk = 1, jpk 
    429                DO ji = 1, jpi 
    430                   ptab(ji,1 , jk) = ptab(ji, jpjm1,jk) 
    431                   ptab(ji,jpj,jk) = ptab(ji,     2,jk) 
    432                END DO 
    433             END DO 
     409            ptab(:,1 , :) = ptab(:, jpjm1,:) 
     410            ptab(:,jpj,:) = ptab(:,     2,:) 
    434411         ELSE   !                                   ! North-South boundaries (closed) 
    435             IF( .NOT. cd_type == 'F' )   THEN 
    436 !$OMP PARALLEL DO schedule(static) private(jk, ji) 
    437                DO jk = 1, jpk 
    438                   DO ji = 1, jpi 
    439                      ptab(ji,     1       :jprecj,jk) = zland       ! south except F-point 
    440                   END DO 
    441                END DO 
    442             END IF 
    443 !$OMP PARALLEL DO schedule(static) private(jk, ji) 
    444             DO jk = 1, jpk 
    445                DO ji = 1, jpi 
    446                   ptab(ji,nlcj-jprecj+1:jpj   ,jk) = zland       ! north 
    447                END DO 
    448             END DO 
     412            IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
     413                                         ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
    449414         ENDIF 
    450415         ! 
    … …  
    458423      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    459424         iihom = nlci-nreci 
    460 !$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 
    461          DO jk = 1, jpk 
    462             DO jj = 1, jpj 
    463                DO jl = 1, jpreci 
    464                   zt3ew(jj,jl,jk,1) = ptab(jpreci+jl,jj,jk) 
    465                   zt3we(jj,jl,jk,1) = ptab(iihom +jl,jj,jk) 
    466                END DO 
    467             END DO 
     425         DO jl = 1, jpreci 
     426            zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 
     427            zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
    468428         END DO 
    469429      END SELECT 
    … …  
    495455      SELECT CASE ( nbondi ) 
    496456      CASE ( -1 ) 
    497 !$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 
    498          DO jk = 1, jpk 
    499             DO jl = 1, jpreci 
    500                DO jj = 1, jpj 
    501                   ptab(iihom+jl,jj,jk) = zt3ew(jj,jl,jk,2) 
    502                END DO 
    503             END DO 
    504          END DO 
    505       CASE ( 0 ) 
    506 !$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 
    507          DO jk = 1, jpk 
    508             DO jl = 1, jpreci 
    509                DO jj = 1, jpj 
    510                   ptab(jl      ,jj,jk) = zt3we(jj,jl,jk,2) 
    511                   ptab(iihom+jl,jj,jk) = zt3ew(jj,jl,jk,2) 
    512                END DO 
    513             END DO 
    514          END DO 
    515       CASE ( 1 ) 
    516 !$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 
    517          DO jk = 1, jpk 
    518             DO jl = 1, jpreci 
    519                DO jj = 1, jpj 
    520                   ptab(jl      ,jj,jk) = zt3we(jj,jl,jk,2) 
    521                END DO 
    522             END DO 
     457         DO jl = 1, jpreci 
     458            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
     459         END DO 
     460      CASE ( 0 ) 
     461         DO jl = 1, jpreci 
     462            ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
     463            ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
     464         END DO 
     465      CASE ( 1 ) 
     466         DO jl = 1, jpreci 
     467            ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
    523468         END DO 
    524469      END SELECT 
    … …  
    530475      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    531476         ijhom = nlcj-nrecj 
    532 !$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 
    533          DO jk = 1, jpk 
    534             DO jl = 1, jprecj 
    535                DO ji = 1, jpi 
    536                   zt3sn(ji,jl,jk,1) = ptab(ji,ijhom +jl,jk) 
    537                   zt3ns(ji,jl,jk,1) = ptab(ji,jprecj+jl,jk) 
    538                END DO 
    539             END DO 
     477         DO jl = 1, jprecj 
     478            zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 
     479            zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 
    540480         END DO 
    541481      ENDIF 
    … …  
    567507      SELECT CASE ( nbondj ) 
    568508      CASE ( -1 ) 
    569 !$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 
    570          DO jk = 1, jpk 
    571             DO jl = 1, jprecj 
    572                DO ji = 1, jpi 
    573                   ptab(ji,ijhom+jl,jk) = zt3ns(ji,jl,jk,2) 
    574                END DO 
    575             END DO 
    576          END DO 
    577       CASE ( 0 ) 
    578 !$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 
    579          DO jk = 1, jpk 
    580             DO jl = 1, jprecj 
    581                DO ji = 1, jpi 
    582                   ptab(ji,jl      ,jk) = zt3sn(ji,jl,jk,2) 
    583                   ptab(ji,ijhom+jl,jk) = zt3ns(ji,jl,jk,2) 
    584                END DO 
    585             END DO 
    586          END DO 
    587       CASE ( 1 ) 
    588 !$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 
    589          DO jk = 1, jpk 
    590             DO jl = 1, jprecj 
    591                DO ji = 1, jpi 
    592                   ptab(ji,jl,jk) = zt3sn(ji,jl,jk,2) 
    593                END DO 
    594             END DO 
     509         DO jl = 1, jprecj 
     510            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
     511         END DO 
     512      CASE ( 0 ) 
     513         DO jl = 1, jprecj 
     514            ptab(:,jl      ,:) = zt3sn(:,jl,:,2) 
     515            ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
     516         END DO 
     517      CASE ( 1 ) 
     518         DO jl = 1, jprecj 
     519            ptab(:,jl,:) = zt3sn(:,jl,:,2) 
    595520         END DO 
    596521      END SELECT 
    … …  
    992917      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    993918         iihom = nlci-nreci 
    994 !$OMP PARALLEL DO schedule(static) private(jj,jl) 
    995          DO jj = 1, jpj 
    996             DO jl = 1, jpreci 
    997                zt2ew(jj,jl,1) = pt2d(jpreci+jl,jj) 
    998                zt2we(jj,jl,1) = pt2d(iihom +jl,jj) 
    999             END DO 
     919         DO jl = 1, jpreci 
     920            zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 
     921            zt2we(:,jl,1) = pt2d(iihom +jl,:) 
    1000922         END DO 
    1001923      END SELECT 
    … …  
    1027949      SELECT CASE ( nbondi ) 
    1028950      CASE ( -1 ) 
    1029 !$OMP PARALLEL DO schedule(static) private(jj,jl) 
    1030951         DO jl = 1, jpreci 
    1031             DO jj = 1, jpj 
    1032                pt2d(iihom+jl,jj) = zt2ew(jj,jl,2) 
    1033             END DO 
    1034          END DO 
    1035       CASE ( 0 ) 
    1036 !$OMP PARALLEL DO schedule(static) private(jj,jl) 
     952            pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
     953         END DO 
     954      CASE ( 0 ) 
    1037955         DO jl = 1, jpreci 
    1038             DO jj = 1, jpj 
    1039                pt2d(jl      ,jj) = zt2we(jj,jl,2) 
    1040                pt2d(iihom+jl,jj) = zt2ew(jj,jl,2) 
    1041             END DO 
    1042          END DO 
    1043       CASE ( 1 ) 
    1044 !$OMP PARALLEL DO schedule(static) private(jj,jl) 
     956            pt2d(jl      ,:) = zt2we(:,jl,2) 
     957            pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
     958         END DO 
     959      CASE ( 1 ) 
    1045960         DO jl = 1, jpreci 
    1046             DO jj = 1, jpj 
    1047                pt2d(jl      ,jj) = zt2we(jj,jl,2) 
    1048             END DO 
     961            pt2d(jl      ,:) = zt2we(:,jl,2) 
    1049962         END DO 
    1050963      END SELECT 
    … …  
    1057970      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    1058971         ijhom = nlcj-nrecj 
    1059 !$OMP PARALLEL DO schedule(static) private(ji,jl) 
    1060972         DO jl = 1, jprecj 
    1061             DO ji = 1, jpi 
    1062                zt2sn(ji,jl,1) = pt2d(ji,ijhom +jl) 
    1063                zt2ns(ji,jl,1) = pt2d(ji,jprecj+jl) 
    1064             END DO 
     973            zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 
     974            zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 
    1065975         END DO 
    1066976      ENDIF 
    … …  
    10921002      SELECT CASE ( nbondj ) 
    10931003      CASE ( -1 ) 
    1094 !$OMP PARALLEL DO schedule(static) private(ji,jl) 
    10951004         DO jl = 1, jprecj 
    1096             DO ji = 1, jpi 
    1097                pt2d(ji,ijhom+jl) = zt2ns(ji,jl,2) 
    1098             END DO 
    1099          END DO 
    1100       CASE ( 0 ) 
    1101 !$OMP PARALLEL DO schedule(static) private(ji,jl) 
     1005            pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
     1006         END DO 
     1007      CASE ( 0 ) 
    11021008         DO jl = 1, jprecj 
    1103             DO ji = 1, jpi 
    1104                pt2d(ji,jl      ) = zt2sn(ji,jl,2) 
    1105                pt2d(ji,ijhom+jl) = zt2ns(ji,jl,2) 
    1106             END DO 
    1107          END DO 
    1108       CASE ( 1 ) 
    1109 !$OMP PARALLEL DO schedule(static) private(ji,jl) 
     1009            pt2d(:,jl      ) = zt2sn(:,jl,2) 
     1010            pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
     1011         END DO 
     1012      CASE ( 1 ) 
    11101013         DO jl = 1, jprecj 
    1111             DO ji = 1, jpi 
    1112                pt2d(ji,jl      ) = zt2sn(ji,jl,2) 
    1113             END DO 
     1014            pt2d(:,jl      ) = zt2sn(:,jl,2) 
    11141015         END DO 
    11151016      END SELECT 

  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfc1d_c2d.F90

    r7698 r7753  
    148148            IF(lwp) WRITE(numout,*) '              momentum laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 
    149149            za00 = pah0 / zd_max 
    150 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    151150            DO jj = 1, jpj  
    152151               DO ji = 1, jpi  
    … …  
    160159            IF(lwp) WRITE(numout,*) '              momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 
    161160            za00 = pah0 / ( zd_max * zd_max * zd_max ) 
    162 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    163161            DO jj = 1, jpj 
    164162               DO ji = 1, jpi 
    … …  
    173171         ENDIF 
    174172         !                                !  deeper values  (LAP and BLP cases) 
    175 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    176173         DO jk = 2, jpk 
    177             DO jj = 1, jpj 
    178                DO ji = 1, jpi 
    179                   pah1(ji,jj,jk) = pah1(ji,jj,1) * tmask(ji,jj,jk)  
    180                   pah2(ji,jj,jk) = pah2(ji,jj,1) * fmask(ji,jj,jk)  
    181                END DO 
    182             END DO 
     174            pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk)  
     175            pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk)  
    183176         END DO 
    184177         ! 
    … …  
    187180            IF(lwp) WRITE(numout,*) '              tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 
    188181            za00 = pah0 / zd_max 
    189 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    190182            DO jj = 1, jpj  
    191183               DO ji = 1, jpi  
    … …  
    199191            IF(lwp) WRITE(numout,*) '              tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 
    200192            za00 = pah0 / ( zd_max * zd_max * zd_max ) 
    201 !$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    202193            DO jj = 1, jpj 
    203194               DO ji = 1, jpi 
    … …  
    212203         ENDIF 
    213204         !                                !  deeper values  (LAP and BLP cases) 
    214 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    215205         DO jk = 2, jpk 
    216             DO jj = 1, jpj 
    217                DO ji = 1, jpi 
    218                   pah1(ji,jj,jk) = pah1(ji,jj,1) * umask(ji,jj,jk)  
    219                   pah2(ji,jj,jk) = pah2(ji,jj,1) * vmask(ji,jj,jk)  
    220                END DO 
    221             END DO 
     206            pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk)  
     207            pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk)  
    222208         END DO 
    223209         ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r7698 r7753  
    155155      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 
    156156      ! 
    157 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    158       DO jj = 1, jpj 
    159          DO ji = 1, jpi 
    160             ahmt(ji,jj,jpk) = 0._wp                           ! last level always 0   
    161             ahmf(ji,jj,jpk) = 0._wp 
    162          END DO 
    163       END DO 
     157      ahmt(:,:,jpk) = 0._wp                           ! last level always 0   
     158      ahmf(:,:,jpk) = 0._wp 
    164159      ! 
    165160      !                                               ! value of eddy mixing coef. 
    … …  
    178173         CASE(   0  )      !==  constant  ==! 
    179174            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant ' 
    180 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    181             DO jk = 1, jpk 
    182                DO jj = 1, jpj 
    183                   DO ji = 1, jpi 
    184                      ahmt(ji,jj,jk) = zah0 * tmask(ji,jj,jk) 
    185                      ahmf(ji,jj,jk) = zah0 * fmask(ji,jj,jk) 
    186                   END DO 
    187                END DO 
    188             END DO 
     175            ahmt(:,:,:) = zah0 * tmask(:,:,:) 
     176            ahmf(:,:,:) = zah0 * fmask(:,:,:) 
    189177            ! 
    190178         CASE(  10  )      !==  fixed profile  ==! 
    191179            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )' 
    192 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    193             DO jj = 1, jpj 
    194                DO ji = 1, jpi 
    195                   ahmt(ji,jj,1) = zah0 * tmask(ji,jj,1)            ! constant surface value 
    196                   ahmf(ji,jj,1) = zah0 * fmask(ji,jj,1) 
    197                END DO 
    198             END DO 
     180            ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value 
     181            ahmf(:,:,1) = zah0 * fmask(:,:,1) 
    199182            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 
    200183            ! 
    … …  
    208191!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 
    209192!!              better:  check that the max is <=1  i.e. it is a shape from 0 to 1, not a coef that has physical dimension 
    210 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    211193            DO jk = 2, jpkm1 
    212                DO jj = 1, jpj 
    213                   DO ji = 1, jpi 
    214                      ahmt(ji,jj,jk) = ahmt(ji,jj,1) * tmask(ji,jj,jk) 
    215                      ahmf(ji,jj,jk) = ahmf(ji,jj,1) * fmask(ji,jj,jk) 
    216                   END DO 
    217                END DO 
     194               ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 
     195               ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 
    218196            END DO 
    219197            ! 
    … …  
    231209!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ???? 
    232210!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 
    233 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    234211            DO jk = 1, jpkm1 
    235                DO jj = 1, jpj 
    236                   DO ji = 1, jpi 
    237                      ahmt(ji,jj,jk) = ahmt(ji,jj,jk) * tmask(ji,jj,jk) 
    238                      ahmf(ji,jj,jk) = ahmf(ji,jj,jk) * fmask(ji,jj,jk) 
    239                   END DO 
    240                END DO 
     212               ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 
     213               ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 
    241214            END DO 
    242215            ! 
    … …  
    266239            ! 
    267240            ! Set local gridscale values 
    268 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    269241            DO jj = 2, jpjm1 
    270242               DO ji = fs_2, fs_jpim1 
    … …  
    279251         ! 
    280252         IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN       ! bilapcian and no time variation: 
    281 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    282             DO jk = 1, jpk 
    283                DO jj = 1, jpj 
    284                   DO ji = 1, jpi 
    285                      ahmt(ji,jj,jk) = SQRT( ahmt(ji,jj,jk) )      ! take the square root of the coefficient 
    286                      ahmf(ji,jj,jk) = SQRT( ahmf(ji,jj,jk) ) 
    287                   END DO 
    288                END DO 
    289             END DO 
     253            ahmt(:,:,:) = SQRT( ahmt(:,:,:) )                     ! take the square root of the coefficient 
     254            ahmf(:,:,:) = SQRT( ahmf(:,:,:) ) 
    290255         ENDIF 
    291256         ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r7698 r7753  
    135135      z1_slpmax = 1._wp / rn_slpmax 
    136136      ! 
    137 !$OMP PARALLEL 
    138 !$OMP DO schedule(static) private(jk, jj, ji) 
    139       DO jk = 1, jpk 
    140          DO jj = 1, jpj 
    141             DO ji = 1, jpi 
    142                zww(ji,jj,jk) = 0._wp 
    143                zwz(ji,jj,jk) = 0._wp 
    144             END DO 
    145          END DO 
    146       END DO 
    147 !$OMP END DO NOWAIT 
    148       ! 
    149 !$OMP DO schedule(static) private(jk, jj, ji) 
     137      zww(:,:,:) = 0._wp 
     138      zwz(:,:,:) = 0._wp 
     139      ! 
    150140      DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
    151141         DO jj = 1, jpjm1 
    … …  
    156146         END DO 
    157147      END DO 
    158 !$OMP END PARALLEL 
    159148      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
    160 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    161149         DO jj = 1, jpjm1 
    162150            DO ji = 1, jpim1 
    … …  
    167155      ENDIF 
    168156      IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level 
    169 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    170157         DO jj = 1, jpjm1 
    171158            DO ji = 1, jpim1 
    … …  
    176163      ENDIF 
    177164      ! 
    178 !$OMP PARALLEL 
    179 !$OMP DO schedule(static) private(jj, ji) 
    180          DO jj = 1, jpj 
    181             DO ji = 1, jpi 
    182                zdzr(ji,jj,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    183             END DO 
    184          END DO 
    185 !$OMP DO schedule(static) private(jk,jj,ji) 
     165      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
    186166      DO jk = 2, jpkm1 
    187167         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    … …  
    190170         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
    191171         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
    192          DO jj = 1, jpj 
    193             DO ji = 1, jpi 
    194                zdzr(ji,jj,jk) = zm1_g * ( prd(ji,jj,jk) + 1._wp )              & 
    195                     &                 * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) ) * ( 1._wp - 0.5_wp * tmask(ji,jj,jk+1) ) 
    196             END DO 
    197          END DO 
    198       END DO 
    199 !$OMP END PARALLEL 
     172         zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              & 
     173            &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 
     174      END DO 
    200175      ! 
    201176      !                          !==   Slopes just below the mixed layer   ==! 
    … …  
    207182      ! 
    208183      IF ( ln_isfcav ) THEN 
    209 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    210184         DO jj = 2, jpjm1 
    211185            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    217191         END DO 
    218192      ELSE 
    219 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    220193         DO jj = 2, jpjm1 
    221194            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    226199      END IF 
    227200 
    228 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zau, zav, zbu, zbv, zfj, zfi, zdepu, zdepv) 
    229201      DO jk = 2, jpkm1                            !* Slopes at u and v points 
    230202         DO jj = 2, jpjm1 
    … …  
    267239      ! 
    268240      !                                            !* horizontal Shapiro filter 
    269 !$OMP PARALLEL  
    270 !$OMP DO schedule(static) private(jk, jj, ji) 
    271241      DO jk = 2, jpkm1 
    272242         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    … …  
    313283      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
    314284      ! 
    315 !$OMP DO schedule(static) private(jk, jj, ji, zbw, zfk, zck, zbi, zbj, zai, zaj, zci, zcj) 
    316285      DO jk = 2, jpkm1 
    317286         DO jj = 2, jpjm1 
    … …  
    349318         END DO 
    350319      END DO 
    351 !$OMP END PARALLEL 
    352320      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions 
    353321      ! 
    354322      !                                           !* horizontal Shapiro filter 
    355 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcofw, zck) 
    356323      DO jk = 2, jpkm1 
    357324         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    … …  
    703670      z1_slpmax = 1._wp / rn_slpmax 
    704671      ! 
    705 !$OMP PARALLEL 
    706 !$OMP DO schedule(static) private(jj)        
    707       DO jj = 1, jpj 
    708          uslpml (1,jj) = 0._wp      ;      uslpml (jpi,jj) = 0._wp 
    709          vslpml (1,jj) = 0._wp      ;      vslpml (jpi,jj) = 0._wp 
    710          wslpiml(1,jj) = 0._wp      ;      wslpiml(jpi,jj) = 0._wp 
    711          wslpjml(1,jj) = 0._wp      ;      wslpjml(jpi,jj) = 0._wp 
    712       END DO 
     672      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp 
     673      vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp 
     674      wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp 
     675      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp 
    713676      ! 
    714677      !                                            !==   surface mixed layer mask   ! 
    715 !$OMP DO schedule(static) private(jk, jj, ji, ik) 
    716678      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    717679         DO jj = 1, jpj 
    … …  
    724686         END DO 
    725687      END DO 
    726 !$OMP END DO NOWAIT 
    727688 
    728689 
    … …  
    737698      !----------------------------------------------------------------------- 
    738699      ! 
    739 !$OMP DO schedule(static) private(jj, ji, iku, ikv, zbu, zbv, zau, zav, ik, ikm1, zbw, zci, zcj, zai, zaj, zbi, zbj)  
    740700      DO jj = 2, jpjm1 
    741701         DO ji = 2, jpim1 
    … …  
    782742         END DO 
    783743      END DO 
    784 !$OMP END PARALLEL 
    785744      !!gm this lbc_lnk should be useless.... 
    786745      CALL lbc_lnk( uslpml , 'U', -1. )   ;   CALL lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change) 
    … …  
    832791         ! Direction of lateral diffusion (tracers and/or momentum) 
    833792         ! ------------------------------ 
    834  
    835 !$OMP PARALLEL 
    836 !$OMP DO schedule(static) private(jk, jj, ji)    
    837         DO jk = 1, jpk 
    838            DO jj = 1, jpj 
    839               DO ji = 1, jpi 
    840                  uslp (ji,jj,jk) = 0._wp 
    841                  vslp (ji,jj,jk) = 0._wp 
    842                  wslpi(ji,jj,jk) = 0._wp 
    843                  wslpj(ji,jj,jk) = 0._wp 
    844               END DO 
    845            END DO 
    846         END DO 
    847 !$OMP END DO NOWAIT 
    848 !$OMP DO schedule(static) private(jj, ji)        
    849         DO jj = 1, jpj 
    850             DO ji = 1, jpi 
    851                uslpml (ji,jj) = 0._wp 
    852                vslpml (ji,jj) = 0._wp 
    853                wslpiml(ji,jj) = 0._wp 
    854                wslpjml(ji,jj) = 0._wp 
    855              END DO 
    856         END DO 
    857 !$OMP END PARALLEL 
     793         uslp (:,:,:) = 0._wp   ;   uslpml (:,:) = 0._wp      ! set the slope to zero (even in s-coordinates) 
     794         vslp (:,:,:) = 0._wp   ;   vslpml (:,:) = 0._wp 
     795         wslpi(:,:,:) = 0._wp   ;   wslpiml(:,:) = 0._wp 
     796         wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp 
     797 
    858798         !!gm I no longer understand this..... 
    859799!!gm         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN 

  • trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r7698 r7753  
    116116      !!              aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 
    117117      !!---------------------------------------------------------------------- 
    118       INTEGER  ::   jk, jj, ji        ! dummy loop indices 
     118      INTEGER  ::   jk                ! dummy loop indices 
    119119      INTEGER  ::   ierr, inum, ios   ! local integer 
    120120      REAL(wp) ::   zah0              ! local scalar 
    … …  
    184184      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 
    185185      ! 
    186 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    187       DO jj = 1, jpj 
    188          DO ji = 1, jpi 
    189             ahtu(ji,jj,jpk) = 0._wp                           ! last level always 0   
    190             ahtv(ji,jj,jpk) = 0._wp 
    191          END DO 
    192       END DO 
     186      ahtu(:,:,jpk) = 0._wp                           ! last level always 0   
     187      ahtv(:,:,jpk) = 0._wp 
    193188      ! 
    194189      !                                               ! value of eddy mixing coef. 
    … …  
    205200         CASE(   0  )      !==  constant  ==! 
    206201            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0 
    207 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    208             DO jk = 1, jpk 
    209                DO jj = 1, jpj 
    210                   DO ji = 1, jpi 
    211                      ahtu(ji,jj,jk) = zah0 * umask(ji,jj,jk) 
    212                      ahtv(ji,jj,jk) = zah0 * vmask(ji,jj,jk) 
    213                   END DO 
    214                END DO 
    215             END DO 
     202            ahtu(:,:,:) = zah0 * umask(:,:,:) 
     203            ahtv(:,:,:) = zah0 * vmask(:,:,:) 
    216204            ! 
    217205         CASE(  10  )      !==  fixed profile  ==! 
    218206            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
    219 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    220             DO jj = 1, jpj 
    221                DO ji = 1, jpi 
    222                   ahtu(ji,jj,1) = zah0 * umask(ji,jj,1)                      ! constant surface value 
    223                   ahtv(ji,jj,1) = zah0 * vmask(ji,jj,1) 
    224                END DO 
    225             END DO 
     207            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value 
     208            ahtv(:,:,1) = zah0 * vmask(:,:,1) 
    226209            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 
    227210            ! 
    … …  
    232215            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 
    233216            CALL iom_close( inum ) 
    234 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    235217            DO jk = 2, jpkm1 
    236                DO jj = 1, jpj 
    237                   DO ji = 1, jpi 
    238                      ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 
    239                      ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 
    240                   END DO 
    241                END DO 
     218               ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     219               ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
    242220            END DO 
    243221            ! 
    … …  
    266244            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 
    267245            CALL iom_close( inum ) 
    268 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    269246            DO jk = 1, jpkm1 
    270                DO jj = 1, jpj 
    271                   DO ji = 1, jpi 
    272                      ahtu(ji,jj,jk) = ahtu(ji,jj,jk) * umask(ji,jj,jk) 
    273                      ahtv(ji,jj,jk) = ahtv(ji,jj,jk) * vmask(ji,jj,jk) 
    274                   END DO 
    275                END DO 
     247               ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 
     248               ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 
    276249            END DO 
    277250            ! 
    … …  
    294267         ! 
    295268         IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 
    296 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    297             DO jk = 1, jpk 
    298                DO jj = 1, jpj 
    299                   DO ji = 1, jpi 
    300                      ahtu(ji,jj,jk) = SQRT( ahtu(ji,jj,jk) ) 
    301                      ahtv(ji,jj,jk) = SQRT( ahtv(ji,jj,jk) ) 
    302                   END DO 
    303                END DO 
    304             END DO 
     269            ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 
     270            ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 
    305271         ENDIF 
    306272         ! 
    … …  
    347313         !                                             !   increase to rn_aht_0 within 20N-20S 
    348314         IF( ln_ldfeiv .AND. nn_aei_ijk_t == 21 ) THEN   ! use the already computed aei. 
    349 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    350             DO jj = 1, jpj 
    351                DO ji = 1, jpi 
    352                   ahtu(ji,jj,1) = aeiu(ji,jj,1) 
    353                   ahtv(ji,jj,1) = aeiv(ji,jj,1) 
    354                END DO 
    355             END DO 
     315            ahtu(:,:,1) = aeiu(:,:,1) 
     316            ahtv(:,:,1) = aeiv(:,:,1) 
    356317         ELSE                                            ! compute aht.  
    357318            CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) 
    … …  
    360321         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )      ! 1 / ff(20 degrees)    
    361322         zaht_min = 0.2_wp * rn_aht_0                                      ! minimum value for aht 
    362 !$OMP PARALLEL 
    363 !$OMP DO schedule(static) private(jj,ji,zaht,zahf) 
    364323         DO jj = 1, jpj 
    365324            DO ji = 1, jpi 
    … …  
    372331            END DO 
    373332         END DO 
    374 !$OMP DO schedule(static) private(jk,jj,ji) 
    375333         DO jk = 2, jpkm1                             ! deeper value = surface value 
    376             DO jj = 1, jpj 
    377                DO ji = 1, jpi 
    378                   ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 
    379                   ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 
    380                END DO 
    381             END DO 
    382          END DO 
    383 !$OMP END PARALLEL 
     334            ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     335            ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
     336         END DO 
    384337         ! 
    385338      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity ) 
    386339         IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12 
    387 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    388340            DO jk = 1, jpkm1 
    389                DO jj = 1, jpj 
    390                   DO ji = 1, jpi 
    391                      ahtu(ji,jj,jk) = ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12 
    392                      ahtv(ji,jj,jk) = ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12 
    393                   END DO 
    394                END DO 
     341               ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 
     342               ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 
    395343            END DO 
    396344         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e 
    397 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    398345            DO jk = 1, jpkm1 
    399                DO jj = 1, jpj 
    400                   DO ji = 1, jpi 
    401                      ahtu(ji,jj,jk) = SQRT(  ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12  ) * e1u(ji,jj) 
    402                      ahtv(ji,jj,jk) = SQRT(  ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12  ) * e2v(ji,jj) 
    403                   END DO 
    404                END DO 
     346               ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:) 
     347               ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:) 
    405348            END DO 
    406349         ENDIF 
    … …  
    435378      !!               l_ldfeiv_time : =T if EIV coefficients vary with time 
    436379      !!---------------------------------------------------------------------- 
    437       INTEGER  ::   jk, jj, ji        ! dummy loop indices 
     380      INTEGER  ::   jk                ! dummy loop indices 
    438381      INTEGER  ::   ierr, inum, ios   ! local integer 
    439382      ! 
    … …  
    476419         CASE(   0  )      !==  constant  ==! 
    477420            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0 
    478 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    479             DO jk = 1, jpk 
    480                DO jj = 1, jpj 
    481                   DO ji = 1, jpi 
    482                      aeiu(ji,jj,jk) = rn_aeiv_0 
    483                      aeiv(ji,jj,jk) = rn_aeiv_0 
    484                   END DO 
    485                END DO 
    486             END DO 
     421            aeiu(:,:,:) = rn_aeiv_0 
     422            aeiv(:,:,:) = rn_aeiv_0 
    487423            ! 
    488424         CASE(  10  )      !==  fixed profile  ==! 
    489425            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )' 
    490 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    491             DO jj = 1, jpj 
    492                DO ji = 1, jpi 
    493                   aeiu(ji,jj,1) = rn_aeiv_0                                ! constant surface value 
    494                   aeiv(ji,jj,1) = rn_aeiv_0 
    495                END DO 
    496             END DO 
     426            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value 
     427            aeiv(:,:,1) = rn_aeiv_0 
    497428            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 
    498429            ! 
    … …  
    503434            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 
    504435            CALL iom_close( inum ) 
    505 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    506436            DO jk = 2, jpk 
    507                DO jj = 1, jpj 
    508                   DO ji = 1, jpi 
    509                      aeiu(ji,jj,jk) = aeiu(ji,jj,1) 
    510                      aeiv(ji,jj,jk) = aeiv(ji,jj,1) 
    511                   END DO 
    512                END DO 
     437               aeiu(:,:,jk) = aeiu(:,:,1) 
     438               aeiv(:,:,jk) = aeiv(:,:,1) 
    513439            END DO 
    514440            ! 
    … …  
    572498      CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
    573499      !       
    574 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    575       DO jj = 1, jpj 
    576          DO ji = 1, jpi 
    577             zn   (ji,jj) = 0._wp      ! Local initialization 
    578             zhw  (ji,jj) = 5._wp 
    579             zah  (ji,jj) = 0._wp 
    580             zross(ji,jj) = 0._wp 
    581          END DO 
    582       END DO 
     500      zn   (:,:) = 0._wp      ! Local initialization 
     501      zhw  (:,:) = 5._wp 
     502      zah  (:,:) = 0._wp 
     503      zross(:,:) = 0._wp 
    583504      !                       ! Compute lateral diffusive coefficient at T-point 
    584505      IF( ln_traldf_triad ) THEN 
    585506         DO jk = 1, jpk 
    586 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w) 
    587507            DO jj = 2, jpjm1 
    588508               DO ji = 2, jpim1 
    … …  
    603523      ELSE 
    604524         DO jk = 1, jpk 
    605 !$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w) 
    606525            DO jj = 2, jpjm1 
    607526               DO ji = 2, jpim1 
    … …  
    623542      END IF 
    624543 
    625 !$OMP PARALLEL  
    626 !$OMP DO schedule(static) private(jj,ji,zfw) 
    627544      DO jj = 2, jpjm1 
    628545         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    637554      !                                         !==  Bound on eiv coeff.  ==! 
    638555      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
    639 !$OMP DO schedule(static) private(jj,ji,zzaei) 
    640556      DO jj = 2, jpjm1 
    641557         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    644560         END DO 
    645561      END DO 
    646 !$OMP END PARALLEL 
    647562      CALL lbc_lnk( zaeiw(:,:), 'W', 1. )       ! lateral boundary condition 
    648563      !                
    649 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    650564      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==! 
    651565         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    656570      CALL lbc_lnk( paeiu(:,:,1), 'U', 1. )   ;   CALL lbc_lnk( paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition 
    657571 
    658 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    659572      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==! 
    660          DO jj = 1, jpj 
    661             DO ji = 1, jpi 
    662                paeiu(ji,jj,jk) = paeiu(ji,jj,1) * umask(ji,jj,jk) 
    663                paeiv(ji,jj,jk) = paeiv(ji,jj,1) * vmask(ji,jj,jk) 
    664             END DO  
    665          END DO  
     573         paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 
     574         paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 
    666575      END DO 
    667576      !   
    … …  
    715624 
    716625       
    717 !$OMP PARALLEL 
    718 !$OMP DO schedule(static) private(jj,ji) 
    719       DO jj = 1, jpj 
    720          DO ji = 1, jpi 
    721             zpsi_uw(ji,jj, 1 ) = 0._wp   ;   zpsi_vw(ji,jj, 1 ) = 0._wp 
    722             zpsi_uw(ji,jj,jpk) = 0._wp   ;   zpsi_vw(ji,jj,jpk) = 0._wp 
    723          END DO 
    724       END DO 
    725 !$OMP END DO NOWAIT 
    726       ! 
    727 !$OMP DO schedule(static) private(jk,jj,ji) 
     626      zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp 
     627      zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
     628      ! 
    728629      DO jk = 2, jpkm1 
    729630         DO jj = 1, jpjm1 
    … …  
    737638      END DO 
    738639      ! 
    739 !$OMP DO schedule(static) private(jk,jj,ji) 
    740640      DO jk = 1, jpkm1 
    741641         DO jj = 1, jpjm1 
    … …  
    746646         END DO 
    747647      END DO 
    748 !$OMP END DO NOWAIT 
    749 !$OMP DO schedule(static) private(jk,jj,ji) 
    750648      DO jk = 1, jpkm1 
    751649         DO jj = 2, jpjm1 
    … …  
    756654         END DO 
    757655      END DO 
    758 !$OMP END PARALLEL 
    759656      ! 
    760657      !                              ! diagnose the eddy induced velocity and associated heat transport 
    … …  
    798695      CALL wrk_alloc( jpi,jpj,jpk,   zw3d ) 
    799696      ! 
    800 !$OMP PARALLEL 
    801 !$OMP DO schedule(static) private(jj,ji) 
    802       DO jj = 1, jpj 
    803          DO ji = 1, jpi 
    804             zw3d(ji,jj,jpk) = 0._wp                            ! bottom value always 0 
    805          END DO 
    806       END DO 
    807 !$OMP END DO NOWAIT 
    808       ! 
    809 !$OMP DO schedule(static) private(jk,jj,ji) 
     697      zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
     698      ! 
    810699      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw] 
    811          DO jj = 1, jpj 
    812             DO ji = 1, jpi 
    813                zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    814             END DO 
    815          END DO 
    816       END DO 
    817 !$OMP END PARALLEL 
     700         zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 
     701      END DO 
    818702      CALL iom_put( "uoce_eiv", zw3d ) 
    819703      ! 
    820 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    821704      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw] 
    822          DO jj = 1, jpj 
    823             DO ji = 1, jpi 
    824                zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 
    825             END DO 
    826          END DO 
     705         zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 
    827706      END DO 
    828707      CALL iom_put( "voce_eiv", zw3d ) 
    829708      ! 
    830 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    831709      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix] 
    832710         DO jj = 2, jpjm1 
    … …  
    846724      zztmp = 0.5_wp * rau0 * rcp  
    847725      IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
    848 !$OMP PARALLEL 
    849 !$OMP DO schedule(static) private(jj,ji) 
    850          DO jj = 1, jpj 
    851             DO ji = 1, jpi 
    852                zw2d(ji,jj) = 0._wp 
    853             END DO 
    854          END DO 
    855 !$OMP DO schedule(static) private(jk,jj,ji) 
    856          DO jk = 1, jpk 
    857             DO jj = 1, jpj 
    858                DO ji = 1, jpi 
    859                   zw3d(ji,jj,jk) = 0._wp  
    860                END DO 
    861             END DO 
    862          END DO 
    863          DO jk = 1, jpkm1 
    864 !$OMP DO schedule(static) private(jj,ji) 
    865             DO jj = 2, jpjm1 
    866                DO ji = fs_2, fs_jpim1   ! vector opt. 
    867                   zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    868                      &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
    869                   zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    870                END DO 
    871             END DO 
    872          END DO 
    873 !$OMP END PARALLEL 
    874          CALL lbc_lnk( zw2d, 'U', -1. ) 
    875          CALL lbc_lnk( zw3d, 'U', -1. ) 
    876          CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction 
    877          CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
    878       ENDIF 
    879 !$OMP PARALLEL 
    880 !$OMP DO schedule(static) private(jj,ji) 
    881       DO jj = 1, jpj 
    882          DO ji = 1, jpi 
    883             zw2d(ji,jj) = 0._wp 
    884          END DO 
    885       END DO 
    886 !$OMP DO schedule(static) private(jk,jj,ji) 
    887       DO jk = 1, jpk 
    888          DO jj = 1, jpj 
    889             DO ji = 1, jpi 
    890                zw3d(ji,jj,jk) = 0._wp 
    891             END DO 
    892          END DO 
    893       END DO 
     726        zw2d(:,:)   = 0._wp  
     727        zw3d(:,:,:) = 0._wp  
     728        DO jk = 1, jpkm1 
     729           DO jj = 2, jpjm1 
     730              DO ji = fs_2, fs_jpim1   ! vector opt. 
     731                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     732                    &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
     733                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
     734              END DO 
     735           END DO 
     736        END DO 
     737        CALL lbc_lnk( zw2d, 'U', -1. ) 
     738        CALL lbc_lnk( zw3d, 'U', -1. ) 
     739        CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction 
     740        CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
     741      ENDIF 
     742      zw2d(:,:)   = 0._wp  
     743      zw3d(:,:,:) = 0._wp  
    894744      DO jk = 1, jpkm1 
    895 !$OMP DO schedule(static) private(jj,ji) 
    896745         DO jj = 2, jpjm1 
    897746            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    902751         END DO 
    903752      END DO 
    904 !$OMP END PARALLEL 
    905753      CALL lbc_lnk( zw2d, 'V', -1. ) 
    906754      CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction 
    … …  
    911759      zztmp = 0.5_wp * 0.5 
    912760      IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 
    913 !$OMP PARALLEL 
    914 !$OMP DO schedule(static) private(jj,ji) 
    915          DO jj = 1, jpj 
    916             DO ji = 1, jpi 
    917                zw2d(ji,jj) = 0._wp 
    918             END DO 
    919          END DO 
    920 !$OMP DO schedule(static) private(jk,jj,ji) 
    921          DO jk = 1, jpk 
    922             DO jj = 1, jpj 
    923                DO ji = 1, jpi 
    924                   zw3d(ji,jj,jk) = 0._wp  
    925                END DO 
    926             END DO 
    927          END DO 
    928          DO jk = 1, jpkm1 
    929 !$OMP DO schedule(static) private(jj,ji) 
    930             DO jj = 2, jpjm1 
    931                DO ji = fs_2, fs_jpim1   ! vector opt. 
    932                   zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    933                      &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
    934                   zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    935                END DO 
    936             END DO 
    937          END DO 
    938          CALL lbc_lnk( zw2d, 'U', -1. ) 
    939          CALL lbc_lnk( zw3d, 'U', -1. ) 
    940          CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
    941          CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
    942 !$OMP END PARALLEL 
    943       ENDIF 
    944 !$OMP PARALLEL 
    945 !$OMP DO schedule(static) private(jj,ji) 
    946       DO jj = 1, jpj 
    947          DO ji = 1, jpi 
    948             zw2d(ji,jj) = 0._wp 
    949          END DO 
    950       END DO 
    951 !$OMP DO schedule(static) private(jk,jj,ji) 
    952       DO jk = 1, jpk 
    953          DO jj = 1, jpj 
    954             DO ji = 1, jpi 
    955                zw3d(ji,jj,jk) = 0._wp 
    956             END DO 
    957          END DO 
    958       END DO 
     761        zw2d(:,:) = 0._wp  
     762        zw3d(:,:,:) = 0._wp  
     763        DO jk = 1, jpkm1 
     764           DO jj = 2, jpjm1 
     765              DO ji = fs_2, fs_jpim1   ! vector opt. 
     766                 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     767                    &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
     768                 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
     769              END DO 
     770           END DO 
     771        END DO 
     772        CALL lbc_lnk( zw2d, 'U', -1. ) 
     773        CALL lbc_lnk( zw3d, 'U', -1. ) 
     774        CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
     775        CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
     776      ENDIF 
     777      zw2d(:,:) = 0._wp  
     778      zw3d(:,:,:) = 0._wp  
    959779      DO jk = 1, jpkm1 
    960 !$OMP DO schedule(static) private(jj,ji) 
    961780         DO jj = 2, jpjm1 
    962781            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    967786         END DO 
    968787      END DO 
    969 !$OMP END PARALLEL 
    970788      CALL lbc_lnk( zw2d, 'V', -1. ) 
    971789      CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r7698 r7753  
    115115          
    116116         !  Computation of ice albedo (free of snow) 
    117 !$OMP PARALLEL DO schedule(static) private(jl,jj,ji) 
    118          DO jl = 1, ijpl 
    119             DO jj = 1, jpj 
    120                DO ji = 1, jpi 
    121                   IF ( ph_snw(ji,jj,jl) == 0._wp .AND. pt_ice(ji,jj,jl) >= rt0_ice ) THEN 
    122                      zalb(ji,jj,jl) = ralb_im 
    123                   ELSE 
    124                      zalb(ji,jj,jl) = ralb_if 
    125                   END IF 
    126                END DO 
    127             END DO 
    128          END DO 
     117         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im 
     118         ELSE WHERE                                              ;   zalb(:,:,:) = ralb_if 
     119         END  WHERE 
    129120       
    130121         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb 
    … …  
    135126         ELSE WHERE                                       ;  zalb_it = 0.1    + 3.6    * ph_ice 
    136127         END WHERE 
    137 !$OMP PARALLEL 
    138 !$OMP DO schedule(static) private(jl, jj, ji,zswitch,zalb_sf,zalb_sm,zalb_st) 
     128      
    139129         DO jl = 1, ijpl 
    140130            DO jj = 1, jpj 
    … …  
    166156         END DO 
    167157 
    168 !$OMP DO schedule(static) private(jl, jj, ji)      
    169          DO jl = 1, ijpl 
    170             DO jj = 1, jpj 
    171                DO ji = 1, jpi 
    172                   pa_ice_os(ji,jj,jl) = pa_ice_cs(ji,jj,jl) + rcloud       ! Oberhuber correction for overcast sky 
    173                END DO 
    174             END DO 
    175          END DO 
    176 !$OMP END PARALLEL 
     158         pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rcloud       ! Oberhuber correction for overcast sky 
    177159 
    178160      !------------------------------------------ 
    … …  
    211193         z1_c2 = 1. / 0.03 
    212194         !  Computation of the snow/ice albedo 
    213 !$OMP PARALLEL DO schedule(static) private(jl, jj, ji,zswitch,zalb_sf,zalb_sm,zalb_st)      
    214195         DO jl = 1, ijpl 
    215196            DO jj = 1, jpj 
    … …  
    249230      !! 
    250231      REAL(wp) :: zcoef  
    251       INTEGER  ::   ji, jj                                   ! dummy loop indices 
    252232      !!---------------------------------------------------------------------- 
    253233      ! 
    254234      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982 
    255 !$OMP PARALLEL DO schedule(static) private(jj, ji)      
    256       DO jj = 1, jpj 
    257          DO ji = 1, jpi 
    258             pa_oce_cs(ji,jj) = zcoef  
    259             pa_oce_os(ji,jj) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972 
    260          END DO 
    261       END DO 
     235      pa_oce_cs(:,:) = zcoef  
     236      pa_oce_os(:,:) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972 
    262237      ! 
    263238   END SUBROUTINE albedo_oce 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r7698 r7753  
    6666      !                                                             ! 'ij->e' = (i,j) components to east 
    6767      !                                                             ! 'ij->n' = (i,j) components to north 
    68       INTEGER  ::   ji, jj                                          ! dummy loop indices 
    6968      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prot       
    7069      !!---------------------------------------------------------------------- 
    … …  
    8382      CASE( 'en->i' )                  ! east-north to i-component 
    8483         SELECT CASE (cd_type) 
    85          CASE ('T')    
    86 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    87             DO jj = 1, jpj 
    88                DO ji = 1, jpi 
    89                   prot(ji,jj) = pxin(ji,jj) * gcost(ji,jj) + pyin(ji,jj) * gsint(ji,jj) 
    90                END DO 
    91             END DO 
    92          CASE ('U') 
    93 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    94             DO jj = 1, jpj 
    95                DO ji = 1, jpi 
    96                   prot(ji,jj) = pxin(ji,jj) * gcosu(ji,jj) + pyin(ji,jj) * gsinu(ji,jj) 
    97                END DO 
    98             END DO 
    99          CASE ('V') 
    100 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    101             DO jj = 1, jpj 
    102                DO ji = 1, jpi 
    103                   prot(ji,jj) = pxin(ji,jj) * gcosv(ji,jj) + pyin(ji,jj) * gsinv(ji,jj) 
    104                END DO 
    105             END DO 
    106          CASE ('F') 
    107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    108             DO jj = 1, jpj 
    109                DO ji = 1, jpi 
    110                   prot(ji,jj) = pxin(ji,jj) * gcosf(ji,jj) + pyin(ji,jj) * gsinf(ji,jj) 
    111                END DO 
    112             END DO 
     84         CASE ('T')   ;   prot(:,:) = pxin(:,:) * gcost(:,:) + pyin(:,:) * gsint(:,:) 
     85         CASE ('U')   ;   prot(:,:) = pxin(:,:) * gcosu(:,:) + pyin(:,:) * gsinu(:,:) 
     86         CASE ('V')   ;   prot(:,:) = pxin(:,:) * gcosv(:,:) + pyin(:,:) * gsinv(:,:) 
     87         CASE ('F')   ;   prot(:,:) = pxin(:,:) * gcosf(:,:) + pyin(:,:) * gsinf(:,:) 
    11388         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 
    11489         END SELECT 
    11590      CASE ('en->j')                   ! east-north to j-component 
    11691         SELECT CASE (cd_type) 
    117          CASE ('T') 
    118 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    119             DO jj = 1, jpj 
    120                DO ji = 1, jpi 
    121                   prot(ji,jj) = pyin(ji,jj) * gcost(ji,jj) - pxin(ji,jj) * gsint(ji,jj) 
    122                END DO 
    123             END DO 
    124          CASE ('U') 
    125 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    126             DO jj = 1, jpj 
    127                DO ji = 1, jpi 
    128                   prot(ji,jj) = pyin(ji,jj) * gcosu(ji,jj) - pxin(ji,jj) * gsinu(ji,jj) 
    129                END DO 
    130             END DO 
    131          CASE ('V')    
    132 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    133             DO jj = 1, jpj 
    134                DO ji = 1, jpi 
    135                   prot(ji,jj) = pyin(ji,jj) * gcosv(ji,jj) - pxin(ji,jj) * gsinv(ji,jj) 
    136                END DO 
    137             END DO 
    138          CASE ('F')    
    139 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    140             DO jj = 1, jpj 
    141                DO ji = 1, jpi 
    142                   prot(ji,jj) = pyin(ji,jj) * gcosf(ji,jj) - pxin(ji,jj) * gsinf(ji,jj) 
    143                END DO 
    144             END DO 
     92         CASE ('T')   ;   prot(:,:) = pyin(:,:) * gcost(:,:) - pxin(:,:) * gsint(:,:) 
     93         CASE ('U')   ;   prot(:,:) = pyin(:,:) * gcosu(:,:) - pxin(:,:) * gsinu(:,:) 
     94         CASE ('V')   ;   prot(:,:) = pyin(:,:) * gcosv(:,:) - pxin(:,:) * gsinv(:,:)    
     95         CASE ('F')   ;   prot(:,:) = pyin(:,:) * gcosf(:,:) - pxin(:,:) * gsinf(:,:)    
    14596         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 
    14697         END SELECT 
    14798      CASE ('ij->e')                   ! (i,j)-components to east 
    14899         SELECT CASE (cd_type) 
    149          CASE ('T') 
    150 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    151             DO jj = 1, jpj 
    152                DO ji = 1, jpi 
    153                   prot(ji,jj) = pxin(ji,jj) * gcost(ji,jj) - pyin(ji,jj) * gsint(ji,jj) 
    154                END DO 
    155             END DO 
    156          CASE ('U') 
    157 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    158             DO jj = 1, jpj 
    159                DO ji = 1, jpi 
    160                   prot(ji,jj) = pxin(ji,jj) * gcosu(ji,jj) - pyin(ji,jj) * gsinu(ji,jj) 
    161                END DO 
    162             END DO 
    163          CASE ('V') 
    164 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    165             DO jj = 1, jpj 
    166                DO ji = 1, jpi 
    167                   prot(ji,jj) = pxin(ji,jj) * gcosv(ji,jj) - pyin(ji,jj) * gsinv(ji,jj) 
    168                END DO 
    169             END DO 
    170          CASE ('F') 
    171 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    172             DO jj = 1, jpj 
    173                DO ji = 1, jpi 
    174                   prot(ji,jj) = pxin(ji,jj) * gcosf(ji,jj) - pyin(ji,jj) * gsinf(ji,jj) 
    175                END DO 
    176             END DO 
     100         CASE ('T')   ;   prot(:,:) = pxin(:,:) * gcost(:,:) - pyin(:,:) * gsint(:,:) 
     101         CASE ('U')   ;   prot(:,:) = pxin(:,:) * gcosu(:,:) - pyin(:,:) * gsinu(:,:) 
     102         CASE ('V')   ;   prot(:,:) = pxin(:,:) * gcosv(:,:) - pyin(:,:) * gsinv(:,:) 
     103         CASE ('F')   ;   prot(:,:) = pxin(:,:) * gcosf(:,:) - pyin(:,:) * gsinf(:,:) 
    177104         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 
    178105         END SELECT 
    179106      CASE ('ij->n')                   ! (i,j)-components to north  
    180107         SELECT CASE (cd_type) 
    181          CASE ('T') 
    182 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    183             DO jj = 1, jpj 
    184                DO ji = 1, jpi 
    185                   prot(ji,jj) = pyin(ji,jj) * gcost(ji,jj) + pxin(ji,jj) * gsint(ji,jj) 
    186                END DO 
    187             END DO 
    188          CASE ('U') 
    189 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    190             DO jj = 1, jpj 
    191                DO ji = 1, jpi 
    192                   prot(ji,jj) = pyin(ji,jj) * gcosu(ji,jj) + pxin(ji,jj) * gsinu(ji,jj) 
    193                END DO 
    194             END DO 
    195          CASE ('V') 
    196 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    197             DO jj = 1, jpj 
    198                DO ji = 1, jpi 
    199                   prot(ji,jj) = pyin(ji,jj) * gcosv(ji,jj) + pxin(ji,jj) * gsinv(ji,jj) 
    200                END DO 
    201             END DO 
    202          CASE ('F') 
    203 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    204             DO jj = 1, jpj 
    205                DO ji = 1, jpi 
    206                   prot(ji,jj) = pyin(ji,jj) * gcosf(ji,jj) + pxin(ji,jj) * gsinf(ji,jj) 
    207                END DO 
    208             END DO 
     108         CASE ('T')   ;   prot(:,:) = pyin(:,:) * gcost(:,:) + pxin(:,:) * gsint(:,:) 
     109         CASE ('U')   ;   prot(:,:) = pyin(:,:) * gcosu(:,:) + pxin(:,:) * gsinu(:,:) 
     110         CASE ('V')   ;   prot(:,:) = pyin(:,:) * gcosv(:,:) + pxin(:,:) * gsinv(:,:) 
     111         CASE ('F')   ;   prot(:,:) = pyin(:,:) * gcosf(:,:) + pxin(:,:) * gsinf(:,:) 
    209112         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 
    210113         END SELECT 
    … …  
    254157      ! (computation done on the north stereographic polar plane) 
    255158      ! 
    256 !$OMP PARALLEL 
    257 !$OMP DO schedule(static) private(jj,ji,zlam,zphi,zxnpt,zynpt,znnpt,zxnpu,zynpu,znnpu,zxnpv,zynpv,znnpv,zxnpf) & 
    258 !$OMP& private(zynpf,znnpf,zlan,zphh,zxvvt,zyvvt,znvvt,zxffu,zyffu,znffu,zxffv,zyffv,znffv,zxuuf,zyuuf,znuuf) 
    259159      DO jj = 2, jpjm1 
    260160         DO ji = fs_2, jpi   ! vector opt. 
    … …  
    348248      ! =============== ! 
    349249 
    350 !$OMP DO schedule(static) private(jj,ji) 
    351250      DO jj = 2, jpjm1 
    352251         DO ji = fs_2, jpi   ! vector opt. 
    … …  
    369268         END DO 
    370269      END DO 
    371 !$OMP END DO NOWAIT 
    372 !$OMP END PARALLEL 
    373270 
    374271      ! =========================== ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90

    r7698 r7753  
    316316#if defined key_cice 
    317317      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
    318 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    319          DO jj = 1, jpj 
    320             DO ji = 1, jpi 
    321                qlw_ice(ji,jj,1)   = sf(jp_qlw)%fnow(ji,jj,1) 
    322             END DO 
    323          END DO 
    324          IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1)   = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
    325          ELSE                 
    326 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    327             DO jj = 1, jpj 
    328                DO ji = 1, jpi 
    329                   qsr_ice(ji,jj,1)   = sf(jp_qsr)%fnow(ji,jj,1)  
    330                END DO 
    331             END DO 
     318         qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1) 
     319         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
     320         ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1)  
    332321         ENDIF  
    333 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    334          DO jj = 1, jpj 
    335             DO ji = 1, jpi 
    336                tatm_ice(ji,jj)    = sf(jp_tair)%fnow(ji,jj,1) 
    337                qatm_ice(ji,jj)    = sf(jp_humi)%fnow(ji,jj,1) 
    338                tprecip(ji,jj)     = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac 
    339                sprecip(ji,jj)     = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac 
    340                wndi_ice(ji,jj)    = sf(jp_wndi)%fnow(ji,jj,1) 
    341                wndj_ice(ji,jj)    = sf(jp_wndj)%fnow(ji,jj,1) 
    342             END DO 
    343          END DO 
     322         tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1) 
     323         qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
     324         tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
     325         sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac 
     326         wndi_ice(:,:)    = sf(jp_wndi)%fnow(:,:,1) 
     327         wndj_ice(:,:)    = sf(jp_wndj)%fnow(:,:,1) 
    344328      ENDIF 
    345329#endif 
    … …  
    398382      ! 
    399383 
    400 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    401       DO jj = 1, jpj 
    402          DO ji = 1, jpi 
    403          ! local scalars ( place there for vector optimisation purposes) 
    404             zst(ji,jj) = pst(ji,jj) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
    405  
    406             ! ... components ( U10m - U_oce ) at T-point (unmasked) 
    407 !!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ??? 
    408             zwnd_i(ji,jj) = 0._wp 
    409             zwnd_j(ji,jj) = 0._wp 
    410          END DO 
    411       END DO 
     384      ! local scalars ( place there for vector optimisation purposes) 
     385      zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
     386 
    412387      ! ----------------------------------------------------------------------------- ! 
    413388      !      0   Wind components and module at T-point relative to the moving ocean   ! 
    414389      ! ----------------------------------------------------------------------------- ! 
    415390 
     391      ! ... components ( U10m - U_oce ) at T-point (unmasked) 
     392!!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ??? 
     393      zwnd_i(:,:) = 0._wp 
     394      zwnd_j(:,:) = 0._wp 
    416395#if defined key_cyclone 
    417396      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
    418 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    419397      DO jj = 2, jpjm1 
    420398         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    424402      END DO 
    425403#endif 
    426 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    427404      DO jj = 2, jpjm1 
    428405         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    434411      CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 
    435412      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    436 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    437       DO jj = 1, jpj 
    438          DO ji = 1, jpi 
    439             wndm(ji,jj) = SQRT(  zwnd_i(ji,jj) * zwnd_i(ji,jj)   & 
    440                &             + zwnd_j(ji,jj) * zwnd_j(ji,jj)  ) * tmask(ji,jj,1) 
    441  
    442          END DO 
    443       END DO 
     413      wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
     414         &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
     415 
    444416      ! ----------------------------------------------------------------------------- ! 
    445417      !      I   Radiative FLUXES                                                     ! 
    … …  
    449421      zztmp = 1. - albo 
    450422      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
    451       ELSE          
    452 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    453          DO jj = 1, jpj 
    454             DO ji = 1, jpi 
    455                qsr(ji,jj) = zztmp *          sf(jp_qsr)%fnow(ji,jj,1)   * tmask(ji,jj,1) 
    456             END DO 
    457          END DO 
    458       ENDIF 
    459  
    460 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    461       DO jj = 1, jpj 
    462          DO ji = 1, jpi 
    463             zqlw(ji,jj) = (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * zst(ji,jj)*zst(ji,jj)*zst(ji,jj)*zst(ji,jj)  ) * tmask(ji,jj,1)   ! Long  Wave 
    464          END DO 
    465       END DO 
     423      ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
     424      ENDIF 
     425 
     426      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    466427 
    467428 
    … …  
    500461      END IF 
    501462 
    502 !$OMP PARALLEL 
    503 !$OMP DO schedule(static) private(jj, ji) 
    504       DO jj = 1, jpj 
    505          DO ji = 1, jpi 
    506             Cd_oce(ji,jj) = Cd(ji,jj)  ! record value of pure ocean-atm. drag (clem) 
    507          END DO 
    508       END DO 
    509  
    510 !$OMP DO schedule(static) private(jj, ji) 
     463      Cd_oce(:,:) = Cd(:,:)  ! record value of pure ocean-atm. drag (clem) 
     464 
    511465      DO jj = 1, jpj             ! tau module, i and j component 
    512466         DO ji = 1, jpi 
    … …  
    517471         END DO 
    518472      END DO 
    519 !$OMP END PARALLEL 
    520473 
    521474      !                          ! add the HF tau contribution to the wind stress module 
    522       IF( lhftau ) THEN 
    523 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    524          DO jj = 1, jpj 
    525             DO ji = 1, jpi 
    526                taum(ji,jj) = taum(ji,jj) + sf(jp_tdif)%fnow(ji,jj,1) 
    527             END DO 
    528          END DO 
    529       END IF 
     475      IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    530476 
    531477      CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    … …  
    534480      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    535481      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
    536 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    537482      DO jj = 1, jpjm1 
    538483         DO ji = 1, fs_jpim1 
    … …  
    551496 
    552497      ! zqla used as temporary array, for rho*U (common term of bulk formulae): 
    553 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    554       DO jj = 1, jpj 
    555          DO ji = 1, jpi 
    556             zqla(ji,jj) = zrhoa(ji,jj) * zU_zu(ji,jj) 
    557          END DO 
    558       END DO 
     498      zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) 
    559499 
    560500      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 
    561501         !! q_air and t_air are given at 10m (wind reference height) 
    562 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    563          DO jj = 1, jpj 
    564             DO ji = 1, jpi 
    565                zevap(ji,jj) = rn_efac*MAX( 0._wp,             zqla(ji,jj)*Ce(ji,jj)*(zsq(ji,jj) - sf(jp_humi)%fnow(ji,jj,1)) ) ! Evaporation, using bulk wind speed 
    566             END DO 
    567          END DO 
    568          zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:) )   ! Sensible Heat, using bulk wind speed 
     502         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed 
     503         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed 
    569504      ELSE 
    570505         !! q_air and t_air are not given at 10m (wind reference height) 
    571506         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 
    572 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    573          DO jj = 1, jpj 
    574             DO ji = 1, jpi 
    575                zevap(ji,jj) = rn_efac*MAX( 0._wp,             zqla(ji,jj)*Ce(ji,jj)*(zsq(ji,jj) - zq_zu(ji,jj) ) ) ! Evaporation ! using bulk wind speed 
    576             END DO 
    577          END DO 
     507         zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - zq_zu(:,:) ) ) ! Evaporation ! using bulk wind speed 
    578508         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - zt_zu(:,:) )   ! Sensible Heat ! using bulk wind speed 
    579509      ENDIF 
    … …  
    597527      ! ----------------------------------------------------------------------------- ! 
    598528      ! 
    599 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    600       DO jj = 1, jpj 
    601          DO ji = 1, jpi 
    602             emp (ji,jj) = (  zevap(ji,jj)                                          &   ! mass flux (evap. - precip.) 
    603                &         - sf(jp_prec)%fnow(ji,jj,1) * rn_pfac  ) * tmask(ji,jj,1) 
    604             ! 
    605             qns(ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj)                                &   ! Downward Non Solar 
    606                &     - sf(jp_snow)%fnow(ji,jj,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
    607                &     - zevap(ji,jj) * pst(ji,jj) * rcp                                      &   ! remove evap heat content at SST 
    608                &     + ( sf(jp_prec)%fnow(ji,jj,1) - sf(jp_snow)%fnow(ji,jj,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
    609                &     * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp                          & 
    610                &     + sf(jp_snow)%fnow(ji,jj,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
    611                &     * ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) 
    612             ! 
     529      emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
     530         &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
     531      ! 
     532      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar 
     533         &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
     534         &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
     535         &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
     536         &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          & 
     537         &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
     538         &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 
     539      ! 
    613540#if defined key_lim3 
    614             qns_oce(ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj)                                ! non solar without emp (only needed by LIM3) 
    615             qsr_oce(ji,jj) = qsr(ji,jj) 
     541      qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3) 
     542      qsr_oce(:,:) = qsr(:,:) 
    616543#endif 
    617          END DO 
    618       END DO 
    619544      ! 
    620545      IF ( nn_ice == 0 ) THEN 
    … …  
    626551         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
    627552         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
    628 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    629          DO jj = 1, jpj 
    630             DO ji = 1, jpi 
    631                tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac   ! output total precipitation [kg/m2/s] 
    632                sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac   ! output solid precipitation [kg/m2/s] 
    633             END DO 
    634          END DO 
     553         tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac   ! output total precipitation [kg/m2/s] 
     554         sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac   ! output solid precipitation [kg/m2/s] 
    635555         CALL iom_put( 'snowpre', sprecip * 86400. )        ! Snow 
    636556         CALL iom_put( 'precip' , tprecip * 86400. )        ! Total precipitation 
    … …  
    679599      CALL wrk_alloc( jpi,jpj, Cd ) 
    680600 
    681 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    682       DO jj = 1, jpj 
    683          DO ji = 1, jpi 
    684             Cd(ji,jj) = Cd_ice 
    685          END DO 
    686       END DO 
     601      Cd(:,:) = Cd_ice 
    687602 
    688603      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 
    … …  
    698613      zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 
    699614 
    700 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    701       DO jj = 1, jpj 
    702          DO ji = 1, jpi 
    703             !!gm brutal.... 
    704             utau_ice  (ji,jj) = 0._wp 
    705             vtau_ice  (ji,jj) = 0._wp 
    706             wndm_ice  (ji,jj) = 0._wp 
    707             !!gm end 
    708          END DO 
    709       END DO 
     615      !!gm brutal.... 
     616      utau_ice  (:,:) = 0._wp 
     617      vtau_ice  (:,:) = 0._wp 
     618      wndm_ice  (:,:) = 0._wp 
     619      !!gm end 
    710620 
    711621      ! ----------------------------------------------------------------------------- ! 
    … …  
    715625      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
    716626         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
    717 !$OMP PARALLEL DO schedule(static) private(jj,ji,zwndi_f,zwndj_f,zwnorm_f,zwndi_t,zwndj_t) 
    718627         DO jj = 2, jpjm1 
    719628            DO ji = 2, jpim1   ! B grid : NO vector opt 
    … …  
    740649         ! 
    741650      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
    742 !$OMP PARALLEL DO schedule(static) private(jj,ji,zwndi_t,zwndj_t) 
    743651         DO jj = 2, jpj 
    744652            DO ji = fs_2, jpi   ! vect. opt. 
    … …  
    748656            END DO 
    749657         END DO 
    750 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    751658         DO jj = 2, jpjm1 
    752659            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    793700      REAL(wp) ::   zztmp, z1_lsub           !   -      - 
    794701      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw         ! long wave heat flux over ice 
    795       REAL(wp), DIMENSION(:,:,:), POINTER ::   zevap_ice3d, zqns_ice3d, zqsr_ice3d  
    796702      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb         ! sensible  heat flux over ice 
    797703      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw        ! long wave heat sensitivity over ice 
    798704      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb        ! sensible  heat sensitivity over ice 
    799705      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (LIM3) 
    800       REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap_ice2d, zqns_ice2d, zqsr_ice2d 
    801706      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa 
    802707      REAL(wp), DIMENSION(:,:)  , POINTER ::   Cd            ! transfer coefficient for momentum      (tau) 
    … …  
    805710      IF( nn_timing == 1 )  CALL timing_start('blk_ice_flx') 
    806711      ! 
    807       CALL wrk_alloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb, zevap_ice3d, zqns_ice3d, zqsr_ice3d ) 
    808       CALL wrk_alloc( jpi,jpj,       zrhoa, zevap_ice2d, zqns_ice2d, zqsr_ice2d) 
     712      CALL wrk_alloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb ) 
     713      CALL wrk_alloc( jpi,jpj,       zrhoa) 
    809714      CALL wrk_alloc( jpi,jpj, Cd ) 
    810715 
    811 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    812       DO jj = 1, jpj 
    813          DO ji = 1, jpi 
    814             Cd(ji,jj) = Cd_ice 
    815          END DO 
    816       END DO 
     716      Cd(:,:) = Cd_ice 
    817717 
    818718      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al.  2012) (clem) 
    … …  
    831731      ! 
    832732      zztmp = 1. / ( 1. - albo ) 
    833 !$OMP PARALLEL 
    834 !$OMP DO schedule(static) private(jl,jj,ji,zst2,zst3)            ! ========================== ! 
    835       DO jl = 1, jpl                                             !  Loop over ice categories  ! 
    836          !                                                       ! ========================== ! 
     733      !                                     ! ========================== ! 
     734      DO jl = 1, jpl                        !  Loop over ice categories  ! 
     735         !                                  ! ========================== ! 
    837736         DO jj = 1 , jpj 
    838737            DO ji = 1, jpi 
    … …  
    882781      END DO 
    883782      ! 
    884 !$OMP DO schedule(static) private(jj, ji) 
    885       DO jj = 1, jpj 
    886          DO ji = 1, jpi 
    887             tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac      ! total precipitation [kg/m2/s] 
    888             sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    889          END DO 
    890       END DO 
    891 !$OMP END PARALLEL 
     783      tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
     784      sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    892785      CALL iom_put( 'snowpre', sprecip * 86400. )                  ! Snow precipitation 
    893786      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation 
    … …  
    898791      ! --- evaporation --- ! 
    899792      z1_lsub = 1._wp / Lsub 
    900 !$OMP PARALLEL 
    901 !$OMP DO schedule(static) private(jl,jj,ji) 
     793      evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub    ! sublimation 
     794      devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub    ! d(sublimation)/dT 
     795      zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )  ! evaporation over ocean 
     796 
     797      ! --- evaporation minus precipitation --- ! 
     798      zsnw(:,:) = 0._wp 
     799      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
     800      emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
     801      emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
     802      emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
     803 
     804      ! --- heat flux associated with emp --- ! 
     805      qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst 
     806         &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
     807         &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
     808         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     809      qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
     810         &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     811 
     812      ! --- total solar and non solar fluxes --- ! 
     813      qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
     814      qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
     815 
     816      ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     817      qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     818 
     819      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 
    902820      DO jl = 1, jpl 
    903          DO jj = 1 , jpj 
    904             DO ji = 1, jpi 
    905                evap_ice (ji,jj,jl) = rn_efac * qla_ice (ji,jj,jl) * z1_lsub    ! sublimation 
    906                devap_ice(ji,jj,jl) = rn_efac * dqla_ice(ji,jj,jl) * z1_lsub    ! d(sublimation)/dT 
    907             END DO 
    908          END DO 
     821         qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 
     822                                   ! But we do not have Tice => consider it at 0degC => evap=0  
    909823      END DO 
    910       ! 
    911 !$OMP DO schedule(static) private(jj, ji) 
    912       DO jj = 1, jpj 
    913          DO ji = 1, jpi 
    914             zevap    (ji,jj)   = rn_efac * ( emp(ji,jj) + tprecip(ji,jj) )  ! evaporation over ocean 
    915  
    916             ! --- evaporation minus precipitation --- ! 
    917             zsnw(ji,jj) = 0._wp 
    918          END DO 
    919       END DO 
    920 !$OMP END PARALLEL 
    921       CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
    922 !$OMP PARALLEL 
    923 !$OMP DO schedule(static) private(jj,ji) 
    924       DO jj = 1, jpj 
    925          DO ji = 1, jpi 
    926             emp_oce(ji,jj) = pfrld(ji,jj) * zevap(ji,jj) - ( tprecip(ji,jj) - sprecip(ji,jj) ) - sprecip(ji,jj) * (1._wp - zsnw(ji,jj)) 
    927          END DO 
    928       END DO 
    929 !$OMP END DO NOWAIT 
    930 !$OMP DO schedule(static) private(jl,jj,ji) 
    931       DO jl = 1, jpl 
    932          DO jj = 1 , jpj 
    933             DO ji = 1, jpi 
    934                zevap_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * evap_ice(ji,jj,jl) 
    935                zqns_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * qns_ice(ji,jj,jl) 
    936                zqsr_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * qsr_ice(ji,jj,jl) 
    937             END DO 
    938          END DO 
    939       END DO 
    940 !$OMP END DO NOWAIT 
    941 !$OMP DO schedule(static) private(jj,ji) 
    942       DO jj = 1, jpj 
    943          DO ji = 1, jpi 
    944             zevap_ice2d(ji,jj) = 0._wp  
    945             zqns_ice2d(ji,jj) = 0._wp 
    946             zqsr_ice2d(ji,jj) = 0._wp 
    947          END DO 
    948       END DO 
    949       DO jl = 1, jpl 
    950 !$OMP DO schedule(static) private(jj,ji) 
    951          DO jj = 1 , jpj 
    952             DO ji = 1, jpi 
    953                zevap_ice2d(ji,jj) = zevap_ice2d(ji,jj) + zevap_ice3d(ji,jj,jl) 
    954                zqns_ice2d(ji,jj) = zqns_ice2d(ji,jj) + zqns_ice3d(ji,jj,jl) 
    955                zqsr_ice2d(ji,jj) = zqsr_ice2d(ji,jj) + zqsr_ice3d(ji,jj,jl) 
    956             END DO 
    957          END DO 
    958       END DO 
    959 !$OMP DO schedule(static) private(jj,ji) 
    960       DO jj = 1 , jpj 
    961          DO ji = 1, jpi 
    962             emp_ice(ji,jj) = zevap_ice2d(ji,jj) - sprecip(ji,jj) * zsnw(ji,jj) 
    963             emp_tot(ji,jj) = emp_oce(ji,jj) + emp_ice(ji,jj) 
    964  
    965             ! --- heat flux associated with emp --- ! 
    966             qemp_oce(ji,jj) = - pfrld(ji,jj) * zevap(ji,jj) * sst_m(ji,jj) * rcp                                & ! evap at sst 
    967                &          + ( tprecip(ji,jj) - sprecip(ji,jj) ) * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp     & ! liquid precip at Tair 
    968                &          +   sprecip(ji,jj) * ( 1._wp - zsnw(ji,jj) ) *                                        & ! solid precip at min(Tair,Tsnow) 
    969                &              ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 
    970             qemp_ice(ji,jj) =   sprecip(ji,jj) * zsnw(ji,jj) *                                                  & ! solid precip (only) 
    971                &              ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 
    972  
    973             ! --- total solar and non solar fluxes --- ! 
    974             qns_tot(ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + zqns_ice2d(ji,jj) + qemp_ice(ji,jj) + qemp_oce(ji,jj) 
    975             qsr_tot(ji,jj) = pfrld(ji,jj) * qsr_oce(ji,jj) + zqsr_ice2d(ji,jj) 
    976  
    977             ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    978             qprec_ice(ji,jj) = rhosn * ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 
    979          END DO 
    980       END DO 
    981 !$OMP END DO NOWAIT 
    982  
    983       ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 
    984 !$OMP DO schedule(static) private(jl,jj,ji) 
    985       DO jl = 1, jpl 
    986          DO jj = 1, jpj 
    987             DO ji = 1, jpi 
    988                qevap_ice(ji,jj,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 
    989                                            ! But we do not have Tice => consider it at 0degC => evap=0  
    990             END DO 
    991          END DO 
    992       END DO 
    993 !$OMP END PARALLEL 
    994824 
    995825      CALL wrk_dealloc( jpi,jpj,   zevap, zsnw ) 
    … …  
    1001831      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    1002832      ! 
    1003 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1004       DO jj = 1, jpj 
    1005          DO ji = 1, jpi 
    1006             fr1_i0(ji,jj) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
    1007             fr2_i0(ji,jj) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    1008          END DO 
    1009       END DO 
     833      fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     834      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    1010835      ! 
    1011836      ! 
    … …  
    1019844      ENDIF 
    1020845 
    1021       CALL wrk_dealloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb, zevap_ice3d, zqns_ice3d, zqsr_ice3d ) 
     846      CALL wrk_dealloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    1022847      CALL wrk_dealloc( jpi,jpj,       zrhoa ) 
    1023       CALL wrk_dealloc( jpi,jpj, Cd, zevap_ice2d, zqns_ice2d, zqsr_ice2d) 
     848      CALL wrk_dealloc( jpi,jpj, Cd ) 
    1024849      ! 
    1025850      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_flx') 
    … …  
    1083908      !!---------------------------------------------------------------------------------- 
    1084909      ! 
    1085 !$OMP PARALLEL DO schedule(static) private(jj,ji,ztmp,ze_sat) 
    1086910      DO jj = 1, jpj 
    1087911         DO ji = 1, jpi 
    … …  
    1120944      !!---------------------------------------------------------------------------------- 
    1121945      ! 
    1122 !$OMP PARALLEL DO schedule(static) private(jj,ji,zrv,ziRT) 
    1123946      DO jj = 1, jpj 
    1124947         DO ji = 1, jpi 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90

    r7698 r7753  
    114114      ! 
    115115      INTEGER ::   j_itt 
    116       INTEGER ::   ji, jj             ! dummy loop indices 
    117116      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    118117      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations 
    … …  
    142141      !! Neutral coefficients at 10m: 
    143142      IF( ln_cdgw ) THEN      ! wave drag case 
    144 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    145          DO jj = 1, jpj 
    146             DO ji = 1, jpi 
    147                cdn_wave(ji,jj) = cdn_wave(ji,jj) + rsmall * ( 1._wp - tmask(ji,jj,1) ) 
    148                ztmp0   (ji,jj) = cdn_wave(ji,jj) 
    149             END DO 
    150          END DO 
     143         cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 
     144         ztmp0   (:,:) = cdn_wave(:,:) 
    151145      ELSE 
    152146         ztmp0 = cd_neutral_10m( U_blk ) 
    … …  
    251245      !!---------------------------------------------------------------------------------- 
    252246      ! 
    253 !$OMP PARALLEL DO schedule(static) private(jj,ji,zw,zw6,zgt33) 
    254247      DO jj = 1, jpj 
    255248         DO ji = 1, jpi 
    … …  
    291284      !!---------------------------------------------------------------------------------- 
    292285      ! 
    293 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx2,zx,zstab) 
    294286      DO jj = 1, jpj 
    295287         DO ji = 1, jpi 
    … …  
    326318      !!---------------------------------------------------------------------------------- 
    327319      ! 
    328 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx2,zstab) 
    329320      DO jj = 1, jpj 
    330321         DO ji = 1, jpi 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r7698 r7753  
    109109                                       !                    4 = Pure Coupled formulation) 
    110110      !! 
    111       INTEGER  ::   jl, jj, ji         ! dummy loop index 
     111      INTEGER  ::   jl                 ! dummy loop index 
    112112      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    113113      REAL(wp), POINTER, DIMENSION(:,:  )   ::   zutau_ice, zvtau_ice  
    … …  
    133133 
    134134         ! mean surface ocean current at ice velocity point (C-grid dynamics :  U- & V-points as the ocean) 
    135 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    136          DO jj = 1, jpj 
    137             DO ji = 1, jpi 
    138                u_oce(ji,jj) = ssu_m(ji,jj) * umask(ji,jj,1) 
    139                v_oce(ji,jj) = ssv_m(ji,jj) * vmask(ji,jj,1) 
    140             END DO 
    141          END DO 
     135         u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) 
     136         v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1) 
    142137 
    143138         ! masked sea surface freezing temperature [Kelvin] (set to rt0 over land) 
    144139         CALL eos_fzp( sss_m(:,:) , t_bo(:,:) ) 
    145 !$OMP PARALLEL 
    146 !$OMP DO schedule(static) private(jj, ji) 
    147          DO jj = 1, jpj 
    148             DO ji = 1, jpi 
    149                t_bo(ji,jj) = ( t_bo(ji,jj) + rt0 ) * tmask(ji,jj,1) + rt0 * ( 1._wp - tmask(ji,jj,1) ) 
    150             END DO 
    151          END DO 
     140         t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 
    152141 
    153142         ! Mask sea ice surface temperature (set to rt0 over land) 
    154143         DO jl = 1, jpl 
    155 !$OMP DO schedule(static) private(jj, ji) 
    156             DO jj = 1, jpj 
    157                DO ji = 1, jpi 
    158                   t_su(ji,jj,jl) = t_su(ji,jj,jl) * tmask(ji,jj,1) + rt0 * ( 1._wp - tmask(ji,jj,1) ) 
    159                END DO 
    160             END DO 
     144            t_su(:,:,jl) = t_su(:,:,jl) * tmask(:,:,1) + rt0 * ( 1._wp - tmask(:,:,1) ) 
    161145         END DO 
    162 !$OMP END PARALLEL 
    163146         ! 
    164147         !------------------------------------------------! 
    … …  
    178161            CALL wrk_alloc( jpi,jpj    , zutau_ice, zvtau_ice) 
    179162                                      CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice ) 
    180 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    181             DO jj = 1, jpj 
    182                DO ji = 1, jpi 
    183                   utau_ice(ji,jj) = utau_ice(ji,jj) * xcplmask(ji,jj,0) + zutau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    184                   vtau_ice(ji,jj) = vtau_ice(ji,jj) * xcplmask(ji,jj,0) + zvtau_ice(ji,jj) * ( 1. - xcplmask(ji,jj,0) ) 
    185                END DO 
    186             END DO 
     163            utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
     164            vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) ) 
    187165            CALL wrk_dealloc( jpi,jpj  , zutau_ice, zvtau_ice) 
    188166         ENDIF 
    … …  
    202180                                      CALL lim_dyn( kt )       !     rheology   
    203181            ELSE 
    204 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    205                DO jj = 1, jpj 
    206                   DO ji = 1, jpi 
    207                      u_ice(ji,jj) = rn_uice * umask(ji,jj,1)             !     or prescribed velocity 
    208                      v_ice(ji,jj) = rn_vice * vmask(ji,jj,1) 
    209                   END DO 
    210                END DO 
     182               u_ice(:,:) = rn_uice * umask(:,:,1)             !     or prescribed velocity 
     183               v_ice(:,:) = rn_vice * vmask(:,:,1) 
    211184            ENDIF 
    212185                                      CALL lim_trp( kt )       ! -- Ice transport (Advection/diffusion) 
    … …  
    227200                                      CALL lim_var_agg(1)      ! at_i for coupling (via pfrld)  
    228201         ! 
    229 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    230          DO jj = 1, jpj 
    231             DO ji = 1, jpi 
    232                pfrld(ji,jj)   = 1._wp - at_i(ji,jj) 
    233                phicif(ji,jj)  = vt_i(ji,jj) 
    234             END DO 
    235          END DO 
     202         pfrld(:,:)   = 1._wp - at_i(:,:) 
     203         phicif(:,:)  = vt_i(:,:) 
    236204 
    237205         !------------------------------------------------------! 
    … …  
    252220            CASE( jp_blk )                                          ! bulk formulation 
    253221               ! albedo depends on cloud fraction because of non-linear spectral effects 
    254                DO jl = 1, jpl 
    255 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    256                   DO jj = 1, jpj 
    257                      DO ji = 1, jpi 
    258                         alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 
    259                      END DO 
    260                   END DO 
    261                END DO 
     222               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    262223                                      CALL blk_ice_flx( t_su, alb_ice ) 
    263224               IF( ln_mixcpl      )   CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    … …  
    265226            CASE ( jp_purecpl ) 
    266227               ! albedo depends on cloud fraction because of non-linear spectral effects 
    267                DO jl = 1, jpl 
    268 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    269                   DO jj = 1, jpj 
    270                      DO ji = 1, jpi 
    271                         alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 
    272                      END DO 
    273                   END DO 
    274                END DO 
     228               alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    275229                                      CALL sbc_cpl_ice_flx( p_frld=pfrld, palbi=alb_ice, psst=sst_m, pist=t_su ) 
    276230               IF( nn_limflx == 2 )   CALL ice_lim_flx( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_limflx ) 
    … …  
    331285      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules 
    332286      !!---------------------------------------------------------------------- 
    333       INTEGER :: jl, ji, jj, ierr 
     287      INTEGER :: ji, jj, ierr 
    334288      !!---------------------------------------------------------------------- 
    335289      IF(lwp) WRITE(numout,*) 
    … …  
    380334      IF( ln_limdiahsb) CALL lim_diahsb_init  ! initialization for diags 
    381335      ! 
    382 !$OMP PARALLEL 
    383 !$OMP DO schedule(static) private(jj, ji) 
    384       DO jj = 1, jpj 
    385          DO ji = 1, jpi 
    386             fr_i(ji,jj)     = at_i(ji,jj)         ! initialisation of sea-ice fraction 
    387          END DO 
    388       END DO 
    389 !$OMP END DO NOWAIT 
    390       DO jl = 1, jpl 
    391 !$OMP DO schedule(static) private(jj, ji) 
    392          DO jj = 1, jpj 
    393             DO ji = 1, jpi 
    394                tn_ice(ji,jj,jl) = t_su(ji,jj,jl)       ! initialisation of surface temp for coupled simu 
    395             END DO 
    396          END DO 
    397 !$OMP END DO NOWAIT 
    398       END DO 
    399       ! 
    400 !$OMP DO schedule(static) private(jj, ji) 
     336      fr_i(:,:)     = at_i(:,:)         ! initialisation of sea-ice fraction 
     337      tn_ice(:,:,:) = t_su(:,:,:)       ! initialisation of surface temp for coupled simu 
     338      ! 
    401339      DO jj = 1, jpj 
    402340         DO ji = 1, jpi 
    … …  
    406344         END DO 
    407345      END DO 
    408 !$OMP END PARALLEL 
    409346      ! 
    410347      nstart = numit  + nn_fsbc 
    … …  
    590527      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pdevap_ice ! sublimation sensitivity 
    591528      ! 
    592       INTEGER  ::   jl, jj, ji      ! dummy loop index 
     529      INTEGER  ::   jl      ! dummy loop index 
    593530      ! 
    594531      REAL(wp), POINTER, DIMENSION(:,:) :: zalb_m    ! Mean albedo over all categories 
    … …  
    613550         z_evap_m (:,:) = fice_ice_ave ( pevap_ice (:,:,:) ) 
    614551         z_devap_m(:,:) = fice_ice_ave ( pdevap_ice (:,:,:) ) 
    615  
    616 !$OMP PARALLEL 
    617552         DO jl = 1, jpl 
    618 !$OMP DO schedule(static) private(jj, ji) 
    619             DO jj = 1, jpj 
    620                DO ji = 1, jpi 
    621                   pdqn_ice  (ji,jj,jl) = z_dqn_m(ji,jj) 
    622                   pdevap_ice(ji,jj,jl) = z_devap_m(ji,jj) 
    623                END DO 
    624             END DO 
    625 !$OMP END DO NOWAIT 
     553            pdqn_ice  (:,:,jl) = z_dqn_m(:,:) 
     554            pdevap_ice(:,:,jl) = z_devap_m(:,:) 
    626555         END DO 
    627556         ! 
    628557         DO jl = 1, jpl 
    629 !$OMP DO schedule(static) private(jj, ji) 
    630             DO jj = 1, jpj 
    631                DO ji = 1, jpi 
    632                   pqns_ice (ji,jj,jl) = z_qns_m(ji,jj) 
    633                   pqsr_ice (ji,jj,jl) = z_qsr_m(ji,jj) 
    634                   pevap_ice(ji,jj,jl) = z_evap_m(ji,jj) 
    635                END DO 
    636             END DO 
     558            pqns_ice (:,:,jl) = z_qns_m(:,:) 
     559            pqsr_ice (:,:,jl) = z_qsr_m(:,:) 
     560            pevap_ice(:,:,jl) = z_evap_m(:,:) 
    637561         END DO 
    638 !$OMP END PARALLEL 
    639562         ! 
    640563         CALL wrk_dealloc( jpi,jpj, z_qsr_m, z_qns_m, z_evap_m, z_dqn_m, z_devap_m) 
    … …  
    648571         ztem_m(:,:) = fice_ice_ave ( ptn_ice  (:,:,:) ) 
    649572         DO jl = 1, jpl 
    650 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    651             DO jj = 1, jpj 
    652                DO ji = 1, jpi 
    653                   pqns_ice (ji,jj,jl) = pqns_ice (ji,jj,jl) + pdqn_ice  (ji,jj,jl) * ( ptn_ice(ji,jj,jl) - ztem_m(ji,jj) ) 
    654                   pevap_ice(ji,jj,jl) = pevap_ice(ji,jj,jl) + pdevap_ice(ji,jj,jl) * ( ptn_ice(ji,jj,jl) - ztem_m(ji,jj) ) 
    655                   pqsr_ice (ji,jj,jl) = pqsr_ice (ji,jj,jl) * ( 1._wp - palb_ice(ji,jj,jl) ) / ( 1._wp - zalb_m(ji,jj) ) 
    656                END DO 
    657             END DO 
     573            pqns_ice (:,:,jl) = pqns_ice (:,:,jl) + pdqn_ice  (:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
     574            pevap_ice(:,:,jl) = pevap_ice(:,:,jl) + pdevap_ice(:,:,jl) * ( ptn_ice(:,:,jl) - ztem_m(:,:) ) 
     575            pqsr_ice (:,:,jl) = pqsr_ice (:,:,jl) * ( 1._wp - palb_ice(:,:,jl) ) / ( 1._wp - zalb_m(:,:) ) 
    658576         END DO 
    659577         ! 
    … …  
    672590      !! ** purpose :  store ice variables at "before" time step 
    673591      !!---------------------------------------------------------------------- 
    674       INTEGER  ::   jn, jl, jj, ji         ! dummy loop index 
    675  
    676 !$OMP PARALLEL 
    677       DO jl = 1, jpl 
    678 !$OMP DO schedule(static) private(jj, ji) 
    679          DO jj = 1, jpj 
    680             DO ji = 1, jpi 
    681                a_i_b  (ji,jj,jl)   = a_i  (ji,jj,jl)     ! ice area 
    682                v_i_b  (ji,jj,jl)   = v_i  (ji,jj,jl)     ! ice volume 
    683                v_s_b  (ji,jj,jl)   = v_s  (ji,jj,jl)     ! snow volume 
    684                smv_i_b(ji,jj,jl)   = smv_i(ji,jj,jl)     ! salt content 
    685                oa_i_b (ji,jj,jl)   = oa_i (ji,jj,jl)     ! areal age content 
    686             END DO 
    687          END DO 
    688 !$OMP END DO NOWAIT 
    689       END DO 
    690       DO jl = 1, jpl 
    691          DO jn = 1, nlay_i 
    692 !$OMP DO schedule(static) private(jj, ji) 
    693             DO jj = 1, jpj 
    694                DO ji = 1, jpi 
    695                   e_i_b  (ji,jj,jn,jl) = e_i  (ji,jj,jn,jl)   ! ice thermal energy 
    696                END DO 
    697             END DO 
    698 !$OMP END DO NOWAIT 
    699          END DO 
    700       END DO 
    701       DO jl = 1, jpl 
    702          DO jn = 1, nlay_s 
    703 !$OMP DO schedule(static) private(jj, ji) 
    704             DO jj = 1, jpj 
    705                DO ji = 1, jpi 
    706                   e_s_b  (ji,jj,jn,jl) = e_s  (ji,jj,jn,jl)   ! snow thermal energy 
    707                END DO 
    708             END DO 
    709 !$OMP END DO NOWAIT 
    710          END DO 
    711       END DO 
    712 !$OMP DO schedule(static) private(jj, ji) 
    713       DO jj = 1, jpj 
    714          DO ji = 1, jpi 
    715             u_ice_b(ji,jj)     = u_ice(ji,jj) 
    716             v_ice_b(ji,jj)     = v_ice(ji,jj) 
    717             at_i_b (ji,jj)     = 0._wp 
    718          END DO 
    719       END DO 
    720       DO jl = 1, jpl 
    721 !$OMP DO schedule(static) private(jj, ji) 
    722          DO jj = 1, jpj 
    723             DO ji = 1, jpi 
    724                ! 
    725                at_i_b (ji,jj)     = at_i_b (ji,jj) + a_i_b(ji,jj,jl) 
    726             END DO 
    727          END DO 
    728       END DO 
    729 !$OMP END PARALLEL 
     592      a_i_b  (:,:,:)   = a_i  (:,:,:)     ! ice area 
     593      e_i_b  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy 
     594      v_i_b  (:,:,:)   = v_i  (:,:,:)     ! ice volume 
     595      v_s_b  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
     596      e_s_b  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy 
     597      smv_i_b(:,:,:)   = smv_i(:,:,:)     ! salt content 
     598      oa_i_b (:,:,:)   = oa_i (:,:,:)     ! areal age content 
     599      u_ice_b(:,:)     = u_ice(:,:) 
     600      v_ice_b(:,:)     = v_ice(:,:) 
     601      ! 
     602      at_i_b (:,:)     = SUM( a_i_b(:,:,:), dim=3 ) 
    730603       
    731604   END SUBROUTINE sbc_lim_bef 
    … …  
    739612      !!               of the time step 
    740613      !!---------------------------------------------------------------------- 
    741       INTEGER  ::   jj, ji         ! dummy loop index 
    742  
    743 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    744       DO jj = 1, jpj 
    745          DO ji = 1, jpi 
    746             sfx    (ji,jj) = 0._wp   ; 
    747             sfx_bri(ji,jj) = 0._wp   ;   sfx_lam(ji,jj) = 0._wp 
    748             sfx_sni(ji,jj) = 0._wp   ;   sfx_opw(ji,jj) = 0._wp 
    749             sfx_bog(ji,jj) = 0._wp   ;   sfx_dyn(ji,jj) = 0._wp 
    750             sfx_bom(ji,jj) = 0._wp   ;   sfx_sum(ji,jj) = 0._wp 
    751             sfx_res(ji,jj) = 0._wp   ;   sfx_sub(ji,jj) = 0._wp 
    752             ! 
    753             wfx_snw(ji,jj) = 0._wp   ;   wfx_ice(ji,jj) = 0._wp 
    754             wfx_sni(ji,jj) = 0._wp   ;   wfx_opw(ji,jj) = 0._wp 
    755             wfx_bog(ji,jj) = 0._wp   ;   wfx_dyn(ji,jj) = 0._wp 
    756             wfx_bom(ji,jj) = 0._wp   ;   wfx_sum(ji,jj) = 0._wp 
    757             wfx_res(ji,jj) = 0._wp   ;   wfx_sub(ji,jj) = 0._wp 
    758             wfx_spr(ji,jj) = 0._wp   ;   wfx_lam(ji,jj) = 0._wp   
     614      sfx    (:,:) = 0._wp   ; 
     615      sfx_bri(:,:) = 0._wp   ;   sfx_lam(:,:) = 0._wp 
     616      sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
     617      sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
     618      sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
     619      sfx_res(:,:) = 0._wp   ;   sfx_sub(:,:) = 0._wp 
     620      ! 
     621      wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
     622      wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
     623      wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp 
     624      wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
     625      wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
     626      wfx_spr(:,:) = 0._wp   ;   wfx_lam(:,:) = 0._wp   
    759627       
    760             hfx_thd(ji,jj) = 0._wp   ; 
    761             hfx_snw(ji,jj) = 0._wp   ;   hfx_opw(ji,jj) = 0._wp 
    762             hfx_bog(ji,jj) = 0._wp   ;   hfx_dyn(ji,jj) = 0._wp 
    763             hfx_bom(ji,jj) = 0._wp   ;   hfx_sum(ji,jj) = 0._wp 
    764             hfx_res(ji,jj) = 0._wp   ;   hfx_sub(ji,jj) = 0._wp 
    765             hfx_spr(ji,jj) = 0._wp   ;   hfx_dif(ji,jj) = 0._wp 
    766             hfx_err(ji,jj) = 0._wp   ;   hfx_err_rem(ji,jj) = 0._wp 
    767             hfx_err_dif(ji,jj) = 0._wp 
    768             wfx_err_sub(ji,jj) = 0._wp 
    769             ! 
    770             afx_tot(ji,jj) = 0._wp   ; 
    771             afx_dyn(ji,jj) = 0._wp   ;   afx_thd(ji,jj) = 0._wp 
    772             ! 
    773             diag_heat(ji,jj) = 0._wp ;   diag_smvi(ji,jj) = 0._wp 
    774             diag_vice(ji,jj) = 0._wp ;   diag_vsnw(ji,jj) = 0._wp 
    775        
    776             tau_icebfr(ji,jj) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 
    777          END DO 
    778       END DO 
     628      hfx_thd(:,:) = 0._wp   ; 
     629      hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
     630      hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp 
     631      hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp 
     632      hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
     633      hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp 
     634      hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
     635      hfx_err_dif(:,:) = 0._wp 
     636      wfx_err_sub(:,:) = 0._wp 
     637      ! 
     638      afx_tot(:,:) = 0._wp   ; 
     639      afx_dyn(:,:) = 0._wp   ;   afx_thd(:,:) = 0._wp 
     640      ! 
     641      diag_heat(:,:) = 0._wp ;   diag_smvi(:,:) = 0._wp 
     642      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp 
     643 
     644      tau_icebfr(:,:) = 0._wp; ! landfast ice param only (clem: important to keep the init here) 
    779645       
    780646   END SUBROUTINE sbc_lim_diag0 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7698 r7753  
    8484      !!              - nsbc: type of sbc 
    8585      !!---------------------------------------------------------------------- 
    86       INTEGER ::   ji, jj, jn                        ! dummy loop indices 
    8786      INTEGER ::   ios, icpt                         ! local integer 
    8887      LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical 
    … …  
    241240      IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero 
    242241         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 
    243 !$OMP PARALLEL 
    244 !$OMP DO schedule(static) private(jj,ji) 
    245          DO jj = 1, jpj 
    246             DO ji = 1, jpi 
    247                fwfisf  (ji,jj)   = 0.0_wp ; fwfisf_b  (ji,jj)   = 0.0_wp 
    248             END DO 
    249          END DO 
    250 !$OMP END DO NOWAIT 
    251          DO jn = 1, jpts 
    252 !$OMP DO schedule(static) private(jj,ji) 
    253             DO jj = 1, jpj 
    254                DO ji = 1, jpi 
    255                   risf_tsc(ji,jj,jn) = 0.0_wp ; risf_tsc_b(ji,jj,jn) = 0.0_wp 
    256                END DO 
    257             END DO 
    258          END DO 
    259 !$OMP END PARALLEL 
     242         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp 
     243         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp 
    260244      END IF 
    261245      IF( nn_ice == 0 ) THEN        !* No sea-ice in the domain : ice fraction is always zero 
    262          IF( nn_components /= jp_iam_opa ) THEN 
    263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    264             DO jj = 1, jpj 
    265                DO ji = 1, jpi 
    266                   fr_i(ji,jj) = 0._wp    ! except for OPA in SAS-OPA coupled case 
    267                END DO 
    268             END DO 
    269          END IF 
    270       ENDIF 
    271       ! 
    272 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    273       DO jj = 1, jpj 
    274          DO ji = 1, jpi 
    275             sfx   (ji,jj) = 0._wp           !* salt flux due to freezing/melting 
    276             fmmflx(ji,jj) = 0._wp           !* freezing minus melting flux 
    277             taum  (ji,jj) = 0._wp           !* wind stress module (needed in GLS in case of reduced restart) 
    278          END DO 
    279       END DO 
     246         IF( nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! except for OPA in SAS-OPA coupled case 
     247      ENDIF 
     248      ! 
     249      sfx   (:,:) = 0._wp           !* salt flux due to freezing/melting 
     250      fmmflx(:,:) = 0._wp           !* freezing minus melting flux 
     251 
     252      taum(:,:) = 0._wp             !* wind stress module (needed in GLS in case of reduced restart) 
    280253 
    281254      !                          ! Choice of the Surface Boudary Condition (set nsbc) 
    … …  
    383356      !!---------------------------------------------------------------------- 
    384357      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    385       INTEGER ::   ji, jj, jn       ! dummy loop indices 
    386358      ! 
    387359      LOGICAL ::   ll_sas, ll_opa   ! local logical 
    … …  
    393365      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
    394366         !                                         ! ---------------------------------------- ! 
    395 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    396          DO jj = 1, jpj 
    397             DO ji = 1, jpi 
    398                utau_b(ji,jj) = utau(ji,jj)                         ! Swap the ocean forcing fields 
    399                vtau_b(ji,jj) = vtau(ji,jj)                         ! (except at nit000 where before fields 
    400                qns_b (ji,jj) = qns (ji,jj)                         !  are set at the end of the routine) 
    401                emp_b (ji,jj) = emp (ji,jj) 
    402                sfx_b (ji,jj) = sfx (ji,jj) 
    403             END DO 
    404          END DO 
     367         utau_b(:,:) = utau(:,:)                         ! Swap the ocean forcing fields 
     368         vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields 
     369         qns_b (:,:) = qns (:,:)                         !  are set at the end of the routine) 
     370         emp_b (:,:) = emp (:,:) 
     371         sfx_b (:,:) = sfx (:,:) 
    405372         IF ( ln_rnf ) THEN 
    406 !$OMP PARALLEL 
    407 !$OMP DO schedule(static) private(jj,ji) 
    408             DO jj = 1, jpj 
    409                DO ji = 1, jpi 
    410                   rnf_b    (ji,jj  ) = rnf    (ji,jj  ) 
    411                END DO 
    412             END DO 
    413 !$OMP END DO NOWAIT 
    414             DO jn = 1, jpts 
    415 !$OMP DO schedule(static) private(jj,ji) 
    416                DO jj = 1, jpj 
    417                   DO ji = 1, jpi 
    418                      rnf_tsc_b(ji,jj,jn) = rnf_tsc(ji,jj,jn) 
    419                   END DO 
    420                END DO 
    421             END DO 
    422 !$OMP END PARALLEL 
     373            rnf_b    (:,:  ) = rnf    (:,:  ) 
     374            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
    423375         ENDIF 
    424376      ENDIF 
    … …  
    449401      END SELECT 
    450402      IF ( ln_wave .AND. ln_tauoc) THEN                                 ! Wave stress subctracted 
    451 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    452          DO jj = 1, jpj 
    453             DO ji = 1, jpi 
    454                utau(ji,jj) = utau(ji,jj)*tauoc_wave(ji,jj) 
    455                vtau(ji,jj) = vtau(ji,jj)*tauoc_wave(ji,jj) 
    456                taum(ji,jj) = taum(ji,jj)*tauoc_wave(ji,jj) 
    457             END DO 
    458          END DO 
     403            utau(:,:) = utau(:,:)*tauoc_wave(:,:) 
     404            vtau(:,:) = vtau(:,:)*tauoc_wave(:,:) 
     405            taum(:,:) = taum(:,:)*tauoc_wave(:,:) 
    459406      ! 
    460407            SELECT CASE( nsbc ) 
    … …  
    510457               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point) 
    511458            ELSE 
    512 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    513                DO jj = 1, jpj 
    514                   DO ji = 1, jpi 
    515                      sfx_b (ji,jj) = sfx(ji,jj) 
    516                   END DO 
    517                END DO 
     459               sfx_b (:,:) = sfx(:,:) 
    518460            ENDIF 
    519461         ELSE                                                   !* no restart: set from nit000 values 
    520462            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000' 
    521 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    522             DO jj = 1, jpj 
    523                DO ji = 1, jpi 
    524                   utau_b(ji,jj) = utau(ji,jj) 
    525                   vtau_b(ji,jj) = vtau(ji,jj) 
    526                   qns_b (ji,jj) = qns (ji,jj) 
    527                   emp_b (ji,jj) = emp(ji,jj) 
    528                   sfx_b (ji,jj) = sfx(ji,jj) 
    529                END DO 
    530             END DO 
     463            utau_b(:,:) = utau(:,:) 
     464            vtau_b(:,:) = vtau(:,:) 
     465            qns_b (:,:) = qns (:,:) 
     466            emp_b (:,:) = emp (:,:) 
     467            sfx_b (:,:) = sfx (:,:) 
    531468         ENDIF 
    532469      ENDIF 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r7698 r7753  
    103103      INTEGER, INTENT(in) ::   kt          ! ocean time step 
    104104      ! 
    105       INTEGER  ::   ji, jj, jn    ! dummy loop indices 
    106       INTEGER  ::   z_err = 0     ! dummy integer for error handling 
     105      INTEGER  ::   ji, jj    ! dummy loop indices 
     106      INTEGER  ::   z_err = 0 ! dummy integer for error handling 
    107107      !!---------------------------------------------------------------------- 
    108108      REAL(wp), DIMENSION(:,:), POINTER       ::   ztfrz   ! freezing point used for temperature correction 
    … …  
    120120      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    121121         ! 
    122          IF( .NOT. l_rnfcpl ) THEN                             ! updated runoff value at time step kt 
    123 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    124             DO jj = 1, jpj 
    125                DO ji = 1, jpi 
    126                   rnf(ji,jj) = rn_rfact * ( sf_rnf(1)%fnow(ji,jj,1) ) 
    127                END DO 
    128             END DO 
    129          END IF 
     122         IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
    130123         ! 
    131124         !                                                     ! set temperature & salinity content of runoffs 
    132125         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
    133 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    134             DO jj = 1, jpj 
    135                DO ji = 1, jpi 
    136                   rnf_tsc(ji,jj,jp_tem) = ( sf_t_rnf(1)%fnow(ji,jj,1) ) * rnf(ji,jj) * r1_rau0 
    137                END DO 
    138             END DO 
     126            rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    139127            CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 
    140 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    141             DO jj = 1, jpj 
    142                DO ji = 1, jpi 
    143                   IF ( sf_t_rnf(1)%fnow(ji,jj,1) == -999._wp ) THEN            ! if missing data value use SST as runoffs temperature 
    144                      rnf_tsc(ji,jj,jp_tem) = sst_m(ji,jj) * rnf(ji,jj) * r1_rau0 
    145                   END IF 
    146                   IF ( sf_t_rnf(1)%fnow(ji,jj,1) == -222._wp ) THEN            ! where fwf comes from melting of ice shelves or iceberg 
    147                      rnf_tsc(ji,jj,jp_tem) = ztfrz(ji,jj) * rnf(ji,jj) * r1_rau0 - rnf(ji,jj) * rlfusisf * r1_rau0_rcp 
    148                   END IF 
    149                END DO 
    150             END DO 
     128            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
     129               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
     130            END WHERE 
     131            WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
     132               rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rlfusisf * r1_rau0_rcp 
     133            END WHERE 
    151134         ELSE                                                        ! use SST as runoffs temperature 
    152 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    153             DO jj = 1, jpj 
    154                DO ji = 1, jpi 
    155                   rnf_tsc(ji,jj,jp_tem) = sst_m(ji,jj) * rnf(ji,jj) * r1_rau0 
    156                END DO 
    157             END DO 
    158          END IF 
     135            rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
     136         ENDIF 
    159137         !                                                           ! use runoffs salinity data 
    160          IF( ln_rnf_sal ) THEN 
    161 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    162             DO jj = 1, jpj 
    163                DO ji = 1, jpi 
    164                   rnf_tsc(ji,jj,jp_sal) = ( sf_s_rnf(1)%fnow(ji,jj,1) ) * rnf(ji,jj) * r1_rau0 
    165                END DO 
    166             END DO 
    167          END IF 
    168          !                                                        ! else use S=0 for runoffs (done one for all in the init) 
     138         IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     139         !                                                           ! else use S=0 for runoffs (done one for all in the init) 
    169140         CALL iom_put( "runoffs", rnf )         ! output runoffs arrays 
    170141      ENDIF 
    … …  
    181152         ELSE                                                   !* no restart: set from nit000 values 
    182153            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    183 !$OMP PARALLEL 
    184 !$OMP DO schedule(static) private(jj,ji) 
    185             DO jj = 1, jpj 
    186                DO ji = 1, jpi 
    187                   rnf_b    (ji,jj  ) = rnf    (ji,jj  ) 
    188                END DO 
    189             END DO 
    190 !$OMP END DO NOWAIT 
    191             DO jn = 1, jpts 
    192 !$OMP DO schedule(static) private(jj,ji) 
    193                DO jj = 1, jpj 
    194                   DO ji = 1, jpi 
    195                      rnf_tsc_b(ji,jj,jn) = rnf_tsc(ji,jj,jn) 
    196                   END DO 
    197                END DO 
    198             END DO 
    199 !$OMP END PARALLEL 
     154            rnf_b    (:,:  ) = rnf    (:,:  ) 
     155            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
    200156         ENDIF 
    201157      ENDIF 
    … …  
    231187      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence 
    232188      !! 
    233       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     189      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    234190      REAL(wp) ::   zfact     ! local scalar 
    235191      !!---------------------------------------------------------------------- 
    … …  
    239195      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    240196         IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow 
    241 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 
    242197            DO jj = 1, jpj 
    243198               DO ji = 1, jpi 
    … …  
    248203            END DO 
    249204         ELSE                    !* variable volume case 
    250 !$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 
    251205            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 
    252206               DO ji = 1, jpi 
    … …  
    263217         ENDIF 
    264218      ELSE                       !==   runoff put only at the surface   ==! 
    265 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    266          DO jj = 1, jpj 
    267             DO ji = 1, jpi 
    268                h_rnf (ji,jj)   = e3t_n (ji,jj,1)        ! update h_rnf to be depth of top box 
    269                phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / e3t_n(ji,jj,1) 
    270             END DO 
    271          END DO 
     219         h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box 
     220         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 
    272221      ENDIF 
    273222      ! 
    … …  
    286235      !!---------------------------------------------------------------------- 
    287236      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name 
    288       INTEGER           ::   ji, jj, jk, jm, jn    ! dummy loop indices 
     237      INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices 
    289238      INTEGER           ::   ierror, inum  ! temporary integer 
    290239      INTEGER           ::   ios           ! Local integer output status for namelist read 
    … …  
    307256         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl 
    308257         nkrnf         = 0 
    309 !$OMP PARALLEL 
    310 !$OMP DO schedule(static) private(jj, ji) 
    311          DO jj = 1, jpj 
    312             DO ji = 1, jpi 
    313                rnf     (ji,jj) = 0.0_wp 
    314                rnf_b   (ji,jj) = 0.0_wp 
    315                rnfmsk  (ji,jj) = 0.0_wp 
    316             END DO 
    317          END DO 
    318 !$OMP END DO NOWAIT 
    319 !$OMP DO schedule(static) private(jk) 
    320          DO jk = 1, jpk 
    321             rnfmsk_z(jk)   = 0.0_wp 
    322          END DO 
    323 !$OMP END PARALLEL 
     258         rnf     (:,:) = 0.0_wp 
     259         rnf_b   (:,:) = 0.0_wp 
     260         rnfmsk  (:,:) = 0.0_wp 
     261         rnfmsk_z(:)   = 0.0_wp 
    324262         RETURN 
    325263      ENDIF 
    … …  
    400338         CALL iom_close( inum )                                        ! close file 
    401339         ! 
    402 !$OMP PARALLEL 
    403 !$OMP DO schedule(static) private(jj, ji) 
    404          DO jj = 1, jpj 
    405             DO ji = 1, jpi 
    406                nk_rnf(ji,jj) = 0                               ! set the number of level over which river runoffs are applied 
    407             END DO 
    408          END DO 
    409 !$OMP DO schedule(static) private(jj, ji, jk) 
     340         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    410341         DO jj = 1, jpj 
    411342            DO ji = 1, jpi 
    … …  
    423354            END DO 
    424355         END DO 
    425 !$OMP DO schedule(static) private(jj, ji, jk) 
    426356         DO jj = 1, jpj                                ! set the associated depth 
    427357            DO ji = 1, jpi 
    … …  
    432362            END DO 
    433363         END DO 
    434 !$OMP END PARALLEL 
    435364         ! 
    436365      ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface 
    … …  
    452381         DEALLOCATE( zrnfcl ) 
    453382         ! 
     383         h_rnf(:,:) = 1. 
     384         ! 
    454385         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff) 
    455386         ! 
    456 !$OMP PARALLEL 
    457          IF( zrnf(ji,jj) > 0._wp ) THEN 
    458 !$OMP DO schedule(static) private(jj, ji) 
    459             DO jj = 1, jpj 
    460                DO ji = 1, jpi 
    461                   h_rnf(ji,jj) = zacoef * zrnf(ji,jj)   ! compute depth for all runoffs 
    462                END DO 
    463             END DO 
    464          END IF 
    465          ! 
    466 !$OMP DO schedule(static) private(jj, ji, jk) 
     387         WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs 
     388         ! 
    467389         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin 
    468390            DO ji = 1, jpi 
    … …  
    474396         END DO 
    475397         ! 
    476 !$OMP DO schedule(static) private(jj, ji) 
    477          DO jj = 1, jpj 
    478             DO ji = 1, jpi 
    479                nk_rnf(ji,jj) = 0                       ! number of levels on which runoffs are distributed 
    480             END DO 
    481          END DO 
    482 !$OMP DO schedule(static) private(jj, ji, jk) 
     398         nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed 
    483399         DO jj = 1, jpj 
    484400            DO ji = 1, jpi 
    … …  
    493409            END DO 
    494410         END DO 
    495 !$OMP END PARALLEL 
    496411         ! 
    497412         DEALLOCATE( zrnf ) 
    498413         ! 
    499 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    500414         DO jj = 1, jpj                                ! set the associated depth 
    501415            DO ji = 1, jpi 
    … …  
    514428         ENDIF 
    515429      ELSE                                       ! runoffs applied at the surface 
    516 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    517          DO jj = 1, jpj 
    518             DO ji = 1, jpi 
    519                nk_rnf(ji,jj) = 1 
    520                h_rnf (ji,jj) = e3t_n(ji,jj,1) 
    521             END DO 
    522          END DO 
    523       ENDIF 
    524       ! 
    525 !$OMP PARALLEL 
    526 !$OMP DO schedule(static) private(jj, ji) 
    527       DO jj = 1, jpj 
    528          DO ji = 1, jpi 
    529             rnf(ji,jj) =  0._wp                         ! runoff initialisation 
    530          END DO 
    531       END DO 
    532 !$OMP END DO NOWAIT 
    533       DO jn = 1, jpts 
    534 !$OMP DO schedule(static) private(jj, ji) 
    535          DO jj = 1, jpj 
    536             DO ji = 1, jpi 
    537                rnf_tsc(ji,jj,jn) = 0._wp                    ! runoffs temperature & salinty contents initilisation 
    538             END DO 
    539          END DO 
    540       END DO 
    541 !$OMP END PARALLEL 
     430         nk_rnf(:,:) = 1 
     431         h_rnf (:,:) = e3t_n(:,:,1) 
     432      ENDIF 
     433      ! 
     434      rnf(:,:) =  0._wp                         ! runoff initialisation 
     435      rnf_tsc(:,:,:) = 0._wp                    ! runoffs temperature & salinty contents initilisation 
    542436      ! 
    543437      !                                   ! ======================== 
    … …  
    572466         IF(lwp) WRITE(numout,*) 
    573467         IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths' 
    574 !$OMP PARALLEL 
    575 !$OMP DO schedule(static) private(jj, ji) 
    576          DO jj = 1, jpj 
    577             DO ji = 1, jpi 
    578                rnfmsk  (ji,jj) = 0._wp 
    579             END DO 
    580          END DO 
    581 !$OMP END DO NOWAIT 
    582 !$OMP DO schedule(static) private(jk) 
    583          DO jk = 1, jpk 
    584             rnfmsk_z(jk)   = 0._wp 
    585          END DO 
    586 !$OMP END PARALLEL 
     468         rnfmsk  (:,:) = 0._wp 
     469         rnfmsk_z(:)   = 0._wp 
    587470         nkrnf = 0 
    588471      ENDIF 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r7698 r7753  
    5959      ! 
    6060      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 
    61 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    6261      DO jj = 1, jpj 
    6362         DO ji = 1, jpi 
    … …  
    6968      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    7069         !                                                ! ---------------------------------------- ! 
    71 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    72          DO jj = 1, jpj 
    73             DO ji = 1, jpi 
    74                ssu_m(ji,jj) = ub(ji,jj,1) 
    75                ssv_m(ji,jj) = vb(ji,jj,1) 
    76             END DO 
    77          END DO 
    78          IF( l_useCT )  THEN 
    79            sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    80          ELSE                     
    81 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    82             DO jj = 1, jpj 
    83                DO ji = 1, jpi 
    84                   sst_m(ji,jj) = zts(ji,jj,jp_tem) 
    85                END DO 
    86             END DO 
    87          ENDIF 
    88 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    89          DO jj = 1, jpj 
    90             DO ji = 1, jpi 
    91                sss_m(ji,jj) = zts(ji,jj,jp_sal) 
    92             END DO 
    93          END DO 
     70         ssu_m(:,:) = ub(:,:,1) 
     71         ssv_m(:,:) = vb(:,:,1) 
     72         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     73         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
     74         ENDIF 
     75         sss_m(:,:) = zts(:,:,jp_sal) 
    9476         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    95          IF( ln_apr_dyn ) THEN   
    96 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    97             DO jj = 1, jpj 
    98                DO ji = 1, jpi 
    99                   ssh_m(ji,jj) = sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) 
    100                END DO 
    101             END DO 
    102          ELSE                     
    103 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    104             DO jj = 1, jpj 
    105                DO ji = 1, jpi 
    106                   ssh_m(ji,jj) = sshn(ji,jj) 
    107                END DO 
    108             END DO 
    109          ENDIF 
    110          ! 
    111 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    112          DO jj = 1, jpj 
    113             DO ji = 1, jpi 
    114                e3t_m(ji,jj) = e3t_n(ji,jj,1) 
    115          ! 
    116                frq_m(ji,jj) = fraqsr_1lev(ji,jj) 
    117             END DO 
    118          END DO 
     77         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     78         ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
     79         ENDIF 
     80         ! 
     81         e3t_m(:,:) = e3t_n(:,:,1) 
     82         ! 
     83         frq_m(:,:) = fraqsr_1lev(:,:) 
    11984         ! 
    12085      ELSE 
    … …  
    12691            IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    12792            zcoef = REAL( nn_fsbc - 1, wp ) 
    128 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    129             DO jj = 1, jpj 
    130                DO ji = 1, jpi 
    131                   ssu_m(ji,jj) = zcoef * ub(ji,jj,1) 
    132                   ssv_m(ji,jj) = zcoef * vb(ji,jj,1) 
    133                END DO 
    134             END DO 
    135             IF( l_useCT )  THEN 
    136               sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    137             ELSE                     
    138 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    139               DO jj = 1, jpj 
    140                  DO ji = 1, jpi 
    141                     sst_m(ji,jj) = zcoef * zts(ji,jj,jp_tem) 
    142                  END DO 
    143               END DO 
    144             ENDIF 
    145 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    146             DO jj = 1, jpj 
    147                DO ji = 1, jpi 
    148                   sss_m(ji,jj) = zcoef * zts(ji,jj,jp_sal) 
    149                END DO 
    150             END DO 
     93            ssu_m(:,:) = zcoef * ub(:,:,1) 
     94            ssv_m(:,:) = zcoef * vb(:,:,1) 
     95            IF( l_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     96            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
     97            ENDIF 
     98            sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
    15199            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    152             IF( ln_apr_dyn ) THEN    
    153 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    154                DO jj = 1, jpj 
    155                   DO ji = 1, jpi 
    156                      ssh_m(ji,jj) = zcoef * ( sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) ) 
    157                   END DO 
    158                END DO 
    159             ELSE                     
    160 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    161                DO jj = 1, jpj 
    162                   DO ji = 1, jpi 
    163                      ssh_m(ji,jj) = zcoef * sshn(ji,jj) 
    164                   END DO 
    165                END DO 
    166             ENDIF 
    167             ! 
    168 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    169             DO jj = 1, jpj 
    170                DO ji = 1, jpi 
    171                   e3t_m(ji,jj) = zcoef * e3t_n(ji,jj,1) 
    172                   ! 
    173                   frq_m(ji,jj) = zcoef * fraqsr_1lev(ji,jj) 
    174                END DO 
    175             END DO 
     100            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
     101            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
     102            ENDIF 
     103            ! 
     104            e3t_m(:,:) = zcoef * e3t_n(:,:,1) 
     105            ! 
     106            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
    176107            !                                             ! ---------------------------------------- ! 
    177108         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
    178109            !                                             ! ---------------------------------------- ! 
    179 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    180             DO jj = 1, jpj 
    181                DO ji = 1, jpi 
    182                   ssu_m(ji,jj) = 0._wp     ! reset to zero ocean mean sbc fields 
    183                   ssv_m(ji,jj) = 0._wp 
    184                   sst_m(ji,jj) = 0._wp 
    185                   sss_m(ji,jj) = 0._wp 
    186                   ssh_m(ji,jj) = 0._wp 
    187                   e3t_m(ji,jj) = 0._wp 
    188                   frq_m(ji,jj) = 0._wp 
    189                END DO 
    190             END DO 
     110            ssu_m(:,:) = 0._wp     ! reset to zero ocean mean sbc fields 
     111            ssv_m(:,:) = 0._wp 
     112            sst_m(:,:) = 0._wp 
     113            sss_m(:,:) = 0._wp 
     114            ssh_m(:,:) = 0._wp 
     115            e3t_m(:,:) = 0._wp 
     116            frq_m(:,:) = 0._wp 
    191117         ENDIF 
    192118         !                                                ! ---------------------------------------- ! 
    193119         !                                                !        Cumulate at each time step        ! 
    194120         !                                                ! ---------------------------------------- ! 
    195 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    196          DO jj = 1, jpj 
    197             DO ji = 1, jpi 
    198                ssu_m(ji,jj) = ssu_m(ji,jj) + ub(ji,jj,1) 
    199                ssv_m(ji,jj) = ssv_m(ji,jj) + vb(ji,jj,1) 
    200             END DO 
    201          END DO 
    202          IF( l_useCT )  THEN    
    203            sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    204          ELSE                    
    205 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    206            DO jj = 1, jpj 
    207               DO ji = 1, jpi 
    208                  sst_m(ji,jj) = sst_m(ji,jj) + zts(ji,jj,jp_tem) 
    209               END DO 
    210            END DO 
    211          ENDIF 
    212 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    213          DO jj = 1, jpj 
    214             DO ji = 1, jpi 
    215                sss_m(ji,jj) = sss_m(ji,jj) + zts(ji,jj,jp_sal) 
    216             END DO 
    217          END DO 
     121         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
     122         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
     123         IF( l_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     124         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
     125         ENDIF 
     126         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
    218127         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    219          IF( ln_apr_dyn ) THEN    
    220 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    221             DO jj = 1, jpj 
    222                DO ji = 1, jpi 
    223                   ssh_m(ji,jj) = ssh_m(ji,jj) + sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) 
    224                END DO 
    225             END DO 
    226          ELSE                     
    227 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    228            DO jj = 1, jpj 
    229               DO ji = 1, jpi 
    230                  ssh_m(ji,jj) = ssh_m(ji,jj) + sshn(ji,jj) 
    231               END DO 
    232            END DO 
    233          ENDIF 
    234          ! 
    235 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    236          DO jj = 1, jpj 
    237             DO ji = 1, jpi 
    238                e3t_m(ji,jj) = e3t_m(ji,jj) + e3t_n(ji,jj,1) 
    239                ! 
    240                frq_m(ji,jj) = frq_m(ji,jj) + fraqsr_1lev(ji,jj) 
    241             END DO 
    242          END DO 
     128         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     129         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
     130         ENDIF 
     131         ! 
     132         e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 
     133         ! 
     134         frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 
    243135 
    244136         !                                                ! ---------------------------------------- ! 
    … …  
    246138            !                                             ! ---------------------------------------- ! 
    247139            zcoef = 1. / REAL( nn_fsbc, wp ) 
    248 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    249             DO jj = 1, jpj 
    250                DO ji = 1, jpi 
    251                   sst_m(ji,jj) = sst_m(ji,jj) * zcoef     ! mean SST             [Celsius] 
    252                   sss_m(ji,jj) = sss_m(ji,jj) * zcoef     ! mean SSS             [psu] 
    253                   ssu_m(ji,jj) = ssu_m(ji,jj) * zcoef     ! mean suface current  [m/s] 
    254                   ssv_m(ji,jj) = ssv_m(ji,jj) * zcoef     ! 
    255                   ssh_m(ji,jj) = ssh_m(ji,jj) * zcoef     ! mean SSH             [m] 
    256                   e3t_m(ji,jj) = e3t_m(ji,jj) * zcoef     ! mean vertical scale factor [m] 
    257                   frq_m(ji,jj) = frq_m(ji,jj) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
    258                END DO 
    259             END DO 
     140            sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celsius] 
     141            sss_m(:,:) = sss_m(:,:) * zcoef     ! mean SSS             [psu] 
     142            ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s] 
     143            ssv_m(:,:) = ssv_m(:,:) * zcoef     ! 
     144            ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m] 
     145            e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m] 
     146            frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
    260147            ! 
    261148         ENDIF 
    … …  
    303190      !!---------------------------------------------------------------------- 
    304191      REAL(wp) ::   zcoef, zf_sbc   ! local scalar 
    305       INTEGER  ::   ji, jj          ! loop index 
    306192      !!---------------------------------------------------------------------- 
    307193      ! 
    … …  
    331217               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  ) 
    332218            ELSE 
    333 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    334                DO jj = 1, jpj 
    335                   DO ji = 1, jpi 
    336                      frq_m(ji,jj) = 1._wp   ! default definition 
    337                   END DO 
    338                END DO 
     219               frq_m(:,:) = 1._wp   ! default definition 
    339220            ENDIF 
    340221            ! 
    … …  
    342223               IF(lwp) WRITE(numout,*) '   restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc  
    343224               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc  
    344 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    345                DO jj = 1, jpj 
    346                   DO ji = 1, jpi 
    347                      ssu_m(ji,jj) = zcoef * ssu_m(ji,jj)  
    348                      ssv_m(ji,jj) = zcoef * ssv_m(ji,jj) 
    349                      sst_m(ji,jj) = zcoef * sst_m(ji,jj) 
    350                      sss_m(ji,jj) = zcoef * sss_m(ji,jj) 
    351                      ssh_m(ji,jj) = zcoef * ssh_m(ji,jj) 
    352                      e3t_m(ji,jj) = zcoef * e3t_m(ji,jj) 
    353                      frq_m(ji,jj) = zcoef * frq_m(ji,jj) 
    354                   END DO 
    355                END DO 
     225               ssu_m(:,:) = zcoef * ssu_m(:,:)  
     226               ssv_m(:,:) = zcoef * ssv_m(:,:) 
     227               sst_m(:,:) = zcoef * sst_m(:,:) 
     228               sss_m(:,:) = zcoef * sss_m(:,:) 
     229               ssh_m(:,:) = zcoef * ssh_m(:,:) 
     230               e3t_m(:,:) = zcoef * e3t_m(:,:) 
     231               frq_m(:,:) = zcoef * frq_m(:,:) 
    356232            ELSE 
    357233               IF(lwp) WRITE(numout,*) '   mean fields read in the ocean restart file' 
    … …  
    363239         ! 
    364240         IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays' 
    365 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    366             DO jj = 1, jpj 
    367                DO ji = 1, jpi 
    368                   ssu_m(ji,jj) = ub(ji,jj,1) 
    369                   ssv_m(ji,jj) = vb(ji,jj,1) 
    370                END DO 
    371             END DO 
     241         ssu_m(:,:) = ub(:,:,1) 
     242         ssv_m(:,:) = vb(:,:,1) 
    372243         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
    373244         ELSE                   ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
    374245         ENDIF 
    375 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    376          DO jj = 1, jpj 
    377             DO ji = 1, jpi 
    378                sss_m(ji,jj) = tsn  (ji,jj,1,jp_sal) 
    379                ssh_m(ji,jj) = sshn (ji,jj) 
    380                e3t_m(ji,jj) = e3t_n(ji,jj,1) 
    381                frq_m(ji,jj) = 1._wp 
    382             END DO 
    383          END DO 
     246         sss_m(:,:) = tsn  (:,:,1,jp_sal) 
     247         ssh_m(:,:) = sshn (:,:) 
     248         e3t_m(:,:) = e3t_n(:,:,1) 
     249         frq_m(:,:) = 1._wp 
    384250         ! 
    385251      ENDIF 

  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r7698 r7753  
    9393            ! 
    9494            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
    95 !$OMP PARALLEL DO schedule(static) private(jj,ji,zqrp) 
    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 !$OMP PARALLEL DO schedule(static) private(jj, ji, zerp) 
    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 !$OMP PARALLEL DO schedule(static) private(jj, ji, zerp) 
    123120               DO jj = 1, jpj 
    124121                  DO ji = 1, jpi                             

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r7698 r7753  
    237237      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    238238         ! 
    239 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    240239         DO jk = 1, jpkm1 
    241240            DO jj = 1, jpj 
    … …  
    278277      CASE( np_seos )                !==  simplified EOS  ==! 
    279278         ! 
    280 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    281279         DO jk = 1, jpkm1 
    282280            DO jj = 1, jpj 
    … …  
    347345            END DO 
    348346            ! 
    349 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, jsmp, jdof, zh, zt, zstemp, zs, ztm, zn3, zn2, zn1) 
    350347            DO jk = 1, jpkm1 
    351348               DO jj = 1, jpj 
    … …  
    402399         ! Non-stochastic equation of state 
    403400         ELSE 
    404 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    405401            DO jk = 1, jpkm1 
    406402               DO jj = 1, jpj 
    … …  
    445441      CASE( np_seos )                !==  simplified EOS  ==! 
    446442         ! 
    447 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    448443         DO jk = 1, jpkm1 
    449444            DO jj = 1, jpj 
    … …  
    498493      IF( nn_timing == 1 )   CALL timing_start('eos2d') 
    499494      ! 
    500 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    501       DO jj = 1, jpj 
    502          DO ji = 1, jpi 
    503             prd(ji,jj) = 0._wp 
    504          END DO 
    505       END DO 
     495      prd(:,:) = 0._wp 
    506496      ! 
    507497      SELECT CASE( neos ) 
    … …  
    509499      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    510500         ! 
    511 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn) 
    512501         DO jj = 1, jpjm1 
    513502            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    549538      CASE( np_seos )                !==  simplified EOS  ==! 
    550539         ! 
    551 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn) 
    552540         DO jj = 1, jpjm1 
    553541            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    601589      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    602590         ! 
    603 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    604591         DO jk = 1, jpkm1 
    605592            DO jj = 1, jpj 
    … …  
    659646      CASE( np_seos )                  !==  simplified EOS  ==! 
    660647         ! 
    661 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    662648         DO jk = 1, jpkm1 
    663649            DO jj = 1, jpj 
    … …  
    712698      IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
    713699      ! 
    714 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    715          DO jk = 1, jpts 
    716             DO jj = 1, jpj 
    717                DO ji = 1, jpi 
    718                   pab(ji,jj,jk) = 0._wp 
    719                END DO 
    720             END DO 
    721          END DO 
     700      pab(:,:,:) = 0._wp 
    722701      ! 
    723702      SELECT CASE ( neos ) 
    … …  
    725704      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    726705         ! 
    727 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn) 
    728706         DO jj = 1, jpjm1 
    729707            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    784762      CASE( np_seos )                  !==  simplified EOS  ==! 
    785763         ! 
    786 !$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn) 
    787764         DO jj = 1, jpjm1 
    788765            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    940917      IF( nn_timing == 1 ) CALL timing_start('bn2') 
    941918      ! 
    942 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrw, zaw, zbw) 
    943919      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    944920         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
    … …  
    976952      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 
    977953      !!---------------------------------------------------------------------- 
    978       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celsius] 
    979       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu] 
     954      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp   [Celsius] 
     955      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity     [psu] 
    980956      ! Leave result array automatic rather than making explicitly allocated 
    981957      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celsius] 
    … …  
    993969      z1_T0   = 1._wp/40._wp 
    994970      ! 
    995 !$OMP PARALLEL DO schedule(static) private(jj, ji, zt, zs, ztm, zn,zd) 
    996971      DO jj = 1, jpj 
    997972         DO ji = 1, jpi 
    … …  
    10491024         ! 
    10501025         z1_S0 = 1._wp / 35.16504_wp 
    1051 !$OMP PARALLEL 
    1052 !$OMP DO schedule(static) private(jj, ji, zs) 
    10531026         DO jj = 1, jpj 
    10541027            DO ji = 1, jpi 
    … …  
    10581031            END DO 
    10591032         END DO 
    1060 !$OMP DO schedule(static) private(jj, ji) 
    1061          DO jj = 1, jpj 
    1062             DO ji = 1, jpi 
    1063                ptf(ji,jj) = ptf(ji,jj) * psal(ji,jj) 
    1064             END DO 
    1065          END DO 
    1066 !$OMP END PARALLEL 
    1067          ! 
    1068          IF( PRESENT( pdep ) ) THEN 
    1069 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    1070            DO jj = 1, jpj 
    1071               DO ji = 1, jpi 
    1072                  ptf(ji,jj) = ptf(ji,jj) - 7.53e-4 * pdep(ji,jj) 
    1073               END DO 
    1074            END DO 
    1075          END IF 
     1033         ptf(:,:) = ptf(:,:) * psal(:,:) 
     1034         ! 
     1035         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
    10761036         ! 
    10771037      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==! 
    10781038         ! 
    1079 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    1080          DO jj = 1, jpj 
    1081             DO ji = 1, jpi 
    1082             ptf(ji,jj) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(ji,jj) )   & 
    1083                &                     - 2.154996e-4_wp *       psal(ji,jj)   ) * psal(ji,jj) 
    1084             END DO 
    1085          END DO 
     1039         ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
     1040            &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
    10861041            ! 
    1087          IF( PRESENT( pdep ) ) THEN 
    1088 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    1089            DO jj = 1, jpj 
    1090               DO ji = 1, jpi 
    1091                  ptf(ji,jj) = ptf(ji,jj) - 7.53e-4 * pdep(ji,jj) 
    1092               END DO 
    1093            END DO 
    1094          END IF 
     1042         IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
    10951043         ! 
    10961044      CASE DEFAULT 
    … …  
    11861134      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    11871135         ! 
    1188 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn2, zn1, zn0, zn) 
    11891136         DO jk = 1, jpkm1 
    11901137            DO jj = 1, jpj 
    … …  
    12501197      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==! 
    12511198         ! 
    1252 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    12531199         DO jk = 1, jpkm1 
    12541200            DO jj = 1, jpj 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r7698 r7753  
    8888      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    8989      ! 
    90       INTEGER :: ji, jj, jk   ! dummy loop index 
     90      INTEGER ::   jk   ! dummy loop index 
    9191      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
    9292      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    … …  
    9898      ! 
    9999      !                                          ! set time step 
    100 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    101       DO jk = 1, jpk 
    102          DO jj = 1, jpj 
    103             DO ji = 1, jpi 
    104                zun(ji,jj,jk) = 0.0 
    105                zvn(ji,jj,jk) = 0.0 
    106                zwn(ji,jj,jk) = 0.0 
    107             END DO 
    108          END DO 
    109       END DO 
     100      zun(:,:,:) = 0.0 
     101      zvn(:,:,:) = 0.0 
     102      zwn(:,:,:) = 0.0 
    110103      !     
    111104      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    … …  
    117110      !                                         !==  effective transport  ==! 
    118111      IF( ln_wave .AND. ln_sdw )  THEN 
    119 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    120112         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    121             DO jj = 1, jpj 
    122                DO ji = 1, jpi 
    123                   zun(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * ( un(ji,jj,jk) + usd(ji,jj,jk) ) 
    124                   zvn(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * ( vn(ji,jj,jk) + vsd(ji,jj,jk) ) 
    125                   zwn(ji,jj,jk) = e1e2t(ji,jj) * ( wn(ji,jj,jk) + wsd(ji,jj,jk) ) 
    126                END DO 
    127             END DO 
     113            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 
     114            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 
     115            zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) ) 
    128116         END DO 
    129117      ELSE 
    130 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    131118         DO jk = 1, jpkm1 
    132             DO jj = 1, jpj 
    133                DO ji = 1, jpi 
    134                   zun(ji,jj,jk) = e2u  (ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)    ! eulerian transport only 
    135                   zvn(ji,jj,jk) = e1v  (ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    136                   zwn(ji,jj,jk) = e1e2t(ji,jj)                   * wn(ji,jj,jk) 
    137                END DO 
    138             END DO 
     119            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)               ! eulerian transport only 
     120            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     121            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    139122         END DO 
    140123      ENDIF 
    141124      ! 
    142125      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections 
    143 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    144          DO jk = 1, jpk 
    145             DO jj = 1, jpj 
    146                DO ji = 1, jpi 
    147                   zun(ji,jj,jk) = zun(ji,jj,jk) + un_td(ji,jj,jk) 
    148                   zvn(ji,jj,jk) = zvn(ji,jj,jk) + vn_td(ji,jj,jk) 
    149                END DO 
    150             END DO 
    151          END DO 
    152       ENDIF 
    153       ! 
    154 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    155       DO jj = 1, jpj 
    156          DO ji = 1, jpi 
    157             zun(ji,jj,jpk) = 0._wp                                              ! no transport trough the bottom 
    158             zvn(ji,jj,jpk) = 0._wp 
    159             zwn(ji,jj,jpk) = 0._wp 
    160          END DO 
    161       END DO 
     126         zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
     127         zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
     128      ENDIF 
     129      ! 
     130      zun(:,:,jpk) = 0._wp                                                      ! no transport trough the bottom 
     131      zvn(:,:,jpk) = 0._wp 
     132      zwn(:,:,jpk) = 0._wp 
    162133      ! 
    163134      IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   & 
    … …  
    176147      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    177148         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    178 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    179          DO jk = 1, jpk 
    180             DO jj = 1, jpj 
    181                DO ji = 1, jpi 
    182                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
    183                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 
    184                END DO 
    185             END DO 
    186          END DO 
     149         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     150         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    187151      ENDIF 
    188152      ! 
    … …  
    205169      ! 
    206170      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
    207 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    208171         DO jk = 1, jpkm1 
    209             DO jj = 1, jpj 
    210                DO ji = 1, jpi 
    211                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
    212                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 
    213                END DO 
    214             END DO 
     172            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
     173            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 
    215174         END DO 
    216175         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r7698 r7753  
    113113      IF( l_trd .OR. l_hst )  THEN 
    114114         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    115 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    116          DO jk = 1, jpk 
    117             DO jj = 1, jpj 
    118                DO ji = 1, jpi 
    119                   ztrdx(ji,jj,jk) = 0._wp 
    120                   ztrdy(ji,jj,jk) = 0._wp 
    121                   ztrdz(ji,jj,jk) = 0._wp 
    122                END DO 
    123             END DO 
    124          END DO 
     115         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
    125116      ENDIF 
    126117      ! 
    127118      IF( l_ptr ) THEN   
    128119         CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
    129 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    130          DO jk = 1, jpk 
    131             DO jj = 1, jpj 
    132                DO ji = 1, jpi 
    133                   zptry(ji,jj,jk) = 0._wp 
    134                END DO 
    135             END DO 
    136          END DO 
     120         zptry(:,:,:) = 0._wp 
    137121      ENDIF 
    138122      !                          ! surface & bottom value : flux set to zero one for all 
    139 !$OMP PARALLEL 
    140 !$OMP DO schedule(static) private(jj, ji) 
    141       DO jj = 1, jpj 
    142          DO ji = 1, jpi 
    143             zwz(ji,jj, 1 ) = 0._wp 
    144             zwx(ji,jj,jpk) = 0._wp 
    145             zwy(ji,jj,jpk) = 0._wp 
    146             zwz(ji,jj,jpk) = 0._wp 
    147          END DO 
    148       END DO 
    149 !$OMP END DO NOWAIT 
    150 !$OMP DO schedule(static) private(jk, jj, ji) 
    151       DO jk = 1, jpk 
    152          DO jj = 1, jpj 
    153             DO ji = 1, jpi 
    154                zwi(ji,jj,jk) = 0._wp 
    155             END DO 
    156          END DO 
    157       END DO 
    158 !$OMP END PARALLEL 
     123      zwz(:,:, 1 ) = 0._wp             
     124      zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp 
     125      ! 
     126      zwi(:,:,:) = 0._wp         
    159127      ! 
    160128      DO jn = 1, kjpt            !==  loop over the tracers  ==! 
    … …  
    162130         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
    163131         !                    !* upstream tracer flux in the i and j direction  
    164 !$OMP PARALLEL 
    165 !$OMP DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui,zfm_ui) 
    166132         DO jk = 1, jpkm1 
    167133            DO jj = 1, jpjm1 
    … …  
    177143            END DO 
    178144         END DO 
    179 !$OMP END DO NOWAIT 
    180145         !                    !* upstream tracer flux in the k direction *! 
    181 !$OMP DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk) 
    182146         DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask) 
    183147            DO jj = 1, jpj 
    … …  
    189153            END DO 
    190154         END DO 
    191 !$OMP END PARALLEL 
    192155         IF( ln_linssh ) THEN    ! top ocean value (only in linear free surface as zwz has been w-masked) 
    193156            IF( ln_isfcav ) THEN             ! top of the ice-shelf cavities and at the ocean surface 
    194 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    195157               DO jj = 1, jpj 
    196158                  DO ji = 1, jpi 
    … …  
    199161               END DO    
    200162            ELSE                             ! no cavities: only at the ocean surface 
    201 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    202                DO jj = 1, jpj 
    203                   DO ji = 1, jpi 
    204                      zwz(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 
    205                   END DO 
    206                END DO 
     163               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    207164            ENDIF 
    208165         ENDIF 
    209166         !                
    210 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztra) 
    211167         DO jk = 1, jpkm1     !* trend and after field with monotonic scheme 
    212168            DO jj = 2, jpjm1 
    … …  
    225181         !                 
    226182         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
    227 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    228             DO jk = 1, jpk 
    229                DO jj = 1, jpj 
    230                   DO ji = 1, jpi 
    231                      ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 
    232                      ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 
    233                      ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 
    234                   END DO 
    235                END DO 
    236             END DO 
     183            ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:) 
    237184         END IF 
    238185         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    239          IF( l_ptr ) THEN 
    240 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    241             DO jk = 1, jpk 
    242                DO jj = 1, jpj 
    243                   DO ji = 1, jpi 
    244                      zptry(ji,jj,jk) = zwy(ji,jj,jk) 
    245                   END DO 
    246                END DO 
    247             END DO 
    248          END IF 
     186         IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:)  
    249187         ! 
    250188         !        !==  anti-diffusive flux : high order minus low order  ==! 
    … …  
    253191         ! 
    254192         CASE(  2  )                   !- 2nd order centered 
    255 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    256193            DO jk = 1, jpkm1 
    257194               DO jj = 1, jpjm1 
    … …  
    264201            ! 
    265202         CASE(  4  )                   !- 4th order centered 
    266 !$OMP PARALLEL  
    267 !$OMP DO schedule(static) private(jj, ji) 
    268             DO jj = 1, jpj 
    269                DO ji = 1, jpi 
    270                   zltu(ji,jj,jpk) = 0._wp            ! Bottom value : flux set to zero 
    271                   zltv(ji,jj,jpk) = 0._wp 
    272                END DO 
    273             END DO 
    274 !$OMP DO schedule(static) private(jk, jj, ji) 
     203            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero 
     204            zltv(:,:,jpk) = 0._wp 
    275205            DO jk = 1, jpkm1                 ! Laplacian 
    276206               DO jj = 1, jpjm1                    ! 1st derivative (gradient) 
    … …  
    287217               END DO 
    288218            END DO 
    289 !$OMP END PARALLEL 
    290219            CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
    291220            ! 
    292 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v) 
    293221            DO jk = 1, jpkm1                 ! Horizontal advective fluxes 
    294222               DO jj = 1, jpjm1 
    … …  
    304232            ! 
    305233         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
    306 !$OMP PARALLEL 
    307 !$OMP DO schedule(static) private(jj, ji) 
    308             DO jj = 1, jpj 
    309                DO ji = 1, jpi 
    310                   ztu(ji,jj,jpk) = 0._wp             ! Bottom value : flux set to zero 
    311                   ztv(ji,jj,jpk) = 0._wp 
    312                END DO 
    313             END DO 
    314 !$OMP DO schedule(static) private(jk, jj, ji) 
     234            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero 
     235            ztv(:,:,jpk) = 0._wp 
    315236            DO jk = 1, jpkm1                 ! 1st derivative (gradient) 
    316237               DO jj = 1, jpjm1 
    … …  
    321242               END DO 
    322243            END DO 
    323 !$OMP END PARALLEL 
    324244            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn) 
    325245            ! 
    326 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v, zC4t_u, zC4t_v) 
    327246            DO jk = 1, jpkm1                 ! Horizontal advective fluxes 
    328247               DO jj = 2, jpjm1 
    … …  
    345264         ! 
    346265         CASE(  2  )                   !- 2nd order centered 
    347 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    348266            DO jk = 2, jpkm1     
    349267               DO jj = 2, jpjm1 
    … …  
    357275         CASE(  4  )                   !- 4th order COMPACT 
    358276            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
    359 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    360277            DO jk = 2, jpkm1 
    361278               DO jj = 2, jpjm1 
    … …  
    368285         END SELECT 
    369286         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0 
    370 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    371             DO jj = 1, jpj 
    372                DO ji = 1, jpi 
    373                   zwz(ji,jj,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked 
    374                END DO 
    375             END DO 
     287            zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked 
    376288         ENDIF 
    377289         ! 
    … …  
    385297         !        !==  final trend with corrected fluxes  ==! 
    386298         ! 
    387 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    388299         DO jk = 1, jpkm1 
    389300            DO jj = 2, jpjm1 
    … …  
    398309         ! 
    399310         IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    400 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    401             DO jk = 1, jpk 
    402                DO jj = 1, jpj 
    403                   DO ji = 1, jpi 
    404                      ztrdx(ji,jj,jk) = ztrdx(ji,jj,jk) + zwx(ji,jj,jk)  ! <<< Add to previously computed 
    405                      ztrdy(ji,jj,jk) = ztrdy(ji,jj,jk) + zwy(ji,jj,jk)  ! <<< Add to previously computed 
    406                      ztrdz(ji,jj,jk) = ztrdz(ji,jj,jk) + zwz(ji,jj,jk)  ! <<< Add to previously computed 
    407                   END DO 
    408                END DO 
    409             END DO 
     311            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
     312            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     313            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    410314         ENDIF 
    411315            ! 
    … …  
    421325         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    422326         IF( l_ptr ) THEN   
    423 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    424             DO jk = 1, jpk 
    425                DO jj = 1, jpj 
    426                   DO ji = 1, jpi 
    427                      zptry(ji,jj,jk) = zptry(ji,jj,jk) + zwy(ji,jj,jk)  ! <<< Add to previously computed 
    428                   END DO 
    429                END DO 
    430             END DO 
     327            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    431328            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
    432329         ENDIF 
    … …  
    765662      zbig  = 1.e+40_wp 
    766663      zrtrn = 1.e-15_wp 
     664      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
    767665 
    768666      ! Search local extrema 
    … …  
    774672         &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    775673 
    776 !$OMP PARALLEL 
    777 !$OMP DO schedule(static) private(jk, jj, ji) 
    778       DO jk = 1, jpk 
    779          DO jj = 1, jpj 
    780             DO ji = 1, jpi 
    781                zbetup(ji,jj,jk) = 0._wp 
    782                zbetdo(ji,jj,jk) = 0._wp 
    783             END DO 
    784          END DO 
    785       END DO 
    786 !$OMP DO schedule(static) private(jk, jj, ji, ikm1, zup, zdo, zpos, zneg, zbt) 
    787674      DO jk = 1, jpkm1 
    788675         ikm1 = MAX(jk-1,1) 
    … …  
    819706         END DO 
    820707      END DO 
    821 !$OMP END PARALLEL 
    822708      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
    823709 
    824710      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    825711      ! ---------------------------------------- 
    826 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu) 
    827712      DO jk = 1, jpkm1 
    828713         DO jj = 2, jpjm1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r7698 r7753  
    327327            IF( ierr /= 0 )   CALL ctl_stop( 'tra_adv_mle_init: failed to allocate arrays' ) 
    328328            z1_t2 = 1._wp / ( rn_time * rn_time ) 
    329 !$OMP PARALLEL DO schedule(static) private(jj, ji, zfu, zfv) 
    330329            DO jj = 2, jpj                           ! "coriolis+ time^-1" at u- & v-points 
    331330               DO ji = fs_2, jpi   ! vector opt. 
    … …  
    348347         ! 
    349348         z1_t2 = 1._wp / ( rn_time * rn_time ) 
    350 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    351          DO jj = 1, jpj 
    352             DO ji = 1, jpi 
    353                r1_ft(ji,jj) = 1._wp / SQRT(  ff_t(ji,jj) * ff_t(ji,jj) + z1_t2 ) 
    354             END DO 
    355          END DO 
     349         r1_ft(:,:) = 1._wp / SQRT(  ff_t(:,:) * ff_t(:,:) + z1_t2  ) 
    356350         ! 
    357351      ENDIF 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90

    r7698 r7753  
    108108         ! 
    109109         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 
    110 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    111          DO jk = 1, jpk 
    112             DO jj = 1, jpj 
    113                DO ji = 1, jpi 
    114                   xind(ji,jj,jk) = 1._wp              ! set equal to 1 where up-stream is not needed 
    115                END DO 
    116             END DO 
    117          END DO 
     110         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed 
    118111         ! 
    119112         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked) 
    120113            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
    121 !$OMP PARALLEL 
    122 !$OMP DO schedule(static) private(jj, ji) 
    123             DO jj = 1, jpj 
    124                DO ji = 1, jpi 
    125                   upsmsk(ji,jj) = 0._wp                             ! not upstream by default 
    126                END DO 
    127             END DO 
     114            upsmsk(:,:) = 0._wp                             ! not upstream by default 
    128115            ! 
    129 !$OMP DO schedule(static) private(jk,jj,ji) 
    130116            DO jk = 1, jpkm1 
    131                DO jj = 1, jpj 
    132                   DO ji = 1, jpi 
    133                      xind(ji,jj,jk) = 1._wp                              &                   ! =>1 where up-stream is not needed 
    134                         &         - MAX ( rnfmsk(ji,jj) * rnfmsk_z(jk),  &                   ! =>0 near runoff mouths (& closed sea outflows) 
    135                         &                 upsmsk(ji,jj)                ) * tmask(ji,jj,jk)   ! =>0 in some user defined area 
    136                   END DO 
    137                END DO 
    138             END DO 
    139 !$OMP END DO NOWAIT 
    140 !$OMP END PARALLEL 
     117               xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed 
     118                  &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows) 
     119                  &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area 
     120            END DO 
    141121         ENDIF  
    142122         ! 
    … …  
    156136         ! 
    157137         !                                !-- first guess of the slopes 
    158 !$OMP PARALLEL 
    159 !$OMP DO schedule(static) private(jj, ji) 
    160          DO jj = 1, jpj 
    161             DO ji = 1, jpi 
    162                zwx(ji,jj,jpk) = 0._wp           ! bottom values 
    163                zwy(ji,jj,jpk) = 0._wp 
    164             END DO 
    165          END DO 
    166 !$OMP DO schedule(static) private(jk, jj, ji) 
     138         zwx(:,:,jpk) = 0._wp                   ! bottom values 
     139         zwy(:,:,jpk) = 0._wp   
    167140         DO jk = 1, jpkm1                       ! interior values 
    168141            DO jj = 1, jpjm1       
    … …  
    173146           END DO 
    174147         END DO 
    175 !$OMP END DO NOWAIT 
    176 !$OMP END PARALLEL 
    177148         CALL lbc_lnk( zwx, 'U', -1. )          ! lateral boundary conditions   (changed sign) 
    178149         CALL lbc_lnk( zwy, 'V', -1. ) 
    179150         !                                !-- Slopes of tracer 
    180 !$OMP PARALLEL 
    181 !$OMP DO schedule(static) private(jj, ji) 
    182          DO jj = 1, jpj 
    183             DO ji = 1, jpi 
    184                zslpx(ji,jj,jpk) = 0._wp                 ! bottom values 
    185                zslpy(ji,jj,jpk) = 0._wp 
    186             END DO 
    187          END DO 
    188 !$OMP DO schedule(static) private(jk, jj, ji) 
     151         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
     152         zslpy(:,:,jpk) = 0._wp 
    189153         DO jk = 1, jpkm1                       ! interior values 
    190154            DO jj = 2, jpj 
    … …  
    198162         END DO 
    199163         ! 
    200 !$OMP DO schedule(static) private(jk, jj, ji) 
    201164         DO jk = 1, jpkm1                 !-- Slopes limitation 
    202165            DO jj = 2, jpj 
    … …  
    212175         END DO 
    213176         ! 
    214 !$OMP DO schedule(static) private(jk, jj, ji, z0u, zalpha, zu, zv, zzwx, zzwy, z0v) 
    215177         DO jk = 1, jpkm1                 !-- MUSCL horizontal advective fluxes 
    216178            DO jj = 2, jpjm1 
    … …  
    233195            END DO 
    234196         END DO 
    235 !$OMP END DO NOWAIT 
    236 !$OMP END PARALLEL 
    237197         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
    238198         ! 
    239 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    240199         DO jk = 1, jpkm1                 !-- Tracer advective trend 
    241200            DO jj = 2, jpjm1       
    … …  
    260219         ! 
    261220         !                                !-- first guess of the slopes 
    262 !$OMP PARALLEL  
    263 !$OMP DO schedule(static) private(jj, ji) 
    264          DO jj = 1, jpj 
    265             DO ji = 1, jpi 
    266                zwx(ji,jj, 1 ) = 0._wp           ! surface & bottom boundary conditions 
    267                zwx(ji,jj,jpk) = 0._wp 
    268            END DO 
    269          END DO 
    270 !$OMP DO schedule(static) private(jk, jj, ji) 
     221         zwx(:,:, 1 ) = 0._wp                   ! surface & bottom boundary conditions 
     222         zwx(:,:,jpk) = 0._wp 
    271223         DO jk = 2, jpkm1                       ! interior values 
    272             DO jj = 1, jpj 
    273                DO ji = 1, jpi 
    274                   zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
    275               END DO 
    276             END DO 
     224            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 
    277225         END DO 
    278226         !                                !-- Slopes of tracer 
    279 !$OMP END DO NOWAIT 
    280 !$OMP DO schedule(static) private(jj, ji) 
    281          DO jj = 1, jpj 
    282             DO ji = 1, jpi 
    283                zslpx(ji,jj,1) = 0._wp                   ! surface values 
    284            END DO 
    285          END DO 
    286 !$OMP DO schedule(static) private(jk, jj, ji) 
     227         zslpx(:,:,1) = 0._wp                   ! surface values 
    287228         DO jk = 2, jpkm1                       ! interior value 
    288229            DO jj = 1, jpj 
    … …  
    293234            END DO 
    294235         END DO 
    295 !$OMP DO schedule(static) private(jk, jj, ji) 
    296236         DO jk = 2, jpkm1                 !-- Slopes limitation 
    297237            DO jj = 1, jpj                      ! interior values 
    … …  
    303243            END DO 
    304244         END DO 
    305 !$OMP DO schedule(static) private(jk, jj, ji, z0w, zalpha, zw, zzwx, zzwy) 
    306245         DO jk = 1, jpk-2                 !-- vertical advective flux 
    307246            DO jj = 2, jpjm1       
    … …  
    316255            END DO 
    317256         END DO 
    318 !$OMP END DO NOWAIT 
    319 !$OMP END PARALLEL 
    320257         IF( ln_linssh ) THEN                   ! top values, linear free surface only 
    321258            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean) 
    322 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    323259               DO jj = 1, jpj 
    324260                  DO ji = 1, jpi 
    … …  
    327263               END DO    
    328264            ELSE                                      ! no cavities: only at the ocean surface 
    329 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    330                DO jj = 1, jpj 
    331                   DO ji = 1, jpi 
    332                      zwx(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 
    333                   END DO 
    334                END DO 
     265               zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    335266            ENDIF 
    336267         ENDIF 
    337268         ! 
    338 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    339269         DO jk = 1, jpkm1                 !-- vertical advective trend 
    340270            DO jj = 2, jpjm1       

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r7698 r7753  
    7676      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7777      ! 
    78       INTEGER  ::   ji, jj, jk    ! dummy loop indices 
     78      INTEGER  ::   ji, jj    ! dummy loop indices 
    7979      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt 
    8080      !!---------------------------------------------------------------------- 
    … …  
    8484      IF( l_trdtra )   THEN         ! Save the input temperature trend 
    8585         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt ) 
    86 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    87          DO jk = 1, jpk 
    88             DO jj = 1, jpj 
    89                DO ji = 1, jpi 
    90                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
    91                END DO 
    92             END DO 
    93          END DO 
     86         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    9487      ENDIF 
    9588      !                             !  Add the geothermal trend on temperature 
    96 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    9789      DO jj = 2, jpjm1 
    9890         DO ji = 2, jpim1 
    … …  
    10496      ! 
    10597      IF( l_trdtra ) THEN        ! Send the trend for diagnostics 
    106 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    107          DO jk = 1, jpk 
    108             DO jj = 1, jpj 
    109                DO ji = 1, jpi 
    110                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
    111                END DO 
    112             END DO 
    113          END DO 
     98         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    11499         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    115100         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt ) 
    … …  
    177162         CASE ( 1 )                          !* constant flux 
    178163            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst 
    179 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    180             DO jj = 1, jpj 
    181                DO ji = 1, jpi 
    182                   qgh_trd0(ji,jj) = r1_rau0_rcp * rn_geoflx_cst 
    183                END DO 
    184             END DO 
     164            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 
    185165            ! 
    186166         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 
    … …  
    199179 
    200180            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data 
    201 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    202             DO jj = 1, jpj 
    203                DO ji = 1, jpi 
    204                   qgh_trd0(ji,jj) = r1_rau0_rcp * sf_qgh(1)%fnow(ji,jj,1) * 1.e-3 ! conversion in W/m2 
    205                END DO 
    206             END DO 
     181            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 
    207182            ! 
    208183         CASE DEFAULT 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r7698 r7753  
    105105      !!---------------------------------------------------------------------- 
    106106      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    107       INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    108107      ! 
    109108      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    … …  
    114113      IF( l_trdtra )   THEN                         !* Save the input trends 
    115114         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    116 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    117          DO jk = 1, jpk 
    118             DO jj = 1, jpj 
    119                DO ji = 1, jpi 
    120                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
    121                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 
    122                END DO 
    123             END DO 
    124          END DO 
     115         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     116         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    125117      ENDIF 
    126118 
    … …  
    154146 
    155147      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
    156 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    157          DO jk = 1, jpk 
    158             DO jj = 1, jpj 
    159                DO ji = 1, jpi 
    160                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
    161                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 
    162                END DO 
    163             END DO 
    164          END DO 
     148         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
     149         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    165150         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    166151         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    … …  
    210195      DO jn = 1, kjpt                                     ! tracer loop 
    211196         !                                                ! =========== 
    212 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 
    213197         DO jj = 1, jpj 
    214198            DO ji = 1, jpi 
    … …  
    218202         END DO 
    219203         !                
    220 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 
    221204         DO jj = 2, jpjm1                                    ! Compute the trend 
    222205            DO ji = 2, jpim1 
    … …  
    374357      ENDIF 
    375358      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity) 
    376 !$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 
    377359      DO jj = 1, jpj 
    378360         DO ji = 1, jpi 
    … …  
    392374      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    393375         !                                !-------------------! 
    394 !$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign) 
    395376         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 
    396377            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    425406         ! 
    426407         CASE( 1 )                                   != use of upper velocity 
    427 !$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign,zsigna) 
    428408            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0 
    429409               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    457437         CASE( 2 )                                 != bbl velocity = F( delta rho ) 
    458438            zgbbl = grav * rn_gambbl 
    459 !$OMP PARALLEL DO schedule(static) private(jj,ji,iid,iis,ikud,ikus,za,zb,zgdrho,ijd,ijs,ikvd,ikvs) 
    460439            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down 
    461440               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    554533 
    555534      !                             !* vertical index of  "deep" bottom u- and v-points 
    556 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    557535      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv) 
    558536         DO ji = 1, jpim1 
    … …  
    569547      !                                 !* sign of grad(H) at u- and v-points 
    570548      mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0 
    571 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    572549      DO jj = 1, jpjm1 
    573550         DO ji = 1, jpim1 
    … …  
    577554      END DO 
    578555      ! 
    579 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    580556      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
    581557         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
    … …  
    587563      ! 
    588564      !                             !* masked diffusive flux coefficients 
    589 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    590       DO jj = 1, jpj 
    591          DO ji = 1, jpi 
    592             ahu_bbl_0(ji,jj) = rn_ahtbbl * e2_e1u(ji,jj) * e3u_bbl_0(ji,jj) * umask(ji,jj,1) 
    593             ahv_bbl_0(ji,jj) = rn_ahtbbl * e1_e2v(ji,jj) * e3v_bbl_0(ji,jj) * vmask(ji,jj,1) 
    594          END DO 
    595       END DO 
     565      ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 
     566      ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
    596567 
    597568      ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r7698 r7753  
    102102      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    103103         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts )  
    104          DO jn = 1, jpts 
    105 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    106             DO jk = 1, jpk 
    107                DO jj = 1, jpj 
    108                   DO ji = 1, jpi 
    109                      ztrdts(ji,jj,jk,jn) = tsa(ji,jj,jk,jn)  
    110                   END DO 
    111                END DO 
    112             END DO 
    113          END DO 
     104         ztrdts(:,:,:,:) = tsa(:,:,:,:)  
    114105      ENDIF 
    115106      !                           !==  input T-S data at kt  ==! 
    … …  
    120111      CASE( 0 )                        !*  newtonian damping throughout the water column  *! 
    121112         DO jn = 1, jpts 
    122 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    123113            DO jk = 1, jpkm1 
    124114               DO jj = 2, jpjm1 
    … …  
    131121         ! 
    132122      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *! 
    133 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    134123         DO jk = 1, jpkm1 
    135124            DO jj = 2, jpjm1 
    … …  
    146135         ! 
    147136      CASE ( 2 )                       !*  no damping in the mixed layer   *! 
    148 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    149137         DO jk = 1, jpkm1 
    150138            DO jj = 2, jpjm1 
    … …  
    163151      ! 
    164152      IF( l_trdtra )   THEN       ! trend diagnostic 
    165          DO jn = 1, jpts 
    166 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    167             DO jk = 1, jpk 
    168                DO jj = 1, jpj 
    169                   DO ji = 1, jpi 
    170                      ztrdts(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) - ztrdts(ji,jj,jk,jn) 
    171                   END DO 
    172                END DO 
    173             END DO 
    174          END DO 
     153         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 
    175154         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    176155         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r7698 r7753  
    5757      !!---------------------------------------------------------------------- 
    5858      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    59       INTEGER ::   jk, jj, ji         ! dummy loop indices 
    6059      !! 
    6160      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    … …  
    6665      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    6766         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds )  
    68 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    69          DO jk = 1, jpk 
    70             DO jj = 1, jpj 
    71                DO ji = 1, jpi 
    72                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
    73                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 
    74                END DO 
    75             END DO 
    76          END DO 
     67         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
     68         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    7769      ENDIF 
    7870      ! 
    … …  
    8981      ! 
    9082      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
    91 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    92          DO jk = 1, jpk 
    93             DO jj = 1, jpj 
    94                DO ji = 1, jpi 
    95                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
    96                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 
    97                END DO 
    98             END DO 
    99          END DO 
     83         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
     84         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    10085         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    10186         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r7698 r7753  
    125125         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    126126         ! 
    127 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    128          DO jk = 1, jpk 
    129             DO jj = 1, jpj 
    130                DO ji = 1, jpi 
    131                   akz     (ji,jj,jk) = 0._wp 
    132                   ah_wslp2(ji,jj,jk) = 0._wp 
    133                END DO 
    134             END DO 
    135          END DO 
     127         akz     (:,:,:) = 0._wp       
     128         ah_wslp2(:,:,:) = 0._wp 
    136129      ENDIF 
    137130      !    
    … …  
    158151      IF( kpass == 1 ) THEN                  !==  first pass only  ==! 
    159152         ! 
    160 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w) 
    161153         DO jk = 2, jpkm1 
    162154            DO jj = 2, jpjm1 
    … …  
    180172         ! 
    181173         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
    182 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    183174            DO jk = 2, jpkm1 
    184175               DO jj = 2, jpjm1 
    … …  
    194185            ! 
    195186            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
    196 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    197187               DO jk = 2, jpkm1 
    198188                  DO jj = 1, jpjm1 
    … …  
    204194               END DO 
    205195            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
    206 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3w_2, zcoef0) 
    207196               DO jk = 2, jpkm1 
    208197                  DO jj = 1, jpjm1 
    … …  
    217206           ! 
    218207         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    219 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    220            DO jk = 1, jpk 
    221               DO jj = 1, jpj 
    222                  DO ji = 1, jpi 
    223                     akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
    224                  END DO 
    225               END DO 
    226            END DO 
     208            akz(:,:,:) = ah_wslp2(:,:,:)       
    227209         ENDIF 
    228210      ENDIF 
    … …  
    236218         !!---------------------------------------------------------------------- 
    237219!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
    238 !$OMP PARALLEL 
    239 !$OMP DO schedule(static) private(jk, jj) 
    240          DO jk = 1, jpk 
    241             DO jj = 1, jpj 
    242                zdit (1,jj,jk) = 0._wp     ;     zdit (jpi,jj,jk) = 0._wp 
    243                zdjt (1,jj,jk) = 0._wp     ;     zdjt (jpi,jj,jk) = 0._wp 
    244             END DO 
    245          END DO 
     220         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp 
     221         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp 
    246222         !!end 
    247223 
    248224         ! Horizontal tracer gradient  
    249 !$OMP DO schedule(static) private(jk, jj, ji) 
    250225         DO jk = 1, jpkm1 
    251226            DO jj = 1, jpjm1 
    … …  
    256231            END DO 
    257232         END DO 
    258 !$OMP END PARALLEL 
    259233         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
    260 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    261234            DO jj = 1, jpjm1              ! bottom correction (partial bottom cell) 
    262235               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    266239            END DO 
    267240            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
    268 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    269241               DO jj = 1, jpjm1 
    270242                  DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    280252         !!---------------------------------------------------------------------- 
    281253         ! 
    282 !$OMP PARALLEL 
    283254         DO jk = 1, jpkm1                                 ! Horizontal slab 
    284255            ! 
    285256            !                             !== Vertical tracer gradient 
    286 !$OMP DO schedule(static) private(jj, ji) 
    287             DO jj = 1 , jpj 
    288                DO ji = 1, jpi 
    289                   zdk1t(ji,jj) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1 
    290                END DO 
    291             END DO 
    292             ! 
    293             IF( jk == 1 ) THEN    
    294 !$OMP DO schedule(static) private(jj, ji) 
    295                DO jj = 1 , jpj 
    296                   DO ji = 1, jpi 
    297                      zdkt(ji,jj) = zdk1t(ji,jj)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
    298                   END DO 
    299                END DO 
    300             ELSE   
    301 !$OMP DO schedule(static) private(jj, ji) 
    302                DO jj = 1 , jpj 
    303                   DO ji = 1, jpi 
    304                      zdkt(ji,jj) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
    305                   END DO 
    306                END DO 
     257            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
     258            ! 
     259            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
     260            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 
    307261            ENDIF 
    308 !$OMP DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2) 
    309262            DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    310263               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    330283            END DO 
    331284            ! 
    332 !$OMP DO schedule(static) private(jj, ji) 
    333285            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta 
    334286               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    344296         !!---------------------------------------------------------------------- 
    345297         ! 
    346 !$OMP DO schedule(static) private(jk, jj) 
    347          DO jk = 1, jpk 
    348             DO jj = 1, jpj 
    349                ztfw(1,jj,jk) = 0._wp     ;     ztfw(jpi,jj,jk) = 0._wp 
    350             END DO 
    351          END DO 
     298         ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp 
    352299         ! 
    353300         ! Vertical fluxes 
    354301         ! --------------- 
    355302         !                          ! Surface and bottom vertical fluxes set to zero 
    356 !$OMP DO schedule(static) private(jj, ji) 
    357          DO jj = 1, jpj 
    358             DO ji = 1, jpi 
    359                ztfw(ji,jj, 1 ) = 0._wp      ;      ztfw(ji,jj,jpk) = 0._wp 
    360             END DO 
    361          END DO 
     303         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
    362304          
    363 !$OMP DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w, zcoef3, zcoef4) 
    364305         DO jk = 2, jpkm1           ! interior (2=<jk=<jpk-1) 
    365306            DO jj = 2, jpjm1 
    … …  
    386327            END DO 
    387328         END DO 
    388 !$OMP END PARALLEL 
    389329         !                                !==  add the vertical 33 flux  ==! 
    390330         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
    391 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    392331            DO jk = 2, jpkm1        
    393332               DO jj = 1, jpjm1 
    … …  
    403342            SELECT CASE( kpass ) 
    404343            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
    405 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    406344               DO jk = 2, jpkm1  
    407345                  DO jj = 1, jpjm1 
    … …  
    414352               END DO  
    415353            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
    416 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    417354               DO jk = 2, jpkm1  
    418355                  DO jj = 1, jpjm1 
    … …  
    427364         ENDIF 
    428365         !          
    429 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    430366         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
    431367            DO jj = 2, jpjm1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r7698 r7753  
    121121      IF( l_trdtra )   THEN                     
    122122         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    123 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    124          DO jk = 1, jpk 
    125             DO jj = 1, jpj 
    126                DO ji = 1, jpi 
    127                   ztrdt(ji,jj,jk) = 0._wp  
    128                   ztrds(ji,jj,jk) = 0._wp 
    129                END DO 
    130             END DO 
    131          END DO 
     123         ztrdt(:,:,jk) = 0._wp 
     124         ztrds(:,:,jk) = 0._wp 
    132125         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
    133126            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 
    … …  
    136129         ! total trend for the non-time-filtered variables.  
    137130            zfact = 1.0 / rdt 
    138 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    139131         DO jk = 1, jpkm1 
    140             DO jj = 1, jpj 
    141                DO ji = 1, jpi 
    142                   ztrdt(ji,jj,jk) = ( tsa(ji,jj,jk,jp_tem) - tsn(ji,jj,jk,jp_tem) ) * zfact 
    143                   ztrds(ji,jj,jk) = ( tsa(ji,jj,jk,jp_sal) - tsn(ji,jj,jk,jp_sal) ) * zfact 
    144                END DO 
    145             END DO 
     132            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact  
     133            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact  
    146134         END DO 
    147135         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 
    … …  
    149137         ! Store now fields before applying the Asselin filter  
    150138         ! in order to calculate Asselin filter trend later. 
    151 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    152          DO jk = 1, jpkm1 
    153             DO jj = 1, jpj 
    154                DO ji = 1, jpi 
    155                   ztrdt(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) 
    156                   ztrds(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 
    157                END DO 
    158             END DO 
    159          END DO 
     139         ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
     140         ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
    160141      ENDIF 
    161142 
    162143      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap) 
    163144         DO jn = 1, jpts 
    164 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    165145            DO jk = 1, jpkm1 
    166                DO jj = 1, jpj 
    167                   DO ji = 1, jpi 
    168                      tsn(ji,jj,jk,jn) = tsa(ji,jj,jk,jn)     
    169                   END DO 
    170                END DO 
     146               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)     
    171147            END DO 
    172148         END DO 
    … …  
    187163      ! 
    188164      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    189 !$OMP PARALLEL DO schedule(static) private(jk, zfact) 
    190165         DO jk = 1, jpkm1 
    191             DO jj = 1, jpj 
    192                DO ji = 1, jpi 
    193                   zfact = 1._wp / r2dt              
    194                   ztrdt(ji,jj,jk) = ( tsb(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) ) * zfact 
    195                   ztrds(ji,jj,jk) = ( tsb(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) ) * zfact 
    196                END DO 
    197             END DO 
     166            zfact = 1._wp / r2dt              
     167            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 
     168            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 
    198169         END DO 
    199170         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    … …  
    243214      DO jn = 1, kjpt 
    244215         ! 
    245 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztn,ztd) 
    246216         DO jk = 1, jpkm1 
    247217            DO jj = 2, jpjm1 
    … …  
    310280      ! 
    311281      DO jn = 1, kjpt       
    312 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact1,zfact2,ze3t_b,ze3t_n,ze3t_a,ze3t_d,ze3t_f,ztc_b,ztc_n,ztc_a,ztc_d,ztc_f) 
    313282         DO jk = 1, jpkm1 
    314283            zfact1 = atfp * p2dt 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r7698 r7753  
    128128      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    129129         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )  
    130 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    131             DO jk = 1, jpk 
    132                DO jj = 1, jpj 
    133                   DO ji = 1, jpi 
    134                      ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
    135                   END DO 
    136                END DO 
    137             END DO 
     130         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    138131      ENDIF 
    139132      ! 
    … …  
    149142         ELSE                                           ! No restart or restart not found: Euler forward time stepping 
    150143            z1_2 = 1._wp 
    151 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    152             DO jk = 1, jpk 
    153                DO jj = 1, jpj 
    154                   DO ji = 1, jpi 
    155                      qsr_hc_b(ji,jj,jk) = 0._wp 
    156                   END DO 
    157                END DO 
    158             END DO 
     144            qsr_hc_b(:,:,:) = 0._wp 
    159145         ENDIF 
    160146      ELSE                             !==  Swap of qsr heat content  ==! 
    161147         z1_2 = 0.5_wp 
    162 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    163             DO jk = 1, jpk 
    164                DO jj = 1, jpj 
    165                   DO ji = 1, jpi 
    166                      qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 
    167                   END DO 
    168                END DO 
    169             END DO 
     148         qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 
    170149      ENDIF 
    171150      ! 
    … …  
    176155      CASE( np_BIO )                   !==  bio-model fluxes  ==! 
    177156         ! 
    178 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    179157         DO jk = 1, nksr 
    180             DO jj = 1, jpj 
    181                DO ji = 1, jpi 
    182                   qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 
    183                END DO 
    184              END DO 
     158            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
    185159         END DO 
    186160         ! 
    … …  
    192166         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    193167            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
    194 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,zCtot,zze,zpsi,zlogc,zlogc2,zlogc3,zCb,zCmax,zpsimax,zdelpsi,zCze) 
    195168            DO jk = 1, nksr + 1 
    196169               DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl 
    … …  
    217190            END DO 
    218191         ELSE                                !* constant chrlorophyll 
    219 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    220192           DO jk = 1, nksr + 1 
    221               DO jj = 1, jpj 
    222                  DO ji = 1, jpi 
    223                     zchl3d(ji,jj,jk) = 0.05 
    224                  ENDDO 
    225               ENDDO 
     193              zchl3d(:,:,jk) = 0.05  
    226194            ENDDO 
    227195         ENDIF 
    228196         ! 
    229197         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B 
    230 !$OMP PARALLEL 
    231 !$OMP DO schedule(static) private(jj,ji) 
    232198         DO jj = 2, jpjm1 
    233199            DO ji = fs_2, fs_jpim1 
    … …  
    239205            END DO 
    240206         END DO 
    241 !$OMP END DO NOWAIT 
    242207         ! 
    243208         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl 
    244 !$OMP DO schedule(static) private(jj,ji,zchl,irgb) 
    245209            DO jj = 2, jpjm1 
    246210               DO ji = fs_2, fs_jpim1 
    … …  
    253217            END DO 
    254218 
    255 !$OMP DO schedule(static) private(jj,ji,zc0,zc1,zc2,zc3) 
    256219            DO jj = 2, jpjm1 
    257220               DO ji = fs_2, fs_jpim1 
    … …  
    269232         END DO 
    270233         ! 
    271 !$OMP DO schedule(static) private(jk,jj,ji) 
    272234         DO jk = 1, nksr                     !* now qsr induced heat content 
    273235            DO jj = 2, jpjm1 
    … …  
    277239            END DO 
    278240         END DO 
    279 !$OMP END PARALLEL 
    280241         ! 
    281242         CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        )  
    … …  
    286247         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands 
    287248         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 
    288 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zc0,zc1) 
    289249         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m  
    290250            DO jj = 2, jpjm1 
    … …  
    300260      ! 
    301261      !                          !-----------------------------! 
    302 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    303262      DO jk = 1, nksr            !  update to the temp. trend  ! 
    304263         DO jj = 2, jpjm1        !-----------------------------! 
    … …  
    311270      ! 
    312271      IF( ln_qsr_ice ) THEN      ! sea-ice: store the 1st ocean level attenuation coefficient 
    313 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    314272         DO jj = 2, jpjm1  
    315273            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    326284         CALL wrk_alloc( jpi,jpj,jpk,   zetot ) 
    327285         ! 
    328 !$OMP PARALLEL 
    329 !$OMP DO schedule(static) private(jj,ji) 
    330          DO jj = 1, jpj  
    331             DO ji = 1, jpi   ! vector opt. 
    332                zetot(ji,jj,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
    333             END DO 
    334          END DO 
     286         zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
    335287         DO jk = nksr, 1, -1 
    336 !$OMP DO schedule(static) private(jj,ji) 
    337             DO jj = 1, jpj  
    338                DO ji = 1, jpi   ! vector opt. 
    339                   zetot(ji,jj,jk) = zetot(ji,jj,jk+1) + qsr_hc(ji,jj,jk) / r1_rau0_rcp 
    340                END DO 
    341             END DO 
     288            zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 
    342289         END DO          
    343 !$OMP END PARALLEL 
    344290         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
    345291         ! 
    … …  
    353299      ! 
    354300      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    355 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    356          DO jk = 1, jpk 
    357             DO jj = 1, jpj 
    358                DO ji = 1, jpi 
    359                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
    360                END DO 
    361             END DO 
    362          END DO 
     301         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    363302         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    364303         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt )  
    … …  
    487426      END SELECT 
    488427      ! 
    489 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    490       DO jk = 1, jpk 
    491          DO jj = 1, jpj 
    492             DO ji = 1, jpi 
    493                qsr_hc(ji,jj,jk) = 0._wp     ! now qsr heat content set to zero where it will not be computed 
    494             END DO 
    495          END DO 
    496       END DO 
     428      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed 
    497429      ! 
    498430      ! 1st ocean level attenuation coefficient (used in sbcssm) 
    … …  
    500432         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  ) 
    501433      ELSE 
    502 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    503          DO jj = 1, jpj 
    504             DO ji = 1, jpi 
    505                fraqsr_1lev(ji,jj) = 1._wp   ! default : no penetration 
    506             END DO 
    507          END DO 
     434         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration 
    508435      ENDIF 
    509436      ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r7710 r7753  
    8888      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    8989         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
    90 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    91          DO jk = 1, jpk 
    92             DO jj = 1, jpj 
    93                DO ji = 1, jpi 
    94                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
    95                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 
    96                END DO 
    97             END DO 
    98          END DO 
     90         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     91         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    9992      ENDIF 
    10093      ! 
    10194!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 
    10295      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
    103 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    104          DO jj = 1, jpj 
    105             DO ji = 1, jpi 
    106                qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns 
    107                qsr(ji,jj) = 0._wp                     ! qsr set to zero 
    108             END DO 
    109          END DO 
     96         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns 
     97         qsr(:,:) = 0._wp                     ! qsr set to zero 
    11098      ENDIF 
    11199 
    … …  
    119107            IF(lwp) WRITE(numout,*) '          nit000-1 sbc tracer content field read in the restart file' 
    120108            zfact = 0.5_wp 
    121             DO jn = 1, jpts 
    122 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    123                DO jj = 1, jpj 
    124                   DO ji = 1, jpi 
    125                      sbc_tsc(ji,jj,jn) = 0._wp  ! needed just to ensure haloes are consistent across restarts 
    126                   END DO 
    127                END DO 
    128             END DO 
     109            sbc_tsc(:,:,:) = 0._wp 
    129110            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend 
    130111            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend 
    131112         ELSE                                   ! No restart or restart not found: Euler forward time stepping 
    132113            zfact = 1._wp 
    133             DO jn = 1, jpts 
    134 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    135                DO jj = 1, jpj 
    136                   DO ji = 1, jpi 
    137                      sbc_tsc(ji,jj,jn) = 0._wp 
    138                      sbc_tsc_b(ji,jj,jn) = 0._wp 
    139                   END DO 
    140                END DO 
    141             END DO 
     114            sbc_tsc(:,:,:) = 0._wp 
     115            sbc_tsc_b(:,:,:) = 0._wp 
    142116         ENDIF 
    143117      ELSE                                !* other time-steps: swap of forcing fields 
    144118         zfact = 0.5_wp 
    145          DO jn = 1, jpts 
    146 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    147             DO jj = 1, jpj 
    148                DO ji = 1, jpi 
    149                   sbc_tsc_b(ji,jj,jn) = sbc_tsc(ji,jj,jn) 
    150                END DO 
    151             END DO 
    152          END DO 
     119         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 
    153120      ENDIF 
    154121      !                             !==  Now sbc tracer content fields  ==! 
    155 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    156122      DO jj = 2, jpj 
    157123         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    161127      END DO 
    162128      IF( ln_linssh ) THEN                !* linear free surface   
    163 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    164129         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell 
    165130            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    173138      ! 
    174139      DO jn = 1, jpts               !==  update tracer trend  ==! 
    175 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    176140         DO jj = 2, jpj 
    177141            DO ji = fs_2, fs_jpim1   ! vector opt.   
    … …  
    255219      ! 
    256220      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff  
    257 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zdep) 
    258221         DO jk = 1,jpk 
    259222            DO jj = 2, jpj  
    … …  
    270233 
    271234      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    272 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    273          DO jk = 1, jpk 
    274             DO jj = 1, jpj 
    275                DO ji = 1, jpi 
    276                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
    277                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 
    278                END DO   
    279             END DO   
    280          END DO 
     235         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
     236         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    281237         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    282238         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r7698 r7753  
    5858      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    5959      ! 
    60       INTEGER  ::   jk, jj, ji           ! Dummy loop indices 
     60      INTEGER  ::   jk                   ! Dummy loop indices 
    6161      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    6262      !!--------------------------------------------------------------------- 
    … …  
    7272      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    7373         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    74 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    75          DO jk = 1, jpk 
    76             DO jj = 1, jpj 
    77                DO ji = 1, jpi 
    78                   ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
    79                   ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 
    80                END DO 
    81             END DO 
    82          END DO 
     74         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     75         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    8376      ENDIF 
    8477      ! 
    … …  
    9184      ! JMM avoid negative salinities near river outlet ! Ugly fix 
    9285      ! JMM : restore negative salinities to small salinities: 
    93 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    94       DO jk = 1, jpk 
    95          DO jj = 1, jpj 
    96             DO ji = 1, jpi 
    97                IF( tsa(ji,jj,jk,jp_sal) < 0._wp )   tsa(ji,jj,jk,jp_sal) = 0.1_wp 
    98             END DO 
    99          END DO 
    100       END DO 
     86      WHERE( tsa(:,:,:,jp_sal) < 0._wp )   tsa(:,:,:,jp_sal) = 0.1_wp 
    10187!!gm 
    10288 
    10389      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    104 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    10590         DO jk = 1, jpkm1 
    106             DO jj = 1, jpj 
    107                DO ji = 1, jpi 
    108                   ztrdt(ji,jj,jk) = ( ( tsa(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) / r2dt ) - ztrdt(ji,jj,jk) 
    109                   ztrds(ji,jj,jk) = ( ( tsa(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) / r2dt ) - ztrds(ji,jj,jk) 
    110                END DO 
    111             END DO 
     91            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk) 
     92            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk) 
    11293         END DO 
    11394!!gm this should be moved in trdtra.F90 and done on all trends 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r7698 r7753  
    106106            ! 
    107107            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 
    108             IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 
    109 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    110                DO jj = 1, jpj 
    111                   DO ji = 1, jpi 
    112                      zwt(ji,jj,2:jpk) = avt  (ji,jj,2:jpk) 
    113                   END DO 
    114                END DO 
    115             ELSE                                             
    116 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    117                DO jj = 1, jpj 
    118                   DO ji = 1, jpi 
    119                      zwt(ji,jj,2:jpk) = fsavs(ji,jj,2:jpk) 
    120                   END DO 
    121                END DO 
     108            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt  (:,:,2:jpk) 
     109            ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 
    122110            ENDIF 
    123 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    124             DO jj = 1, jpj 
    125                DO ji = 1, jpi 
    126                   zwt(ji,jj,1) = 0._wp 
    127                END DO 
    128             END DO 
     111            zwt(:,:,1) = 0._wp 
    129112            ! 
    130113            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
    131114               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
    132 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    133115                  DO jk = 2, jpkm1 
    134116                     DO jj = 2, jpjm1 
    … …  
    139121                  END DO 
    140122               ELSE                          ! standard or triad iso-neutral operator 
    141 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    142123                  DO jk = 2, jpkm1 
    143124                     DO jj = 2, jpjm1 
    … …  
    151132            ! 
    152133            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
    153 !$OMP PARALLEL  
    154 !$OMP DO schedule(static) private(jk, jj, ji) 
    155134            DO jk = 1, jpkm1 
    156135               DO jj = 2, jpjm1 
    … …  
    183162            !   used as a work space array: its value is modified. 
    184163            ! 
    185 !$OMP DO schedule(static) private(jj, ji) 
    186164            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    187165               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction) 
    … …  
    189167               END DO 
    190168            END DO 
    191 !$OMP END DO NOWAIT  
    192169            DO jk = 2, jpkm1 
    193 !$OMP DO schedule(static) private(jj, ji) 
    194170               DO jj = 2, jpjm1 
    195171                  DO ji = fs_2, fs_jpim1 
    … …  
    198174               END DO 
    199175            END DO 
    200 !$OMP END PARALLEL  
    201176            ! 
    202177         ENDIF  
    203178         !          
    204 !$OMP PARALLEL  
    205 !$OMP DO schedule(static) private(jj, ji) 
    206179         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    207180            DO ji = fs_2, fs_jpim1 
    … …  
    210183         END DO 
    211184         DO jk = 2, jpkm1 
    212 !$OMP DO schedule(static) private(jj, ji, zrhs) 
    213185            DO jj = 2, jpjm1 
    214186               DO ji = fs_2, fs_jpim1 
    … …  
    219191         END DO 
    220192         ! 
    221 !$OMP DO schedule(static) private(jj, ji) 
    222193         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer) 
    223194            DO ji = fs_2, fs_jpim1 
    … …  
    226197         END DO 
    227198         DO jk = jpk-2, 1, -1 
    228 !$OMP DO schedule(static) private(jj, ji) 
    229199            DO jj = 2, jpjm1 
    230200               DO ji = fs_2, fs_jpim1 
    … …  
    234204            END DO 
    235205         END DO 
    236 !$OMP END PARALLEL  
    237206         !                                            ! ================= ! 
    238207      END DO                                          !  end tracer loop  ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90

    r7698 r7753  
    101101      IF( nn_timing == 1 )   CALL timing_start( 'zps_hde') 
    102102      ! 
    103       DO jn = 1, kjpt 
    104 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    105          DO jj = 1, jpjm1 
    106             DO ji = 1, jpim1 
    107                pgtu(ji,jj,jn)=0._wp   ;   zti (ji,jj,jn)=0._wp 
    108                pgtv(ji,jj,jn)=0._wp   ;   ztj (ji,jj,jn)=0._wp 
    109             END DO 
    110          END DO 
    111       END DO 
    112 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    113       DO jj = 1, jpjm1 
    114          DO ji = 1, jpim1 
    115             zhi (ji,jj  )=0._wp 
    116             zhj (ji,jj  )=0._wp 
    117          END DO 
    118        END DO 
     103      pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp 
     104      pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp 
    119105      ! 
    120106      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    121107         ! 
    122 !$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv,zmaxu,zmaxv) 
    123108         DO jj = 1, jpjm1 
    124109            DO ji = 1, jpim1 
    … …  
    165150      !                 
    166151      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    167 !$OMP PARALLEL 
    168 !$OMP DO schedule(static) private(jj,ji) 
    169          DO jj = 1, jpjm1 
    170             DO ji = 1, jpim1 
    171                pgru(ji,jj) = 0._wp 
    172                pgrv(ji,jj) = 0._wp                ! depth of the partial step level 
    173             END DO 
    174          END DO 
    175 !$OMP END DO NOWAIT 
    176 !$OMP DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv) 
     152         pgru(:,:) = 0._wp 
     153         pgrv(:,:) = 0._wp                ! depth of the partial step level 
    177154         DO jj = 1, jpjm1 
    178155            DO ji = 1, jpim1 
    … …  
    189166            END DO 
    190167         END DO 
    191 !$OMP END DO NOWAIT 
    192 !$OMP END PARALLEL 
    193168         ! 
    194169         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
    195170         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    196171         ! 
    197 !$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv) 
    198172         DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    199173            DO ji = 1, jpim1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_hgr.F90

    r7715 r7753  
    77   !! User defined :   mesh and Coriolis parameter of a user configuration 
    88   !!====================================================================== 
    9    !! History  :  4.0 ! 2016-03  (S. Flavoni)  
     9   !! History :  4.0 ! 2016-03  (S. Flavoni)  
    1010   !!---------------------------------------------------------------------- 
    1111 
    … …  
    103103      ENDIF 
    104104      !    
    105 !$OMP PARALLEL 
    106 !$OMP DO schedule(static) private(jj, ji, zim1, zjm1) 
    107105      DO jj = 1, jpj  
    108106         DO ji = 1, jpi  
    … …  
    131129         END DO 
    132130      END DO 
    133 !$OMP END DO NOWAIT 
    134131      ! 
    135132      !                       !== Horizontal scale factors ==! (in meters) 
    136133      !                      
    137134      !                                         ! constant grid spacing 
    138 !$OMP DO schedule(static) private(jj, ji) 
    139       DO jj = 1, jpj 
    140          DO ji = 1, jpi 
    141             pe1t(ji,jj) =  ze1     ;      pe2t(ji,jj) = ze1 
    142             pe1u(ji,jj) =  ze1     ;      pe2u(ji,jj) = ze1 
    143             pe1v(ji,jj) =  ze1     ;      pe2v(ji,jj) = ze1 
    144             pe1f(ji,jj) =  ze1     ;      pe2f(ji,jj) = ze1 
    145             ! 
    146             !                                         ! NO reduction of grid size in some straits  
    147             pe1e2u(ji,jj) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that 
    148             pe1e2v(ji,jj) = 0._wp                       !             require an initialization of INTENT(out) arguments 
    149          END DO 
    150       END DO 
    151 !$OMP END PARALLEL 
     135      pe1t(:,:) =  ze1     ;      pe2t(:,:) = ze1 
     136      pe1u(:,:) =  ze1     ;      pe2u(:,:) = ze1 
     137      pe1v(:,:) =  ze1     ;      pe2v(:,:) = ze1 
     138      pe1f(:,:) =  ze1     ;      pe2f(:,:) = ze1 
     139      ! 
     140      !                                         ! NO reduction of grid size in some straits  
    152141      ke1e2u_v = 0                              !    ==>> u_ & v_surfaces will be computed in dom_ghr routine 
     142      pe1e2u(:,:) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that 
     143      pe1e2v(:,:) = 0._wp                       !             require an initialization of INTENT(out) arguments 
    153144      ! 
    154145      ! 
    … …  
    162153      zf0   = 2. * omega * SIN( rad * zphi0 )            !  compute f0 1st point south 
    163154      ! 
    164 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    165       DO jj = 1, jpj 
    166          DO ji = 1, jpi 
    167             pff_f(ji,jj) = ( zf0 + zbeta * ABS( pphif(ji,jj) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
    168             pff_t(ji,jj) = ( zf0 + zbeta * ABS( pphit(ji,jj) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
    169          END DO 
    170       END DO 
     155      pff_f(:,:) = ( zf0 + zbeta * ABS( pphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
     156      pff_t(:,:) = ( zf0 + zbeta * ABS( pphit(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
    171157      ! 
    172158      IF(lwp) WRITE(numout,*) '                           beta-plane used. beta = ', zbeta, ' 1/(s.m)' 

  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_istate.F90

    r7715 r7753  
    77   !! User defined : set the initial state of a user configuration 
    88   !!====================================================================== 
    9    !! History :  4.0  ! 2016-03  (S. Flavoni) Original code 
     9   !! History :  4.0 ! 2016-03  (S. Flavoni) Original code 
    1010   !!---------------------------------------------------------------------- 
    1111 
    … …  
    5555      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with an horizontally uniform T and S profiles' 
    5656      ! 
    57 !$OMP PARALLEL 
    58 !$OMP DO schedule(static) private(jk,jj,ji) 
    59       DO jk = 1, jpk 
    60          DO jj = 1, jpj 
    61             DO ji = 1, jpi 
    62                pu  (ji,jj,jk) = 0._wp        ! ocean at rest 
    63                pv  (ji,jj,jk) = 0._wp 
    64             END DO 
    65          END DO 
    66       END DO 
    67 !$OMP END DO NOWAIT 
    68 !$OMP DO schedule(static) private(jj,ji) 
    69       DO jj = 1, jpj 
    70          DO ji = 1, jpi 
    71             pssh(ji,jj)   = 0._wp 
    72          END DO 
    73       END DO 
    74 !$OMP END DO NOWAIT 
     57      pu  (:,:,:) = 0._wp        ! ocean at rest 
     58      pv  (:,:,:) = 0._wp 
     59      pssh(:,:)   = 0._wp 
    7560      ! 
    76 !$OMP DO schedule(static) private(jk,jj,ji) 
    7761      DO jk = 1, jpk             ! horizontally uniform T & S profiles 
    7862         DO jj = 1, jpj 
    … …  
    9579         END DO 
    9680      END DO 
    97 !$OMP END PARALLEL 
    9881      !    
    9982   END SUBROUTINE usr_def_istate 

  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90

    r7698 r7753  
    109109      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K) 
    110110      zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s 
    111 !$OMP PARALLEL DO schedule(static) private(jj, ji, t_star) 
    112111      DO jj = 1, jpj 
    113112         DO ji = 1, jpi 
    … …  
    138137 
    139138      ! freshwater (mass flux) and update of qns with heat content of emp 
    140 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    141       DO jj = 1, jpj 
    142          DO ji = 1, jpi 
    143             emp (ji,jj) = emp(ji,jj) - zsumemp * tmask(ji,jj,1)          ! freshwater flux (=0 in domain average) 
    144             sfx (ji,jj) = 0.0_wp                                         ! no salt flux 
    145             qns (ji,jj) = qns(ji,jj) - emp(ji,jj) * sst_m(ji,jj) * rcp   ! evap and precip are at SST 
    146          END DO 
    147       END DO 
     139      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average) 
     140      sfx (:,:) = 0.0_wp                                   ! no salt flux 
     141      qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST 
    148142 
    149143 
    … …  
    172166      ztau_sais = 0.015 
    173167      ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 
    174 !$OMP PARALLEL 
    175 !$OMP DO schedule(static) private(jj, ji) 
    176168      DO jj = 1, jpj 
    177169         DO ji = 1, jpi 
    … …  
    185177      ! module of wind stress and wind speed at T-point 
    186178      zcoef = 1. / ( zrhoa * zcdrag )  
    187 !$OMP DO schedule(static) private(jj, ji, ztx, zty, zmod) 
    188179      DO jj = 2, jpjm1 
    189180         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    195186         END DO 
    196187      END DO 
    197 !$OMP END PARALLEL 
    198188      CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
    199189 

  • trunk/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90

    r7698 r7753  
    199199      ! 
    200200      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D local workspace 
    201  
    202       INTEGER  ::   ji, jj 
    203201      !!---------------------------------------------------------------------- 
    204202      ! 
    … …  
    208206      IF(lwp) WRITE(numout,*) '       GYRE case : closed flat box ocean without ocean cavities' 
    209207      ! 
    210 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    211       DO jj = 1, jpj 
    212          DO ji = 1, jpi 
    213             z2d(ji,jj) = REAL( jpkm1 , wp )          ! flat bottom 
    214          END DO 
    215       END DO 
     208      z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom 
    216209      ! 
    217210      CALL lbc_lnk( z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    218211      ! 
    219 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    220       DO jj = 1, jpj 
    221          DO ji = 1, jpi 
    222             k_bot(ji,jj) = INT( z2d(ji,jj) )           ! =jpkm1 over the ocean point, =0 elsewhere 
    223             ! 
    224             k_top(ji,jj) = MIN( 1 , k_bot(ji,jj) )     ! = 1    over the ocean point, =0 elsewhere 
    225          END DO 
    226       END DO 
     212      k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     213      ! 
     214      k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 
    227215      ! 
    228216   END SUBROUTINE zgr_msk_top_bot 
    … …  
    246234      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      - 
    247235      ! 
    248       INTEGER  ::   ji, jj, jk 
     236      INTEGER  ::   jk 
    249237      !!---------------------------------------------------------------------- 
    250238      ! 
    251239      IF( nn_timing == 1 )  CALL timing_start('zgr_zco') 
    252240      ! 
    253 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    254241      DO jk = 1, jpk 
    255          DO jj = 1, jpj 
    256             DO ji = 1, jpi 
    257                pdept(ji,jj,jk) = pdept_1d(jk) 
    258                pdepw(ji,jj,jk) = pdepw_1d(jk) 
    259                pe3t (ji,jj,jk) = pe3t_1d (jk) 
    260                pe3u (ji,jj,jk) = pe3t_1d (jk) 
    261                pe3v (ji,jj,jk) = pe3t_1d (jk) 
    262                pe3f (ji,jj,jk) = pe3t_1d (jk) 
    263                pe3w (ji,jj,jk) = pe3w_1d (jk) 
    264                pe3uw(ji,jj,jk) = pe3w_1d (jk) 
    265                pe3vw(ji,jj,jk) = pe3w_1d (jk) 
    266             END DO 
    267          END DO 
     242         pdept(:,:,jk) = pdept_1d(jk) 
     243         pdepw(:,:,jk) = pdepw_1d(jk) 
     244         pe3t (:,:,jk) = pe3t_1d (jk) 
     245         pe3u (:,:,jk) = pe3t_1d (jk) 
     246         pe3v (:,:,jk) = pe3t_1d (jk) 
     247         pe3f (:,:,jk) = pe3t_1d (jk) 
     248         pe3w (:,:,jk) = pe3w_1d (jk) 
     249         pe3uw(:,:,jk) = pe3w_1d (jk) 
     250         pe3vw(:,:,jk) = pe3w_1d (jk) 
    268251      END DO 
    269252      ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r7698 r7753  
    106106         IF ( ln_loglayer.AND. .NOT.ln_linssh ) THEN ! "log layer" bottom friction coefficient 
    107107 
    108 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 
    109108            DO jj = 1, jpj 
    110109               DO ji = 1, jpi 
    … …  
    118117! (ISF) 
    119118            IF ( ln_isfcav ) THEN 
    120 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 
    121119               DO jj = 1, jpj 
    122120                  DO ji = 1, jpi 
    … …  
    131129            !    
    132130         ELSE 
    133 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    134             DO jj = 1, jpj 
    135                DO ji = 1, jpi 
    136                   zbfrt(ji,jj) = bfrcoef2d(ji,jj) 
    137                   ztfrt(ji,jj) = tfrcoef2d(ji,jj) 
    138                END DO 
    139             END DO 
    140          ENDIF 
    141  
    142 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv) 
     131            zbfrt(:,:) = bfrcoef2d(:,:) 
     132            ztfrt(:,:) = tfrcoef2d(:,:) 
     133         ENDIF 
     134 
    143135         DO jj = 2, jpjm1 
    144136            DO ji = 2, jpim1 
    … …  
    175167 
    176168         IF( ln_isfcav ) THEN 
    177 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv) 
    178169            DO jj = 2, jpjm1 
    179170               DO ji = 2, jpim1 
    … …  
    269260      CASE( 0 ) 
    270261         IF(lwp) WRITE(numout,*) '      free-slip ' 
    271 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    272             DO jj = 1, jpj 
    273                DO ji = 1, jpi 
    274                   bfrua(ji,jj) = 0.e0 
    275                   bfrva(ji,jj) = 0.e0 
    276                   tfrua(ji,jj) = 0.e0 
    277                   tfrva(ji,jj) = 0.e0 
    278                END DO 
    279             END DO 
     262         bfrua(:,:) = 0._wp 
     263         bfrva(:,:) = 0._wp 
     264         tfrua(:,:) = 0._wp 
     265         tfrva(:,:) = 0._wp 
    280266         ! 
    281267      CASE( 1 ) 
    … …  
    299285            CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array 
    300286            CALL iom_close(inum) 
    301 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    302             DO jj = 1, jpj 
    303                DO ji = 1, jpi 
    304                   bfrcoef2d(ji,jj) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(ji,jj) ) 
    305                END DO 
    306             END DO 
     287            bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 
    307288         ELSE 
    308 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    309             DO jj = 1, jpj 
    310                DO ji = 1, jpi 
    311                   bfrcoef2d(ji,jj) = rn_bfri1  ! initialize bfrcoef2d to the namelist variable 
    312                END DO 
    313             END DO 
    314          ENDIF 
    315          ! 
    316 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    317             DO jj = 1, jpj 
    318                DO ji = 1, jpi 
    319                   bfrua(ji,jj) = - bfrcoef2d(ji,jj) 
    320                   bfrva(ji,jj) = - bfrcoef2d(ji,jj) 
    321                END DO 
    322             END DO 
     289            bfrcoef2d(:,:) = rn_bfri1  ! initialize bfrcoef2d to the namelist variable 
     290         ENDIF 
     291         ! 
     292         bfrua(:,:) = - bfrcoef2d(:,:) 
     293         bfrva(:,:) = - bfrcoef2d(:,:) 
    323294         ! 
    324295         IF ( ln_isfcav ) THEN 
    … …  
    328299               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 
    329300               CALL iom_close(inum) 
    330 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    331                DO jj = 1, jpj 
    332                   DO ji = 1, jpi 
    333                      tfrcoef2d(ji,jj) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(ji,jj) ) 
    334                   END DO 
    335                END DO 
     301               tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 
    336302            ELSE 
    337 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    338                DO jj = 1, jpj 
    339                   DO ji = 1, jpi 
    340                      tfrcoef2d(ji,jj) = rn_tfri1  ! initialize tfrcoef2d to the namelist variable 
    341                   END DO 
    342                END DO 
     303               tfrcoef2d(:,:) = rn_tfri1  ! initialize tfrcoef2d to the namelist variable 
    343304            ENDIF 
    344305            ! 
    345 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    346             DO jj = 1, jpj 
    347                DO ji = 1, jpi 
    348                   tfrua(ji,jj) = - tfrcoef2d(ji,jj) 
    349                   tfrva(ji,jj) = - tfrcoef2d(ji,jj) 
    350                END DO 
    351             END DO 
     306            tfrua(:,:) = - tfrcoef2d(:,:) 
     307            tfrva(:,:) = - tfrcoef2d(:,:) 
    352308         END IF 
    353309         ! 
    … …  
    390346            CALL iom_close(inum) 
    391347            ! 
    392 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    393             DO jj = 1, jpj 
    394                DO ji = 1, jpi 
    395                   bfrcoef2d(ji,jj) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(ji,jj) ) 
    396                END DO 
    397             END DO 
     348            bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 
    398349         ELSE 
    399 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    400             DO jj = 1, jpj 
    401                DO ji = 1, jpi 
    402                   bfrcoef2d(ji,jj) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable 
    403                END DO 
    404             END DO 
     350            bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable 
    405351         ENDIF 
    406352          
    … …  
    412358               CALL iom_close(inum) 
    413359               ! 
    414 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    415                DO jj = 1, jpj 
    416                   DO ji = 1, jpi 
    417                      tfrcoef2d(ji,jj) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(ji,jj) ) 
    418                   END DO 
    419                END DO 
     360               tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 
    420361            ELSE 
    421 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    422                DO jj = 1, jpj 
    423                   DO ji = 1, jpi 
    424                      tfrcoef2d(ji,jj) = rn_tfri2  ! initialize tfrcoef2d to the namelist variable 
    425                   END DO 
    426                END DO 
     362               tfrcoef2d(:,:) = rn_tfri2  ! initialize tfrcoef2d to the namelist variable 
    427363            ENDIF 
    428364         END IF 
    429365         ! 
    430366         IF( ln_loglayer.AND. ln_linssh ) THEN ! set "log layer" bottom friction once for all 
    431 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 
    432367            DO jj = 1, jpj 
    433368               DO ji = 1, jpi 
    … …  
    439374            END DO 
    440375            IF ( ln_isfcav ) THEN 
    441 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 
    442376               DO jj = 1, jpj 
    443377                  DO ji = 1, jpi 
    … …  
    479413      zmaxtfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient 
    480414      ! 
    481 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zfru,zfrv,ictu,ictv,zminbfr,zmaxbfr,zmintfr,zmaxtfr) 
    482415      DO jj = 2, jpjm1 
    483416         DO ji = 2, jpim1 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r7698 r7753  
    112112         ! Define the mask  
    113113         ! --------------- 
    114 !$OMP PARALLEL 
    115 !$OMP DO schedule(static) private(jj,ji,zrw,zaw,zbw,zdt,zds) 
    116114         DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 
    117115            DO ji = 1, jpi 
    … …  
    130128            END DO 
    131129         END DO 
    132 !$OMP END DO NOWAIT 
    133  
    134 !$OMP DO schedule(static) private(jj,ji) 
     130 
    135131         DO jj = 1, jpj                                     ! indicators: 
    136132            DO ji = 1, jpi 
    … …  
    159155         END DO 
    160156         ! mask zmsk in order to have avt and avs masked 
    161  
    162 !$OMP DO schedule(static) private(jj,ji) 
    163          DO jj = 1, jpj                                
    164             DO ji = 1, jpi 
    165                zmsks(ji,jj) = zmsks(ji,jj) * wmask(ji,jj,jk) 
    166             END DO 
    167          END DO 
     157         zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 
     158 
    168159 
    169160         ! Update avt and avs 
    170161         ! ------------------ 
    171162         ! Constant eddy coefficient: reset to the background value 
    172 !$OMP DO schedule(static) private(jj,ji,zinr,zrr,zavfs,zavft,zavdt,zavds) 
    173163         DO jj = 1, jpj 
    174164            DO ji = 1, jpi 
    … …  
    199189         ! -------------------------------- 
    200190!!gm to be changed following the definition of avm. 
    201 !$OMP DO schedule(static) private(jj,ji) 
    202191         DO jj = 1, jpjm1 
    203192            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    210199            END DO 
    211200         END DO 
    212 !$OMP END DO NOWAIT 
    213 !$OMP END PARALLEL 
    214201         !                                                ! =============== 
    215202      END DO                                              !   End of slab 
    … …  
    245232      !!---------------------------------------------------------------------- 
    246233      INTEGER ::   ios   ! local integer 
    247       INTEGER  ::   ji, jj , jk     ! dummy loop indices 
    248234      !! 
    249235      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr 
    … …  
    271257      IF( zdf_ddm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 
    272258      !                               ! initialization to masked Kz 
    273 !$OMP DO schedule(static) private(jk,jj,ji) 
    274       DO jk = 1, jpk                                
    275          DO jj = 1, jpj                                
    276             DO ji = 1, jpi 
    277                avs(ji,jj,jk) = rn_avt0 * wmask(ji,jj,jk) 
    278             END DO 
    279          END DO 
    280       END DO  
     259      avs(:,:,:) = rn_avt0 * wmask(:,:,:)  
    281260      ! 
    282261   END SUBROUTINE zdf_ddm_init 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r7698 r7753  
    7070      CALL wrk_alloc( jpi,jpj,jpk,   zavt_evd, zavm_evd )  
    7171      ! 
    72 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    73       DO jk = 1, jpk 
    74          DO jj = 1, jpj 
    75             DO ji = 1, jpi 
    76                zavt_evd(ji,jj,jk) = avt(ji,jj,jk)           ! set avt prior to evd application 
    77             END DO 
    78          END DO 
    79       END DO  
     72      zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application 
    8073      ! 
    8174      SELECT CASE ( nn_evdm ) 
    … …  
    8376      CASE ( 1 )           ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12) 
    8477         ! 
    85 !$OMP PARALLEL 
    86 !$OMP DO schedule(static) private(jk, jj, ji) 
    87          DO jk = 1, jpk 
    88             DO jj = 1, jpj 
    89                DO ji = 1, jpi 
    90                   zavm_evd(ji,jj,jk) = avm(ji,jj,jk)           ! set avm prior to evd application 
    91                END DO 
    92             END DO 
    93          END DO  
     78         zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application 
    9479         ! 
    95 !$OMP DO schedule(static) private(jk, jj, ji) 
    9680         DO jk = 1, jpkm1  
    9781            DO jj = 2, jpj             ! no vector opt. 
    … …  
    10892            END DO 
    10993         END DO  
    110 !$OMP END PARALLEL 
    11194         CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions 
    11295         CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. ) 
    11396         ! 
    114 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    115          DO jk = 1, jpk 
    116             DO jj = 1, jpj 
    117                DO ji = 1, jpi 
    118                   zavm_evd(ji,jj,jk) = avm(ji,jj,jk) - zavm_evd(ji,jj,jk)   ! change in avm due to evd 
    119                END DO 
    120             END DO 
    121          END DO  
     97         zavm_evd(:,:,:) = avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd 
    12298         CALL iom_put( "avm_evd", zavm_evd )              ! output this change 
    12399         ! 
    124100      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12)  
    125 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    126101         DO jk = 1, jpkm1 
    127102!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!  
    … …  
    136111      END SELECT  
    137112 
    138 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    139       DO jk = 1, jpk 
    140          DO jj = 1, jpj 
    141             DO ji = 1, jpi 
    142                zavt_evd(ji,jj,jk) = avt(ji,jj,jk) - zavt_evd(ji,jj,jk)   ! change in avt due to evd 
    143             END DO 
    144          END DO 
    145       END DO  
     113      zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
    146114      CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
    147115      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r7698 r7753  
    9696 
    9797      ! w-level of the mixing and mixed layers 
    98       zN2_c = grav * rho_c * r1_rau0           ! convert density criteria into N^2 criteria 
    99 !$OMP PARALLEL 
    100 !$OMP DO schedule(static) private(jj, ji) 
    101       DO jj = 1, jpj 
    102          DO ji = 1, jpi 
    103             nmln(ji,jj)  = nlb10               ! Initialization to the number of w ocean point 
    104             hmlp(ji,jj)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
    105          END DO 
    106       END DO 
     98      nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point 
     99      hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
     100      zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria 
    107101      DO jk = nlb10, jpkm1 
    108 !$OMP DO schedule(static) private(jj, ji, ikt) 
    109102         DO jj = 1, jpj                ! Mixed layer level: w-level  
    110103            DO ji = 1, jpi 
    … …  
    117110      ! 
    118111      ! w-level of the turbocline and mixing layer (iom_use) 
    119 !$OMP DO schedule(static) private(jj, ji) 
    120       DO jj = 1, jpj 
    121          DO ji = 1, jpi 
    122             imld(ji,jj) = mbkt(ji,jj) + 1        ! Initialization to the number of w ocean point 
    123          END DO 
    124       END DO 
     112      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
    125113      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
    126 !$OMP DO schedule(static) private(jj, ji) 
    127114         DO jj = 1, jpj 
    128115            DO ji = 1, jpi 
    … …  
    132119      END DO 
    133120      ! depth of the mixing and mixed layers 
    134 !$OMP DO schedule(static) private(jj, ji, iiki, iikn) 
    135121      DO jj = 1, jpj 
    136122         DO ji = 1, jpi 
    … …  
    142128         END DO 
    143129      END DO 
    144 !$OMP END PARALLEL 
    145130      ! 
    146131      IF( .NOT.l_offline ) THEN 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r7698 r7753  
    171171      !!---------------------------------------------------------------------- 
    172172      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    173       INTEGER             ::   jk, jj, ji   
    174173      !!---------------------------------------------------------------------- 
    175174      ! 
    … …  
    180179      ! 
    181180      IF( kt /= nit000 ) THEN   ! restore before value to compute tke 
    182 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    183          DO jk = 1, jpk 
    184             DO jj = 1, jpj 
    185                DO ji = 1, jpi 
    186                   avt (ji,jj,jk) = avt_k (ji,jj,jk)  
    187                   avm (ji,jj,jk) = avm_k (ji,jj,jk)  
    188                   avmu(ji,jj,jk) = avmu_k(ji,jj,jk)  
    189                   avmv(ji,jj,jk) = avmv_k(ji,jj,jk)  
    190                END DO 
    191             END DO 
    192          END DO 
     181         avt (:,:,:) = avt_k (:,:,:)  
     182         avm (:,:,:) = avm_k (:,:,:)  
     183         avmu(:,:,:) = avmu_k(:,:,:)  
     184         avmv(:,:,:) = avmv_k(:,:,:)  
    193185      ENDIF  
    194186      ! 
    … …  
    197189      CALL tke_avn      ! now avt, avm, avmu, avmv 
    198190      ! 
    199 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    200          DO jk = 1, jpk 
    201             DO jj = 1, jpj 
    202                DO ji = 1, jpi 
    203                   avt_k (ji,jj,jk) = avt (ji,jj,jk)  
    204                   avm_k (ji,jj,jk) = avm (ji,jj,jk)  
    205                   avmu_k(ji,jj,jk) = avmu(ji,jj,jk)  
    206                   avmv_k(ji,jj,jk) = avmv(ji,jj,jk)  
    207                END DO 
    208             END DO 
    209          END DO 
     191      avt_k (:,:,:) = avt (:,:,:)  
     192      avm_k (:,:,:) = avm (:,:,:)  
     193      avmu_k(:,:,:) = avmu(:,:,:)  
     194      avmv_k(:,:,:) = avmv(:,:,:)  
    210195      ! 
    211196#if defined key_agrif 
    … …  
    268253      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    269254      IF ( ln_isfcav ) THEN 
    270 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    271255         DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin 
    272256            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    275259         END DO 
    276260      END IF 
    277 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    278261      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    279262         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    310293         ! 
    311294         !                        !* total energy produce by LC : cumulative sum over jk 
    312 !$OMP PARALLEL 
    313 !$OMP DO schedule(static) private(jj, ji) 
    314          DO jj =1, jpj 
    315             DO ji=1, jpi 
    316                zpelc(ji,jj,1) =  MAX( rn2b(ji,jj,1), 0._wp ) * gdepw_n(ji,jj,1) * e3w_n(ji,jj,1) 
    317             END DO 
    318          END DO 
     295         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1) 
    319296         DO jk = 2, jpk 
    320 !$OMP DO schedule(static) private(jj, ji) 
    321             DO jj =1, jpj 
    322                DO ji=1, jpi 
    323                   zpelc(ji,jj,jk)  = zpelc(ji,jj,jk-1) + MAX( rn2b(ji,jj,jk), 0._wp ) * gdepw_n(ji,jj,jk) * e3w_n(ji,jj,jk) 
    324                END DO 
    325             END DO 
     297            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk) 
    326298         END DO 
    327299         !                        !* finite Langmuir Circulation depth 
    328300         zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 
    329 !$OMP DO schedule(static) private(jj,ji) 
    330             DO jj = 1, jpj 
    331                DO ji = 1, jpi 
    332                   imlc(ji,jj) = mbkt(ji,jj) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    333                END DO 
    334             END DO 
     301         imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
    335302         DO jk = jpkm1, 2, -1 
    336 !$OMP DO schedule(static) private(jj, ji, zus) 
    337303            DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us  
    338304               DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1) 
    … …  
    343309         END DO 
    344310         !                               ! finite LC depth 
    345 !$OMP DO schedule(static) private(jj, ji) 
    346311         DO jj = 1, jpj  
    347312            DO ji = 1, jpi 
    … …  
    350315         END DO 
    351316         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
    352 !$OMP DO schedule(static) private(jk, jj, ji, zus, zind, zwlc) 
    353317         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    354318            DO jj = 2, jpjm1 
    … …  
    364328            END DO 
    365329         END DO 
    366 !$OMP END PARALLEL 
    367330         ! 
    368331      ENDIF 
    … …  
    375338      !                     ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 
    376339      ! 
    377 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    378340      DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
    379341         DO jj = 1, jpjm1 
    … …  
    394356         ! Note that zesh2 is also computed in the next loop. 
    395357         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 
    396 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zesh2, zri) 
    397358         DO jk = 2, jpkm1 
    398359            DO jj = 2, jpjm1 
    … …  
    411372      ENDIF 
    412373      !          
    413 !$OMP PARALLEL 
    414 !$OMP DO schedule(static) private(jk, jj, ji, zcof, zzd_up, zzd_lw, zesh2) 
    415374      DO jk = 2, jpkm1           !* Matrix and right hand side in en 
    416375         DO jj = 2, jpjm1 
    … …  
    446405      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    447406      DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
    448 !$OMP DO schedule(static) private(jj, ji) 
    449407         DO jj = 2, jpjm1 
    450408            DO ji = fs_2, fs_jpim1    ! vector opt. 
    … …  
    453411         END DO 
    454412      END DO 
    455 !$OMP DO schedule(static) private(jj, ji) 
    456413      DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    457414         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    460417      END DO 
    461418      DO jk = 3, jpkm1 
    462 !$OMP DO schedule(static) private(jj, ji) 
    463419         DO jj = 2, jpjm1 
    464420            DO ji = fs_2, fs_jpim1    ! vector opt. 
    … …  
    467423         END DO 
    468424      END DO 
    469 !$OMP DO schedule(static) private(jj, ji) 
    470425      DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    471426         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    474429      END DO 
    475430      DO jk = jpk-2, 2, -1 
    476 !$OMP DO schedule(static) private(jj, ji) 
    477431         DO jj = 2, jpjm1 
    478432            DO ji = fs_2, fs_jpim1    ! vector opt. 
    … …  
    481435         END DO 
    482436      END DO 
    483 !$OMP DO schedule(static) private(jk,jj, ji) 
    484437      DO jk = 2, jpkm1                             ! set the minimum value of tke 
    485438         DO jj = 2, jpjm1 
    … …  
    489442         END DO 
    490443      END DO 
    491 !$OMP END PARALLEL 
    492444 
    493445      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    498450       
    499451      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
    500 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    501452         DO jk = 2, jpkm1 
    502453            DO jj = 2, jpjm1 
    … …  
    508459         END DO 
    509460      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
    510 !$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    511461         DO jj = 2, jpjm1 
    512462            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    517467         END DO 
    518468      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
    519 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztx2, zty2, ztau, zdif) 
    520469         DO jk = 2, jpkm1 
    521470            DO jj = 2, jpjm1 
    … …  
    596545      ! 
    597546      ! initialisation of interior minimum value (avoid a 2d loop with mikt) 
    598 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    599       DO jk = 1, jpk 
    600          DO jj = 1, jpj 
    601             DO ji = 1, jpi 
    602                zmxlm(ji,jj,jk)  = rmxl_min     
    603                zmxld(ji,jj,jk)  = rmxl_min 
    604             END DO 
    605          END DO 
    606       END DO 
     547      zmxlm(:,:,:)  = rmxl_min     
     548      zmxld(:,:,:)  = rmxl_min 
    607549      ! 
    608550      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 
    609 !$OMP PARALLEL DO schedule(static) private(jj, ji, zraug) 
    610551         DO jj = 2, jpjm1 
    611552            DO ji = fs_2, fs_jpim1 
    … …  
    615556         END DO 
    616557      ELSE  
    617 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    618          DO jj = 1, jpj 
    619             DO ji = 1, jpi 
    620                zmxlm(ji,jj,1) = rn_mxl0 
    621             END DO 
    622          END DO 
     558         zmxlm(:,:,1) = rn_mxl0 
    623559      ENDIF 
    624560      ! 
    625 !$OMP PARALLEL 
    626 !$OMP DO schedule(static) private(jk, jj, ji, zrn2) 
    627561      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2) 
    628562         DO jj = 2, jpjm1 
    … …  
    636570      !                     !* Physical limits for the mixing length 
    637571      ! 
    638 !$OMP DO schedule(static) private(jj,ji) 
    639       DO jj = 1, jpj 
    640          DO ji = 1, jpi 
    641             zmxld(ji,jj, 1 ) = zmxlm(ji,jj,1)   ! surface set to the minimum value  
    642             zmxld(ji,jj,jpk) = rmxl_min       ! last level  set to the minimum value 
    643          END DO 
    644       END DO 
    645 !$OMP END PARALLEL 
     572      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value  
     573      zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value 
    646574      ! 
    647575      SELECT CASE ( nn_mxl ) 
    … …  
    650578      ! where wmask = 0 set zmxlm == e3w_n 
    651579      CASE ( 0 )           ! bounded by the distance to surface and bottom 
    652 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 
    653580         DO jk = 2, jpkm1 
    654581            DO jj = 2, jpjm1 
    … …  
    664591         ! 
    665592      CASE ( 1 )           ! bounded by the vertical scale factor 
    666 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 
    667593         DO jk = 2, jpkm1 
    668594            DO jj = 2, jpjm1 
    … …  
    676602         ! 
    677603      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
    678 !$OMP PARALLEL 
    679604         DO jk = 2, jpkm1         ! from the surface to the bottom : 
    680 !$OMP DO schedule(static) private(jj, ji) 
    681605            DO jj = 2, jpjm1 
    682606               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    686610         END DO 
    687611         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : 
    688 !$OMP DO schedule(static) private(jj, ji, zemxl) 
    689612            DO jj = 2, jpjm1 
    690613               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    695618            END DO 
    696619         END DO 
    697 !$OMP END PARALLEL 
    698620         ! 
    699621      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
    700 !$OMP PARALLEL 
    701622         DO jk = 2, jpkm1         ! from the surface to the bottom : lup 
    702 !$OMP DO schedule(static) private(jj, ji) 
    703623            DO jj = 2, jpjm1 
    704624               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    708628         END DO 
    709629         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown 
    710 !$OMP DO schedule(static) private(jj, ji) 
    711630            DO jj = 2, jpjm1 
    712631               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    715634            END DO 
    716635         END DO 
    717 !$OMP DO schedule(static) private(jk, jj, ji, zemlm, zemlp) 
    718636         DO jk = 2, jpkm1 
    719637            DO jj = 2, jpjm1 
    … …  
    726644            END DO 
    727645         END DO 
    728 !$OMP END PARALLEL 
    729646         ! 
    730647      END SELECT 
    731648      ! 
    732649# if defined key_c1d 
    733 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    734       DO jk = 1, jpk 
    735          DO jj = 1, jpj 
    736             DO ji = 1, jpi 
    737                e_dis(ji,jj,jk) = zmxld(ji,jj,jk)      ! c1d configuration : save mixing and dissipation turbulent length scales 
    738                e_mix(ji,jj,jk) = zmxlm(ji,jj,jk) 
    739             END DO 
    740          END DO 
    741       END DO 
     650      e_dis(:,:,:) = zmxld(:,:,:)      ! c1d configuration : save mixing and dissipation turbulent length scales 
     651      e_mix(:,:,:) = zmxlm(:,:,:) 
    742652# endif 
    743653 
    … …  
    745655      !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt) 
    746656      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    747 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zsqen, zav) 
    748657      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points 
    749658         DO jj = 2, jpjm1 
    … …  
    759668      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
    760669      ! 
    761 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    762670      DO jk = 2, jpkm1            !* vertical eddy viscosity at wu- and wv-points 
    763671         DO jj = 2, jpjm1 
    … …  
    771679      ! 
    772680      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt 
    773 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    774681         DO jk = 2, jpkm1 
    775682            DO jj = 2, jpjm1 
    … …  
    891798         SELECT CASE( nn_htau )             ! Choice of the depth of penetration 
    892799         CASE( 0 )                                 ! constant depth penetration (here 10 meters) 
    893 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    894             DO jj = 1, jpj 
    895                DO ji = 1, jpi 
    896                   htau(ji,jj) = 10._wp 
    897                END DO 
    898             END DO 
     800            htau(:,:) = 10._wp 
    899801         CASE( 1 )                                 ! F(latitude) : 0.5m to 30m poleward of 40 degrees 
    900 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    901             DO jj = 1, jpj 
    902                DO ji = 1, jpi 
    903                   htau(ji,jj) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(ji,jj) ) ) )   )             
    904                END DO 
    905             END DO 
     802            htau(:,:) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) )   )             
    906803         END SELECT 
    907804      ENDIF 
    908805      !                               !* set vertical eddy coef. to the background value 
    909 !$OMP PARALLEL 
    910 !$OMP DO schedule(static) private(jk,jj,ji) 
    911806      DO jk = 1, jpk 
    912          DO jj = 1, jpj 
    913             DO ji = 1, jpi 
    914                avt (ji,jj,jk) = avtb(jk) * wmask (ji,jj,jk) 
    915                avm (ji,jj,jk) = avmb(jk) * wmask (ji,jj,jk) 
    916                avmu(ji,jj,jk) = avmb(jk) * wumask(ji,jj,jk) 
    917                avmv(ji,jj,jk) = avmb(jk) * wvmask(ji,jj,jk) 
    918             END DO 
    919          END DO 
    920       END DO 
    921 !$OMP END DO NOWAIT 
    922 !$OMP DO schedule(static) private(jk,jj,ji) 
    923       DO jk = 1, jpk 
    924          DO jj = 1, jpj 
    925             DO ji = 1, jpi 
    926                dissl(ji,jj,jk) = 1.e-12_wp 
    927             END DO 
    928          END DO 
    929       END DO 
    930 !$OMP END PARALLEL 
     807         avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
     808         avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 
     809         avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 
     810         avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 
     811      END DO 
     812      dissl(:,:,:) = 1.e-12_wp 
    931813      !                               
    932814      CALL tke_rst( nit000, 'READ' )  !* read or initialize all required files 
    … …  
    948830     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    949831     ! 
    950      INTEGER ::   jit, jk, jj, ji   ! dummy loop indices 
     832     INTEGER ::   jit, jk   ! dummy loop indices 
    951833     INTEGER ::   id1, id2, id3, id4, id5, id6   ! local integers 
    952834     !!---------------------------------------------------------------------- 
    … …  
    975857           ELSE                                     ! No TKE array found: initialisation 
    976858              IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without tke scheme, en computed by iterative loop' 
    977 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    978               DO jk = 1, jpk 
    979                  DO jj = 1, jpj 
    980                     DO ji = 1, jpi 
    981                        en (ji,jj,jk) = rn_emin * tmask(ji,jj,jk) 
    982                     END DO 
    983                  END DO 
    984               END DO 
     859              en (:,:,:) = rn_emin * tmask(:,:,:) 
    985860              CALL tke_avn                               ! recompute avt, avm, avmu, avmv and dissl (approximation) 
    986861              ! 
    987 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    988               DO jk = 1, jpk 
    989                  DO jj = 1, jpj 
    990                     DO ji = 1, jpi 
    991                        avt_k (ji,jj,jk) = avt (ji,jj,jk) 
    992                        avm_k (ji,jj,jk) = avm (ji,jj,jk) 
    993                        avmu_k(ji,jj,jk) = avmu(ji,jj,jk) 
    994                        avmv_k(ji,jj,jk) = avmv(ji,jj,jk) 
    995                     END DO 
    996                  END DO 
    997               END DO 
     862              avt_k (:,:,:) = avt (:,:,:) 
     863              avm_k (:,:,:) = avm (:,:,:) 
     864              avmu_k(:,:,:) = avmu(:,:,:) 
     865              avmv_k(:,:,:) = avmv(:,:,:) 
    998866              ! 
    999867              DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_tke( jit )   ;   END DO 
    1000868           ENDIF 
    1001869        ELSE                                   !* Start from rest 
    1002 !$OMP PARALLEL 
    1003 !$OMP DO schedule(static) private(jk,jj,ji) 
    1004            DO jk = 1, jpk 
    1005               DO jj = 1, jpj 
    1006                  DO ji = 1, jpi 
    1007                     en(ji,jj,jk) = rn_emin * tmask(ji,jj,jk) 
    1008                  END DO 
    1009               END DO 
     870           en(:,:,:) = rn_emin * tmask(:,:,:) 
     871           DO jk = 1, jpk                           ! set the Kz to the background value 
     872              avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
     873              avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 
     874              avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 
     875              avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 
    1010876           END DO 
    1011 !$OMP END DO NOWAIT 
    1012 !$OMP DO schedule(static) private(jk) 
    1013            DO jk = 1, jpk                           ! set the Kz to the background value 
    1014               DO jj = 1, jpj 
    1015                  DO ji = 1, jpi 
    1016                     avt (ji,jj,jk) = avtb(jk) * wmask (ji,jj,jk) 
    1017                     avm (ji,jj,jk) = avmb(jk) * wmask (ji,jj,jk) 
    1018                     avmu(ji,jj,jk) = avmb(jk) * wumask(ji,jj,jk) 
    1019                     avmv(ji,jj,jk) = avmb(jk) * wvmask(ji,jj,jk) 
    1020                  END DO 
    1021               END DO 
    1022            END DO 
    1023 !$OMP END PARALLEL 
    1024877        ENDIF 
    1025878        ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r7698 r7753  
    121121      !                          ! ----------------------- ! 
    122122      !                             !* First estimation (with n2 bound by rn_n2min) bounded by 60 cm2/s 
    123 !$OMP PARALLEL 
    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                zav_tide(ji,jj,jk) = MIN(  60.e-4, az_tmx(ji,jj,jk) / MAX( rn_n2min, rn2(ji,jj,jk) )  ) 
    129             END DO 
    130          END DO 
    131       END DO 
    132 !$OMP END DO NOWAIT 
    133  
    134 !$OMP DO schedule(static) private(jj, ji)  
    135       DO jj = 1, jpj 
    136          DO ji = 1, jpi 
    137             zkz(ji,jj) = 0.e0               !* Associated potential energy consummed over the whole water column 
    138          END DO 
    139       END DO 
     123      zav_tide(:,:,:) = MIN(  60.e-4, az_tmx(:,:,:) / MAX( rn_n2min, rn2(:,:,:) )  ) 
     124 
     125      zkz(:,:) = 0.e0               !* Associated potential energy consummed over the whole water column 
    140126      DO jk = 2, jpkm1 
    141 !$OMP DO schedule(static) private(jj, ji)  
    142          DO jj = 1, jpj 
    143             DO ji = 1, jpi 
    144                zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
    145             END DO 
    146          END DO 
    147       END DO 
    148  
    149 !$OMP DO schedule(static) private(jj, ji)  
     127         zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
     128      END DO 
     129 
    150130      DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    151131         DO ji = 1, jpi 
    … …  
    155135 
    156136      DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 
    157 !$OMP DO schedule(static) private(jj, ji)  
    158          DO jj = 1, jpj 
    159             DO ji = 1, jpi 
    160                zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s 
    161             END DO 
    162          END DO 
    163       END DO 
    164 !$OMP END PARALLEL 
     137         zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s 
     138      END DO 
    165139 
    166140      IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide 
    167141         ztpc = 0._wp 
    168 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc)  
    169142         DO jk= 1, jpk 
    170143            DO jj= 1, jpj 
    … …  
    189162      !                          !   Update  mixing coefs  !                           
    190163      !                          ! ----------------------- ! 
    191 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)  
    192164      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing 
    193          DO jj = 1, jpj 
    194             DO ji = 1, jpi  ! vector opt. 
    195                avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
    196                avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
    197             END DO 
    198          END DO 
     165         avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 
     166         avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 
    199167         DO jj = 2, jpjm1 
    200168            DO ji = fs_2, fs_jpim1  ! vector opt. 
    … …  
    257225 
    258226      !                             ! compute the form function using N2 at each time step 
    259 !$OMP PARALLEL  
    260 !$OMP DO schedule(static) private(jj, ji)  
    261       DO jj = 1, jpj 
    262          DO ji = 1, jpi 
    263             zempba_3d_1(ji,jj,jpk) = 0.e0 
    264             zempba_3d_2(ji,jj,jpk) = 0.e0 
    265          END DO 
    266       END DO 
    267 !$OMP DO schedule(static) private(jk,jj,ji)  
     227      zempba_3d_1(:,:,jpk) = 0.e0 
     228      zempba_3d_2(:,:,jpk) = 0.e0 
    268229      DO jk = 1, jpkm1              
    269          DO jj = 1, jpj 
    270             DO ji = 1, jpi 
    271                zdn2dz     (ji,jj,jk) = rn2(ji,jj,jk) - rn2(ji,jj,jk+1)           ! Vertical profile of dN2/dz 
    272                zempba_3d_1(ji,jj,jk) = SQRT(  MAX( 0.e0, rn2(ji,jj,jk) )  )    !    -        -    of N 
    273                zempba_3d_2(ji,jj,jk) =        MAX( 0.e0, rn2(ji,jj,jk) )       !    -        -    of N^2 
    274             END DO 
    275          END DO 
    276       END DO 
    277 !$OMP END DO NOWAIT 
    278       ! 
    279 !$OMP DO schedule(static) private(jj, ji)  
    280       DO jj = 1, jpj 
    281          DO ji = 1, jpi 
    282             zsum (ji,jj) = 0.e0 
    283             zsum1(ji,jj) = 0.e0 
    284             zsum2(ji,jj) = 0.e0 
    285          END DO 
    286       END DO 
     230         zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz 
     231         zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N 
     232         zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2 
     233      END DO 
     234      ! 
     235      zsum (:,:) = 0.e0 
     236      zsum1(:,:) = 0.e0 
     237      zsum2(:,:) = 0.e0 
    287238      DO jk= 2, jpk 
    288 !$OMP DO schedule(static) private(jj,ji)  
    289          DO jj= 1, jpj 
    290             DO ji= 1, jpi 
    291                zsum1(ji,jj) = zsum1(ji,jj) + zempba_3d_1(ji,jj,jk) * e3w_n(ji,jj,jk) * wmask(ji,jj,jk) 
    292                zsum2(ji,jj) = zsum2(ji,jj) + zempba_3d_2(ji,jj,jk) * e3w_n(ji,jj,jk) * wmask(ji,jj,jk)               
    293             END DO 
    294         END DO  
    295       END DO 
    296 !$OMP DO schedule(static) private(jj,ji)  
     239         zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk) 
     240         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk)                
     241      END DO 
    297242      DO jj = 1, jpj 
    298243         DO ji = 1, jpi 
    … …  
    303248 
    304249      DO jk= 1, jpk 
    305 !$OMP DO schedule(static) private(jj,ji,zcoef,ztpc)  
    306250         DO jj = 1, jpj 
    307251            DO ji = 1, jpi 
    … …  
    315259         END DO 
    316260       END DO 
    317 !$OMP DO schedule(static) private(jj,ji)  
    318261       DO jj = 1, jpj 
    319262          DO ji = 1, jpi 
    … …  
    324267      !                             ! first estimation bounded by 10 cm2/s (with n2 bounded by rn_n2min)  
    325268      zcoef = rn_tfe_itf / ( rn_tfe * rau0 ) 
    326 !$OMP DO schedule(static) private(jk,jj,ji)  
    327269      DO jk = 1, jpk 
    328          DO jj = 1, jpj 
    329             DO ji = 1, jpi 
    330                zavt_itf(ji,jj,jk) = MIN(  10.e-4, zcoef * en_tmx(ji,jj) * zsum(ji,jj) * zempba_3d(ji,jj,jk)   & 
    331             &                                      / MAX( rn_n2min, rn2(ji,jj,jk) ) * tmask(ji,jj,jk)  ) 
    332             END DO 
    333          END DO 
    334       END DO                
    335  
    336 !$OMP DO schedule(static) private(jj, ji)  
    337       DO jj = 1, jpj 
    338          DO ji = 1, jpi 
    339             zkz(ji,jj) = 0.e0               ! Associated potential energy consummed over the whole water column 
    340          END DO 
    341       END DO 
     270         zavt_itf(:,:,jk) = MIN(  10.e-4, zcoef * en_tmx(:,:) * zsum(:,:) * zempba_3d(:,:,jk)   & 
     271            &                                      / MAX( rn_n2min, rn2(:,:,jk) ) * tmask(:,:,jk)  ) 
     272      END DO            
     273 
     274      zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column 
    342275      DO jk = 2, jpkm1 
    343 !$OMP DO schedule(static) private(jj,ji)  
    344          DO jj = 1, jpj 
    345             DO ji = 1, jpi 
    346                zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zavt_itf(ji,jj,jk) * wmask(ji,jj,jk) 
    347             END DO 
    348          END DO 
    349       END DO 
    350  
    351 !$OMP DO schedule(static) private(jj,ji)  
     276         zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 
     277      END DO 
     278 
    352279      DO jj = 1, jpj                ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    353280         DO ji = 1, jpi 
    … …  
    356283      END DO 
    357284 
    358 !$OMP DO schedule(static) private(jk,jj,ji)  
    359285      DO jk = 2, jpkm1              ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s 
    360          DO jj = 1, jpj 
    361             DO ji = 1, jpi 
    362                zavt_itf(ji,jj,jk) = zavt_itf(ji,jj,jk) * MIN( zkz(ji,jj), 120./10. ) * wmask(ji,jj,jk)   ! kz max = 120 cm2/s 
    363             END DO 
    364          END DO 
    365       END DO 
    366 !$OMP END PARALLEL 
     286         zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk)   ! kz max = 120 cm2/s 
     287      END DO 
    367288 
    368289      IF( kt == nit000 ) THEN       ! diagnose the nergy consumed by zavt_itf 
    369290         ztpc = 0.e0 
    370 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc)  
    371291         DO jk= 1, jpk 
    372292            DO jj= 1, jpj 
    … …  
    383303 
    384304      !                             ! Update pav with the ITF mixing coefficient 
    385 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)  
    386305      DO jk = 2, jpkm1 
    387          DO jj= 1, jpj 
    388             DO ji= 1, jpi 
    389                pav(ji,jj,jk) = pav     (ji,jj,jk) * ( 1.e0 - mask_itf(ji,jj) )   & 
    390                   &        + zavt_itf(ji,jj,jk) *          mask_itf(ji,jj)  
    391             END DO 
    392          END DO 
     306         pav(:,:,jk) = pav     (:,:,jk) * ( 1.e0 - mask_itf(:,:) )   & 
     307            &        + zavt_itf(:,:,jk) *          mask_itf(:,:)  
    393308      END DO 
    394309      ! 
    … …  
    494409      !                                ! only the energy available for mixing is taken into account, 
    495410      !                                ! (mixing efficiency tidal dissipation efficiency) 
    496 !$OMP PARALLEL 
    497  
    498 !$OMP DO schedule(static) private(jj, ji)  
    499       DO jj = 1, jpj 
    500          DO ji = 1, jpi 
    501             en_tmx(ji,jj) = - rn_tfe * rn_me * ( zem2(ji,jj) * 1.25 + zek1(ji,jj) ) * ssmask(ji,jj) 
    502          END DO 
    503       END DO 
     411      en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:) 
    504412 
    505413!============ 
    … …  
    508416!!     the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation. 
    509417      !                                ! Vertical structure (az_tmx) 
    510 !$OMP DO schedule(static) private(jj, ji) 
    511418      DO jj = 1, jpj                         ! part independent of the level 
    512419         DO ji = 1, jpi 
    … …  
    516423         END DO 
    517424      END DO 
    518 !$OMP DO schedule(static) private(jk, jj, ji) 
    519425      DO jk= 1, jpk                          ! complete with the level-dependent part 
    520426         DO jj = 1, jpj 
    … …  
    524430         END DO 
    525431      END DO 
    526 !$OMP END PARALLEL 
    527432!=========== 
    528433      ! 
    … …  
    531436         ! Total power consumption due to vertical mixing 
    532437         ! zpc = rau0 * 1/rn_me * rn2 * zav_tide 
     438         zav_tide(:,:,:) = 0.e0 
     439         DO jk = 2, jpkm1 
     440            zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) ) 
     441         END DO 
     442         ! 
    533443         ztpc = 0._wp 
    534 !$OMP PARALLEL 
    535 !$OMP DO schedule(static) private(jk, jj, ji)  
    536          DO jk = 1, jpk 
    537             DO jj = 1, jpj 
    538                DO ji = 1, jpi 
    539                   zav_tide(ji,jj,jk) = 0.e0 
    540                END DO 
    541             END DO 
    542          END DO 
    543 !$OMP DO schedule(static) private(jk,jj,ji) 
    544          DO jk = 2, jpkm1 
    545             DO jj = 1, jpj 
    546                DO ji = 1, jpi 
    547                   zav_tide(ji,jj,jk) = az_tmx(ji,jj,jk) / MAX( rn_n2min, rn2(ji,jj,jk) ) 
    548                END DO 
    549             END DO 
    550          END DO 
    551          ! 
    552 !$OMP DO schedule(static) private(jk, jj, ji) 
    553          DO jk= 1, jpk 
    554             DO jj = 1, jpj 
    555                DO ji = 1, jpi 
    556                   zpc(ji,jj,jk) = MAX(rn_n2min,rn2(ji,jj,jk)) * zav_tide(ji,jj,jk) 
    557                END DO 
    558             END DO 
    559          END DO 
    560 !$OMP DO schedule(static) private(jk, jj, ji, ztpc) 
     444         zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:) 
    561445         DO jk= 2, jpkm1 
    562446            DO jj = 1, jpj 
    … …  
    566450            END DO 
    567451         END DO 
    568 !$OMP END PARALLEL 
    569452         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    570453         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    … …  
    574457         ! 
    575458         ! control print 2 
    576 !$OMP PARALLEL 
    577 !$OMP DO schedule(static) private(jk, jj, ji) 
    578          DO jk= 1, jpk 
    579             DO jj = 1, jpj 
    580                DO ji = 1, jpi 
    581                   zav_tide(ji,jj,jk) = MIN( zav_tide(ji,jj,jk), 60.e-4 )    
    582                   zkz(ji,jj) = 0._wp 
    583                END DO 
    584             END DO 
    585          END DO 
    586  
     459         zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )    
     460         zkz(:,:) = 0._wp 
    587461         DO jk = 2, jpkm1 
    588 !$OMP DO schedule(static) private(jj, ji) 
    589             DO jj = 1, jpj 
    590                DO ji = 1, jpi 
    591                   zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
    592                END DO 
    593             END DO 
     462               zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
    594463         END DO 
    595464         ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz 
    596 !$OMP DO schedule(static) private(jj, ji) 
    597465         DO jj = 1, jpj 
    598466            DO ji = 1, jpi 
    … …  
    603471         END DO 
    604472         ztpc = 1.e50 
    605 !$OMP DO schedule(static) private(jj, ji, ztpc) 
    606473         DO jj = 1, jpj 
    607474            DO ji = 1, jpi 
    … …  
    611478            END DO 
    612479         END DO 
    613 !$OMP END PARALLEL 
    614480         WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) ) 
    615 !$OMP PARALLEL  
    616481         ! 
    617 !$OMP DO schedule(static) private(jk,jj,ji) 
    618482         DO jk = 2, jpkm1 
    619             DO jj = 1, jpj 
    620                DO ji = 1, jpi 
    621                   zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s 
    622                END DO 
    623             END DO 
     483            zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s 
    624484         END DO 
    625485         ztpc = 0._wp 
    626 !$OMP DO schedule(static) private(jk, jj, ji) 
    627          DO jk= 1, jpk 
    628             DO jj = 1, jpj 
    629                DO ji = 1, jpi 
    630                   zpc(ji,jj,jk) = Max(0.e0,rn2(ji,jj,jk)) * zav_tide(ji,jj,jk) 
    631                END DO 
    632             END DO 
    633          END DO 
    634 !$OMP DO schedule(static) private(jk, jj, ji, ztpc) 
     486         zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:) 
    635487         DO jk= 1, jpk 
    636488            DO jj = 1, jpj 
    … …  
    640492            END DO 
    641493         END DO 
    642 !$OMP END PARALLEL 
    643494         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    644495         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    … …  
    649500               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask   (:,:,jk) * tmask_i(:,:) ) ) 
    650501            ztpc = 1.e50 
    651 !$OMP PARALLEL DO schedule(static) private(ztpc, jj, ji) 
    652502            DO jj = 1, jpj 
    653503               DO ji = 1, jpi 
    … …  
    663513         WRITE(numout,*) '          Initial profile of tidal vertical mixing' 
    664514         DO jk = 1, jpk 
    665 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    666515            DO jj = 1,jpj 
    667516               DO ji = 1,jpi 
    … …  
    674523         END DO 
    675524         DO jk = 1, jpk 
    676 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    677             DO jj = 1,jpj 
    678                DO ji = 1,jpi 
    679                   zkz(ji,jj) = az_tmx(ji,jj,jk) /rn_n2min 
    680                END DO 
    681             END DO 
     525            zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 
    682526            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   & 
    683527               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) 
    … …  
    845689      !                        !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    846690      !                                                 using an exponential decay from the seafloor. 
    847 !$OMP PARALLEL 
    848 !$OMP DO schedule(static) private(jj,ji) 
    849691      DO jj = 1, jpj                ! part independent of the level 
    850692         DO ji = 1, jpi 
    … …  
    855697      END DO 
    856698 
    857 !$OMP DO schedule(static) private(jk,jj,ji) 
    858699      DO jk = 2, jpkm1              ! complete with the level-dependent part 
    859          DO jj = 1, jpj 
    860             DO ji = 1, jpi 
    861                emix_tmx(ji,jj,jk) = zfact(ji,jj) * (  EXP( ( gde3w_n(ji,jj,jk  ) - zhdep(ji,jj) ) / hcri_tmx(:,:) )                      & 
    862                   &                             - EXP( ( gde3w_n(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_tmx(ji,jj) )  ) * wmask(ji,jj,jk)   & 
    863                   &                          / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 
    864             END DO 
    865          END DO 
    866       END DO 
    867 !$OMP END PARALLEL 
     700         emix_tmx(:,:,jk) = zfact(:,:) * (  EXP( ( gde3w_n(:,:,jk  ) - zhdep(:,:) ) / hcri_tmx(:,:) )                      & 
     701            &                             - EXP( ( gde3w_n(:,:,jk-1) - zhdep(:,:) ) / hcri_tmx(:,:) )  ) * wmask(:,:,jk)   & 
     702            &                          / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 
     703      END DO 
    868704 
    869705      !                        !* Pycnocline-intensified mixing: distribute energy over the time-varying  
    … …  
    874710      CASE ( 1 )               ! Dissipation scales as N (recommended) 
    875711 
    876 !$OMP PARALLEL 
    877 !$OMP DO schedule(static) private(jj, ji)  
    878          DO jj = 1, jpj 
    879             DO ji = 1, jpi 
    880                zfact(ji,jj) = 0._wp 
    881             END DO 
    882          END DO 
     712         zfact(:,:) = 0._wp 
    883713         DO jk = 2, jpkm1              ! part independent of the level 
    884 !$OMP DO schedule(static) private(jj,ji) 
    885             DO jj = 1, jpj                ! part independent of the level 
    886                DO ji = 1, jpi 
    887                   zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    888                END DO 
    889             END DO 
    890          END DO 
    891  
    892 !$OMP DO schedule(static) private(jj,ji) 
     714            zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
     715         END DO 
     716 
    893717         DO jj = 1, jpj 
    894718            DO ji = 1, jpi 
    … …  
    897721         END DO 
    898722 
    899 !$OMP DO schedule(static) private(jk,jj,ji) 
    900723         DO jk = 2, jpkm1              ! complete with the level-dependent part 
    901             DO jj = 1, jpj 
    902                DO ji = 1, jpi 
    903                   emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,ji,jk) 
    904                END DO 
    905             END DO 
    906          END DO 
    907 !$OMP END PARALLEL 
     724            emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
     725         END DO 
    908726 
    909727      CASE ( 2 )               ! Dissipation scales as N^2 
    910728 
    911 !$OMP PARALLEL 
    912 !$OMP DO schedule(static) private(jj, ji)  
    913          DO jj = 1, jpj 
    914             DO ji = 1, jpi 
    915                zfact(ji,jj) = 0._wp 
    916             END DO 
    917          END DO 
    918  
    919          DO jk = 2, jpkm1             
    920 !$OMP DO schedule(static) private(jj,ji) 
    921             DO jj = 1, jpj            
    922                DO ji = 1, jpi 
    923                   zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
    924                END DO 
    925             END DO 
    926          END DO 
    927  
    928 !$OMP DO schedule(static) private(jj,ji) 
     729         zfact(:,:) = 0._wp 
     730         DO jk = 2, jpkm1              ! part independent of the level 
     731            zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
     732         END DO 
     733 
    929734         DO jj= 1, jpj 
    930735            DO ji = 1, jpi 
    … …  
    933738         END DO 
    934739 
    935 !$OMP DO schedule(static) private(jk,jj,ji) 
    936740         DO jk = 2, jpkm1              ! complete with the level-dependent part 
    937             DO jj = 1, jpj 
    938                DO ji = 1, jpi 
    939                   emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,ji,jk) 
    940                END DO 
    941             END DO 
    942          END DO 
    943 !$OMP END PARALLEL 
     741            emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
     742         END DO 
    944743 
    945744      END SELECT 
    … …  
    948747      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
    949748       
    950 !$OMP PARALLEL 
    951 !$OMP DO schedule(static) private(jk,jj,ji)  
    952       DO jk = 1, jpk 
    953          DO jj = 1, jpj 
    954             DO ji = 1, jpi 
    955                zwkb(ji,jj,jk) = 0._wp 
    956             END DO 
    957          END DO 
    958       END DO 
    959 !$OMP DO schedule(static) private(jj,ji) 
    960       DO jj = 1, jpj 
    961          DO ji = 1, jpi 
    962             zfact(ji,jj) = 0._wp 
    963          END DO 
    964       END DO 
     749      zwkb(:,:,:) = 0._wp 
     750      zfact(:,:) = 0._wp 
    965751      DO jk = 2, jpkm1 
    966 !$OMP DO schedule(static) private(jj,ji) 
    967          DO jj = 1, jpj            
    968             DO ji = 1, jpi 
    969                zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
    970                zwkb(ji,jj,jk) = zfact(ji,jj) 
    971             END DO 
    972          END DO 
    973       END DO 
    974  
    975 !$OMP DO schedule(static) private(jk,jj,ji) 
     752         zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
     753         zwkb(:,:,jk) = zfact(:,:) 
     754      END DO 
     755 
    976756      DO jk = 2, jpkm1 
    977757         DO jj = 1, jpj 
    … …  
    982762         END DO 
    983763      END DO 
    984  
    985 !$OMP DO schedule(static) private(jj, ji)  
    986       DO jj = 1, jpj 
    987          DO ji = 1, jpi 
    988             zwkb(ji,jj,1) = zhdep(ji,jj) * tmask(ji,jj,1) 
    989          END DO 
    990       END DO 
    991 !$OMP END DO NOWAIT 
    992 !$OMP DO schedule(static) private(jk,jj,ji)  
    993       DO jk = 1, jpk 
    994          DO jj = 1, jpj 
    995             DO ji = 1, jpi 
    996                zweight(ji,jj,jk) = 0._wp 
    997             END DO 
    998          END DO 
    999       END DO 
    1000  
    1001 !$OMP DO schedule(static) private(jk,jj,ji) 
     764      zwkb(:,:,1) = zhdep(:,:) * tmask(:,:,1) 
     765 
     766      zweight(:,:,:) = 0._wp 
    1002767      DO jk = 2, jpkm1 
    1003          DO jj = 1, jpj 
    1004             DO ji = 1, jpi 
    1005                zweight(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * hbot_tmx(ji,jj) * wmask(ji,jj,jk)                    & 
    1006                 &   * (  EXP( -zwkb(ji,jj,jk) / hbot_tmx(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_tmx(ji,jj) )  ) 
    1007             END DO 
    1008          END DO 
    1009       END DO 
    1010  
    1011 !$OMP DO schedule(static) private(jj, ji)  
    1012       DO jj = 1, jpj 
    1013          DO ji = 1, jpi 
    1014             zfact(ji,jj) = 0._wp 
    1015          END DO 
    1016       END DO 
    1017  
     768         zweight(:,:,jk) = MAX( 0._wp, rn2(:,:,jk) ) * hbot_tmx(:,:) * wmask(:,:,jk)                    & 
     769            &   * (  EXP( -zwkb(:,:,jk) / hbot_tmx(:,:) ) - EXP( -zwkb(:,:,jk-1) / hbot_tmx(:,:) )  ) 
     770      END DO 
     771 
     772      zfact(:,:) = 0._wp 
    1018773      DO jk = 2, jpkm1              ! part independent of the level 
    1019 !$OMP DO schedule(static) private(jj,ji) 
    1020          DO jj = 1, jpj            
    1021             DO ji = 1, jpi 
    1022                zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 
    1023             END DO 
    1024          END DO 
    1025       END DO 
    1026  
    1027 !$OMP DO schedule(static) private(jj,ji) 
     774         zfact(:,:) = zfact(:,:) + zweight(:,:,jk) 
     775      END DO 
     776 
    1028777      DO jj = 1, jpj 
    1029778         DO ji = 1, jpi 
    … …  
    1032781      END DO 
    1033782 
    1034 !$OMP DO schedule(static) private(jk,jj,ji) 
    1035783      DO jk = 2, jpkm1              ! complete with the level-dependent part 
    1036          DO jj = 1, jpj 
    1037             DO ji = 1, jpi 
    1038                emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,ji,jk) 
    1039                   &                                / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 
    1040             END DO 
    1041          END DO 
    1042       END DO 
    1043 !$OMP END DO NOWAIT 
     784         emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk)   & 
     785            &                                / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 
     786      END DO 
    1044787 
    1045788 
    1046789      ! Calculate molecular kinematic viscosity 
    1047 !$OMP DO schedule(static) private(jj, ji)  
    1048       DO jj = 1, jpj 
    1049          DO ji = 1, jpi 
    1050             znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(ji,jj,jk,jp_tem) & 
    1051          &                                  + 0.00694_wp * tsn(ji,jj,jk,jp_tem) * tsn(ji,jj,jk,jp_tem)  & 
    1052          &                                  + 0.02305_wp * tsn(ji,jj,jk,jp_sal)  ) * tmask(ji,jj,jk) * r1_rau0 
    1053          END DO 
    1054       END DO 
    1055 !$OMP DO schedule(static) private(jk,jj,ji) 
     790      znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem)  & 
     791         &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rau0 
    1056792      DO jk = 2, jpkm1 
    1057          DO jj = 1, jpj 
    1058             DO ji = 1, jpi 
    1059                znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 
    1060             END DO 
    1061          END DO 
     793         znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 
    1062794      END DO 
    1063795 
    1064796      ! Calculate turbulence intensity parameter Reb 
    1065 !$OMP DO schedule(static) private(jk,jj,ji) 
    1066797      DO jk = 2, jpkm1 
    1067          DO jj = 1, jpj 
    1068             DO ji = 1, jpi 
    1069                zReb(ji,jj,jk) = emix_tmx(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 
    1070             END DO 
    1071          END DO 
     798         zReb(:,:,jk) = emix_tmx(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) ) 
    1072799      END DO 
    1073800 
    1074801      ! Define internal wave-induced diffusivity 
    1075 !$OMP DO schedule(static) private(jk,jj,ji) 
    1076802      DO jk = 2, jpkm1 
    1077          DO jj = 1, jpj 
    1078             DO ji = 1, jpi 
    1079                zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
    1080             END DO 
    1081          END DO 
    1082       END DO 
    1083 !$OMP END PARALLEL 
     803         zav_wave(:,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
     804      END DO 
    1084805 
    1085806      IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the 
    1086 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    1087807         DO jk = 2, jpkm1              ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
    1088808            DO jj = 1, jpj 
    … …  
    1098818      ENDIF 
    1099819 
    1100 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    1101820      DO jk = 2, jpkm1                 ! Bound diffusivity by molecular value and 100 cm2/s 
    1102          DO jj = 1, jpj 
    1103             DO ji = 1, jpi 
    1104                zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk) 
    1105             END DO 
    1106          END DO 
     821         zav_wave(:,:,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp  ) * wmask(:,:,jk) 
    1107822      END DO 
    1108823 
    1109824      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave 
    1110825         ztpc = 0._wp 
    1111 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc) 
    1112826         DO jk = 2, jpkm1 
    1113827            DO jj = 1, jpj 
    … …  
    1135849      !       
    1136850      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature 
    1137 !$OMP PARALLEL 
    1138 !$OMP DO schedule(static) private(jk,jj,ji) 
    1139851         DO jk = 2, jpkm1              ! Calculate S/T diffusivity ratio as a function of Reb 
    1140852            DO jj = 1, jpj 
    … …  
    1146858            END DO 
    1147859         END DO 
    1148 !$OMP DO schedule(static) private(jk,jj,ji) 
     860         CALL iom_put( "av_ratio", zav_ratio ) 
    1149861         DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing 
    1150             DO jj = 1, jpj 
    1151                DO ji = 1, jpi 
    1152                   fsavs(ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 
    1153                   avt  (ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
    1154                   avm  (ji,jj,jk) = avm(ji,jj,jk) + zav_wave(ji,jj,jk) 
    1155                END DO 
    1156             END DO 
    1157          END DO 
    1158 !$OMP END PARALLEL 
    1159          CALL iom_put( "av_ratio", zav_ratio ) 
     862            fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) * zav_ratio(:,:,jk) 
     863            avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
     864            avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk) 
     865         END DO 
    1160866         ! 
    1161867      ELSE                          !* update momentum & tracer diffusivity with wave-driven mixing 
    1162 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    1163868         DO jk = 2, jpkm1 
    1164             DO jj = 1, jpj 
    1165                DO ji = 1, jpi 
    1166                   fsavs(ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
    1167                   avt  (ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
    1168                   avm  (ji,jj,jk) = avm(ji,jj,jk) + zav_wave(ji,jj,jk) 
    1169                END DO 
    1170             END DO 
    1171          END DO 
    1172       ENDIF 
    1173  
    1174 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     869            fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
     870            avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
     871            avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk) 
     872         END DO 
     873      ENDIF 
     874 
    1175875      DO jk = 2, jpkm1              !* update momentum diffusivity at wu and wv points 
    1176876         DO jj = 2, jpjm1 
    … …  
    1188888                                    !  vertical integral of rau0 * Kz * N^2 (pcmap_tmx), energy density (emix_tmx) 
    1189889      IF( iom_use("bflx_tmx") .OR. iom_use("pcmap_tmx") ) THEN 
    1190 !$OMP PARALLEL 
    1191 !$OMP DO schedule(static) private(jk,jj,ji) 
    1192       DO jk = 1, jpk 
    1193          DO jj = 1, jpj 
    1194             DO ji = 1, jpi 
    1195                bflx_tmx(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) 
    1196             END DO 
    1197          END DO 
    1198       END DO 
    1199 !$OMP END DO NOWAIT 
    1200 !$OMP DO schedule(static) private(jj, ji)  
    1201       DO jj = 1, jpj 
    1202          DO ji = 1, jpi 
    1203             pcmap_tmx(ji,jj) = 0._wp 
    1204          END DO 
    1205       END DO 
    1206       DO jk = 2, jpkm1 
    1207 !$OMP DO schedule(static) private(jj, ji)  
    1208          DO jj = 1, jpj 
    1209             DO ji = 1, jpi 
    1210                pcmap_tmx(ji,jj) = pcmap_tmx(ji,jj) + e3w_n(ji,jj,jk) * bflx_tmx(ji,jj,jk) * wmask(ji,jj,jk) 
    1211             END DO 
    1212          END DO 
    1213       END DO 
    1214 !$OMP DO schedule(static) private(jj, ji)  
    1215       DO jj = 1, jpj 
    1216          DO ji = 1, jpi 
    1217             pcmap_tmx(ji,jj) = rau0 * pcmap_tmx(ji,jj) 
    1218          END DO 
    1219       END DO 
    1220 !$OMP END PARALLEL 
     890         bflx_tmx(:,:,:) = MAX( 0._wp, rn2(:,:,:) ) * zav_wave(:,:,:) 
     891         pcmap_tmx(:,:) = 0._wp 
     892         DO jk = 2, jpkm1 
     893            pcmap_tmx(:,:) = pcmap_tmx(:,:) + e3w_n(:,:,jk) * bflx_tmx(:,:,jk) * wmask(:,:,jk) 
     894         END DO 
     895         pcmap_tmx(:,:) = rau0 * pcmap_tmx(:,:) 
    1221896         CALL iom_put( "bflx_tmx", bflx_tmx ) 
    1222897         CALL iom_put( "pcmap_tmx", pcmap_tmx ) 
    … …  
    1295970      avmb(:) = 1.4e-6_wp        ! viscous molecular value 
    1296971      avtb(:) = 1.e-10_wp        ! very small diffusive minimum (background avt is specified in zdf_tmx)     
    1297 !$OMP PARALLEL DO schedule(static) private(jj, ji)  
    1298       DO jj = 1, jpj 
    1299          DO ji = 1, jpi 
    1300             avtb_2d(ji,jj) = 1.e0_wp     ! uniform  
    1301          END DO 
    1302       END DO 
     972      avtb_2d(:,:) = 1.e0_wp     ! uniform  
    1303973      IF(lwp) THEN                  ! Control print 
    1304974         WRITE(numout,*) 
    … …  
    13331003      CALL iom_close(inum) 
    13341004 
    1335 !$OMP PARALLEL DO schedule(static) private(jj, ji)  
    1336       DO jj = 1, jpj 
    1337          DO ji = 1, jpi 
    1338             ebot_tmx(ji,jj) = ebot_tmx(ji,jj) * ssmask(ji,jj) 
    1339             epyc_tmx(ji,jj) = epyc_tmx(ji,jj) * ssmask(ji,jj) 
    1340             ecri_tmx(ji,jj) = ecri_tmx(ji,jj) * ssmask(ji,jj) 
    1341              
    1342             ! Set once for all to zero the first and last vertical levels of appropriate variables 
    1343             emix_tmx (ji,jj, 1 ) = 0._wp 
    1344             emix_tmx (ji,jj,jpk) = 0._wp 
    1345             zav_ratio(ji,jj, 1 ) = 0._wp 
    1346             zav_ratio(ji,jj,jpk) = 0._wp 
    1347             zav_wave (ji,jj, 1 ) = 0._wp 
    1348             zav_wave (ji,jj,jpk) = 0._wp 
    1349          END DO 
    1350       END DO 
     1005      ebot_tmx(:,:) = ebot_tmx(:,:) * ssmask(:,:) 
     1006      epyc_tmx(:,:) = epyc_tmx(:,:) * ssmask(:,:) 
     1007      ecri_tmx(:,:) = ecri_tmx(:,:) * ssmask(:,:) 
     1008 
     1009      ! Set once for all to zero the first and last vertical levels of appropriate variables 
     1010      emix_tmx (:,:, 1 ) = 0._wp 
     1011      emix_tmx (:,:,jpk) = 0._wp 
     1012      zav_ratio(:,:, 1 ) = 0._wp 
     1013      zav_ratio(:,:,jpk) = 0._wp 
     1014      zav_wave (:,:, 1 ) = 0._wp 
     1015      zav_wave (:,:,jpk) = 0._wp 
    13511016 
    13521017      zbot = glob_sum( e1e2t(:,:) * ebot_tmx(:,:) ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/step.F90

    r7698 r7753  
    7474      !!              -8- Outputs and diagnostics 
    7575      !!---------------------------------------------------------------------- 
    76       INTEGER ::   ji,jj,jk,jn ! dummy loop indice 
     76      INTEGER ::   ji,jj,jk ! dummy loop indice 
    7777      INTEGER ::   indic    ! error indicator if < 0 
    7878      INTEGER ::   kcall    ! optional integer argument (dom_vvl_sf_nxt) 
    … …  
    135135      ! 
    136136      IF( lk_zdfcst  ) THEN                                ! Constant Kz (reset avt, avm[uv] to the background value) 
    137 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    138          DO jk = 1, jpk 
    139             DO jj = 1, jpj 
    140                DO ji = 1, jpi 
    141                   avt (ji,jj,jk) = rn_avt0 * wmask (ji,jj,jk) 
    142                   avmu(ji,jj,jk) = rn_avm0 * wumask(ji,jj,jk) 
    143                   avmv(ji,jj,jk) = rn_avm0 * wvmask(ji,jj,jk) 
    144                END DO 
    145             END DO 
    146          END DO 
     137         avt (:,:,:) = rn_avt0 * wmask (:,:,:) 
     138         avmu(:,:,:) = rn_avm0 * wumask(:,:,:) 
     139         avmv(:,:,:) = rn_avm0 * wvmask(:,:,:) 
    147140      ENDIF 
    148141 
    149142      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths 
    150 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    151          DO jk = 2, nkrnf 
    152             DO jj = 1, jpj 
    153                DO ji = 1, jpi 
    154                   avt(ji,jj,jk) = avt(ji,jj,jk) + 2._wp * rn_avt_rnf * rnfmsk(ji,jj) * tmask(ji,jj,jk) 
    155                END DO 
    156             END DO 
    157          END DO 
     143         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
    158144      ENDIF 
    159145      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity 
    … …  
    211197               &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level 
    212198!!jc: fs simplification 
    213 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    214          DO jk = 1, jpk 
    215             DO jj = 1, jpj 
    216                DO ji = 1, jpi 
    217                   ua(ji,jj,jk) = 0._wp            ! set dynamics trends to zero 
    218                   va(ji,jj,jk) = 0._wp 
    219                END DO 
    220             END DO 
    221          END DO 
     199                             
     200                         ua(:,:,:) = 0._wp            ! set dynamics trends to zero 
     201                         va(:,:,:) = 0._wp 
    222202 
    223203      IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
    … …  
    272252      ! Active tracers                               
    273253      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    274       DO jn = 1, jpts 
    275 !$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    276          DO jk = 1, jpk 
    277             DO jj = 1, jpj 
    278                DO ji = 1, jpi 
    279                   tsa(ji,jj,jk,jn) = 0._wp         ! set tracer trends to zero 
    280                END DO 
    281             END DO 
    282          END DO 
    283       END DO 
     254                         tsa(:,:,:,:) = 0._wp         ! set tracer trends to zero 
    284255 
    285256      IF(  lk_asminc .AND. ln_asmiau .AND. & 
Note: See TracChangeset for help on using the changeset viewer.