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/LIM_SRC_3 – 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/LIM_SRC_3
Files:
17 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90

    r7698 r7753  
    7575      !  upstream advection with initial mass fluxes & intermediate update 
    7676      ! -------------------------------------------------------------------- 
    77 !$OMP PARALLEL 
    78 !$OMP DO schedule(static) private(jj,ji,zfp_ui,zfm_ui,zfp_vj,zfm_vj) 
    7977      DO jj = 1, jpjm1         ! upstream tracer flux in the i and j direction 
    8078         DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    8886      END DO 
    8987       
    90 !$OMP DO schedule(static) private(jj,ji,ztra) 
    9188      DO jj = 2, jpjm1            ! total intermediate advective trends 
    9289         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    9895         END DO 
    9996      END DO 
    100 !$OMP END PARALLEL 
    10197      CALL lbc_lnk( zt_ups, 'T', 1. )        ! Lateral boundary conditions   (unchanged sign) 
    10298       
    … …  
    105101      SELECT CASE( nn_limadv_ord ) 
    106102      CASE ( 20 )                          ! centered second order 
    107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    108103         DO jj = 2, jpjm1 
    109104            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    116111         CALL macho( kt, nn_limadv_ord, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v ) 
    117112         ! 
    118 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    119113         DO jj = 2, jpjm1 
    120114            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    128122      ! antidiffusive flux : high order minus low order 
    129123      ! -------------------------------------------------- 
    130 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    131124      DO jj = 2, jpjm1 
    132125         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    143136      ! final trend with corrected fluxes 
    144137      ! ------------------------------------ 
    145 !$OMP PARALLEL DO schedule(static) private(jj,ji,ztra) 
    146138      DO jj = 2, jpjm1 
    147139         DO ji = fs_2, fs_jpim1   ! vector opt.   
    … …  
    195187         ! 
    196188         !                                                           !--  advective form update in zzt  --! 
    197 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    198189         DO jj = 2, jpjm1 
    199190            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    214205         ! 
    215206         !                                                           !--  advective form update in zzt  --! 
    216 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    217207         DO jj = 2, jpjm1 
    218208            DO ji = fs_2, fs_jpim1 
    … …  
    263253      ! 
    264254      !                                                     !--  Laplacian in i-direction  --! 
    265 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    266255      DO jj = 2, jpjm1         ! First derivative (gradient) 
    267256         DO ji = 1, fs_jpim1 
    … …  
    276265      ! 
    277266      !                                                     !--  BiLaplacian in i-direction  --! 
    278 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    279267      DO jj = 2, jpjm1         ! Third derivative 
    280268         DO ji = 1, fs_jpim1 
    … …  
    293281      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21) 
    294282         !         
    295 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    296283         DO jj = 1, jpj 
    297284            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    303290      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23) 
    304291         ! 
    305 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu) 
    306292         DO jj = 1, jpj 
    307293            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    315301      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24) 
    316302         ! 
    317 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2) 
    318303         DO jj = 1, jpj 
    319304            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    330315      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27) 
    331316         ! 
    332 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2) 
    333317         DO jj = 1, jpj 
    334318            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    345329      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29) 
    346330         ! 
    347 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2,zdx4) 
    348331         DO jj = 1, jpj 
    349332            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    397380      ! 
    398381      !                                                     !--  Laplacian in j-direction  --! 
    399 !$OMP PARALLEL 
    400 !$OMP DO schedule(static) private(jj,ji) 
    401382      DO jj = 1, jpjm1         ! First derivative (gradient) 
    402383         DO ji = fs_2, fs_jpim1 
    … …  
    404385         END DO 
    405386      END DO 
    406 !$OMP DO schedule(static) private(jj,ji) 
    407387      DO jj = 2, jpjm1         ! Second derivative (Laplacian) 
    408388         DO ji = fs_2, fs_jpim1 
    … …  
    410390         END DO 
    411391      END DO 
    412 !$OMP END PARALLEL 
    413392      CALL lbc_lnk( ztv2, 'T', 1. ) 
    414393      ! 
    415394      !                                                     !--  BiLaplacian in j-direction  --! 
    416 !$OMP PARALLEL 
    417 !$OMP DO schedule(static) private(jj,ji) 
    418395      DO jj = 1, jpjm1         ! First derivative 
    419396         DO ji = fs_2, fs_jpim1 
    … …  
    421398         END DO 
    422399      END DO 
    423 !$OMP DO schedule(static) private(jj,ji) 
    424400      DO jj = 2, jpjm1         ! Second derivative 
    425401         DO ji = fs_2, fs_jpim1 
    … …  
    427403         END DO 
    428404      END DO 
    429 !$OMP END PARALLEL 
    430405      CALL lbc_lnk( ztv4, 'T', 1. ) 
    431406      ! 
    … …  
    435410      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21) 
    436411         !         
    437 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    438412         DO jj = 1, jpjm1 
    439413            DO ji = 1, jpi 
    … …  
    444418         ! 
    445419      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23) 
    446 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv) 
    447420         DO jj = 1, jpjm1 
    448421            DO ji = 1, jpi 
    … …  
    456429      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24) 
    457430         ! 
    458 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2) 
    459431         DO jj = 1, jpjm1 
    460432            DO ji = 1, jpi 
    … …  
    471443      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27) 
    472444         ! 
    473 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2) 
    474445         DO jj = 1, jpjm1 
    475446            DO ji = 1, jpi 
    … …  
    486457      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29) 
    487458         ! 
    488 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2,zdy4) 
    489459         DO jj = 1, jpjm1 
    490460            DO ji = 1, jpi 
    … …  
    543513 
    544514      ! clem test 
    545 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    546515      DO jj = 2, jpjm1 
    547516         DO ji = fs_2, fs_jpim1   ! vector opt.   
    … …  
    553522 
    554523      ! Determine ice masks for before and after tracers  
    555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    556       DO jj = 1, jpj 
    557          DO ji = 1, jpi   
    558             IF( pbef(ji,jj) == 0._wp .AND. paft(ji,jj) == 0._wp .AND. zdiv(ji,jj) == 0._wp ) THEN 
    559                zmsk(ji,jj) = 0._wp 
    560             ELSE 
    561                zmsk(ji,jj) = 1._wp * tmask(ji,jj,1) 
    562             END IF 
    563          END DO 
    564       END DO 
     524      WHERE( pbef(:,:) == 0._wp .AND. paft(:,:) == 0._wp .AND. zdiv(:,:) == 0._wp )   ;   zmsk(:,:) = 0._wp 
     525      ELSEWHERE                                                                       ;   zmsk(:,:) = 1._wp * tmask(:,:,1) 
     526      END WHERE 
    565527 
    566528      ! Search local extrema 
    … …  
    571533!      zbdo(:,:) = MIN( pbef(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ),   & 
    572534!         &             paft(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) )  ) 
     535      zbup(:,:) = MAX( pbef(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) ),   & 
     536         &             paft(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) )  ) 
     537      zbdo(:,:) = MIN( pbef(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) ),   & 
     538         &             paft(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) )  ) 
    573539 
    574540      z1_dt = 1._wp / pdt 
    575  
    576 !$OMP PARALLEL 
    577 !$OMP DO schedule(static) private(jj,ji) 
    578       DO jj = 1, jpj 
    579          DO ji = 1, jpi   
    580             zbup(ji,jj) = MAX( pbef(ji,jj) * zmsk(ji,jj) - zbig * ( 1.e0 - zmsk(ji,jj) ),   & 
    581                &             paft(ji,jj) * zmsk(ji,jj) - zbig * ( 1.e0 - zmsk(ji,jj) )  ) 
    582             zbdo(ji,jj) = MIN( pbef(ji,jj) * zmsk(ji,jj) + zbig * ( 1.e0 - zmsk(ji,jj) ),   & 
    583                &             paft(ji,jj) * zmsk(ji,jj) + zbig * ( 1.e0 - zmsk(ji,jj) )  ) 
    584          END DO 
    585       END DO 
    586  
    587 !$OMP DO schedule(static) private(jj,ji,zup,zdo,zpos,zneg,zbt) 
    588541      DO jj = 2, jpjm1 
    589542         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    604557         END DO 
    605558      END DO 
    606 !$OMP END PARALLEL 
    607559      CALL lbc_lnk_multi( zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
    608560 
    609561      ! monotonic flux in the i & j direction (paa & pbb) 
    610562      ! ------------------------------------- 
    611 !$OMP PARALLEL DO schedule(static) private(jj,ji,zau,zbu,zcu,zav,zbv,zcv) 
    612563      DO jj = 2, jpjm1 
    613564         DO ji = fs_2, fs_jpim1   ! vector opt. 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90

    r7698 r7753  
    5858      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    5959      !! 
    60       INTEGER  :: ji, jj, jl, jk ! dummy loop indices 
     60      INTEGER  :: jl, jk ! dummy loop indices 
    6161      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    6262     !!--------------------------------------------------------------------- 
    … …  
    6969      IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limdyn', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 
    7070       
    71 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    72       DO jj = 1, jpj 
    73          DO ji = 1, jpi 
    74             ! ice velocities before rheology 
    75             u_ice_b(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) 
    76             v_ice_b(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
     71      ! ice velocities before rheology 
     72      u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 
     73      v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 
    7774       
    78             ! Landfast ice parameterization: define max bottom friction 
    79             tau_icebfr(ji,jj) = 0._wp 
    80          END DO 
    81       END DO 
     75      ! Landfast ice parameterization: define max bottom friction 
     76      tau_icebfr(:,:) = 0._wp 
    8277      IF( ln_landfast ) THEN 
    8378         DO jl = 1, jpl 
    84 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    85             DO jj = 1, jpj 
    86                DO ji = 1, jpi 
    87                   IF( ht_i(ji,jj,jl) > ht_n(ji,jj) * rn_gamma )  tau_icebfr(ji,jj) = tau_icebfr(ji,jj) + a_i(ji,jj,jl) * rn_icebfr 
    88                END DO 
    89             END DO 
     79            WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma )  tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 
    9080         END DO 
    9181      ENDIF 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90

    r7698 r7753  
    254254 
    255255      CASE( 0 ) 
    256 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    257          DO jj = 1, jpj 
    258             DO ji = 1, jpi 
    259                ahiu(ji,jj) = rn_ahi0_ref 
    260                ahiv(ji,jj) = rn_ahi0_ref 
    261             END DO 
    262          END DO 
     256         ahiu(:,:) = rn_ahi0_ref 
     257         ahiv(:,:) = rn_ahi0_ref 
    263258 
    264259         IF(lwp) WRITE(numout,*) '' 
    … …  
    270265         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain 
    271266          
    272 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    273          DO jj = 1, jpj 
    274             DO ji = 1, jpi 
    275                ahiu(ji,jj) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
     267         ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
    276268                                                        !                    (60deg = min latitude for ice cover)   
    277                ahiv(ji,jj) = rn_ahi0_ref * zd_max * 1.e-05_wp 
    278             END DO 
    279          END DO 
     269         ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 
    280270 
    281271         IF(lwp) WRITE(numout,*) '' 
    … …  
    290280         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
    291281                                                 !                    (60deg = min latitude for ice cover)   
    292 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    293282         DO jj = 1, jpj 
    294283            DO ji = 1, jpi 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r7698 r7753  
    8686      REAL(wp), POINTER, DIMENSION(:,:)   :: zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini !data from namelist or nc file 
    8787      REAL(wp), POINTER, DIMENSION(:,:,:) :: zh_i_ini, za_i_ini                         !data by cattegories to fill 
    88       INTEGER , DIMENSION(4)     :: itest 
     88      INTEGER , POINTER, DIMENSION(:)     :: itest 
    8989      !-------------------------------------------------------------------- 
    9090 
    … …  
    9292      CALL wrk_alloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    9393      CALL wrk_alloc( jpi, jpj,      zswitch ) 
     94      Call wrk_alloc( 4,             itest ) 
    9495 
    9596      IF(lwp) WRITE(numout,*) 
    … …  
    105106      ! init surface temperature 
    106107      DO jl = 1, jpl 
    107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    108          DO jj = 1, jpj 
    109             DO ji = 1, jpi 
    110                t_su  (ji,jj,jl) = rt0 * tmask(ji,jj,1) 
    111                tn_ice(ji,jj,jl) = rt0 * tmask(ji,jj,1) 
    112             END DO 
    113          END DO 
     108         t_su  (:,:,jl) = rt0 * tmask(:,:,1) 
     109         tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 
    114110      END DO 
    115111 
    116112      ! init basal temperature (considered at freezing point) 
    117113      CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
    118 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    119       DO jj = 1, jpj 
    120          DO ji = 1, jpi 
    121             t_bo(ji,jj) = ( t_bo(ji,jj) + rt0 ) * tmask(ji,jj,1)  
    122          END DO 
    123       END DO 
     114      t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
    124115 
    125116 
    … …  
    131122         IF( ln_limini_file )THEN 
    132123         ! 
    133 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    134             DO jj = 1, jpj 
    135                DO ji = 1, jpi 
    136                   zht_i_ini(ji,jj)  = si(jp_hti)%fnow(ji,jj,1) 
    137                   zht_s_ini(ji,jj)  = si(jp_hts)%fnow(ji,jj,1) 
    138                   zat_i_ini(ji,jj)  = si(jp_ati)%fnow(ji,jj,1) 
    139                   zts_u_ini(ji,jj)  = si(jp_tsu)%fnow(ji,jj,1) 
    140                   ztm_i_ini(ji,jj)  = si(jp_tmi)%fnow(ji,jj,1) 
    141                   zsm_i_ini(ji,jj)  = si(jp_smi)%fnow(ji,jj,1) 
    142                   ! 
    143                   IF  ( zat_i_ini(ji,jj) > 0._wp ) THEN ; zswitch(ji,jj) = tmask(ji,jj,1)  
    144                   ELSE                                ; zswitch(ji,jj) = 0._wp 
    145                   END IF 
    146                END DO 
    147             END DO 
    148          ! 
     124            zht_i_ini(:,:)  = si(jp_hti)%fnow(:,:,1) 
     125            zht_s_ini(:,:)  = si(jp_hts)%fnow(:,:,1) 
     126            zat_i_ini(:,:)  = si(jp_ati)%fnow(:,:,1) 
     127            zts_u_ini(:,:)  = si(jp_tsu)%fnow(:,:,1) 
     128            ztm_i_ini(:,:)  = si(jp_tmi)%fnow(:,:,1) 
     129            zsm_i_ini(:,:)  = si(jp_smi)%fnow(:,:,1) 
     130            ! 
     131            WHERE( zat_i_ini(:,:) > 0._wp ) ; zswitch(:,:) = tmask(:,:,1)  
     132            ELSEWHERE                       ; zswitch(:,:) = 0._wp 
     133            END WHERE 
     134            ! 
    149135         ELSE ! ln_limini_file = F 
    150136 
    … …  
    153139            !-------------------------------------------------------------------- 
    154140            ! no ice if sst <= t-freez + ttest 
    155 !$OMP PARALLEL 
    156 !$OMP DO schedule(static) private(jj,ji) 
    157             DO jj = 1, jpj 
    158                DO ji = 1, jpi 
    159                   IF ( ( sst_m(ji,jj) - (t_bo(ji,jj) - rt0) ) * tmask(ji,jj,1) >= rn_thres_sst ) THEN 
    160                      zswitch(ji,jj) = 0._wp  
    161                   ELSE 
    162                      zswitch(ji,jj) = tmask(ji,jj,1) 
    163                   END IF 
    164                END DO 
    165             END DO 
     141            WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp  
     142            ELSEWHERE                                                                  ; zswitch(:,:) = tmask(:,:,1) 
     143            END WHERE 
    166144 
    167145            !----------------------------- 
    … …  
    169147            !----------------------------- 
    170148            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
    171 !$OMP DO schedule(static) private(jj,ji) 
    172149            DO jj = 1, jpj 
    173150               DO ji = 1, jpi 
    … …  
    189166               END DO 
    190167            END DO 
    191 !$OMP END PARALLEL 
    192168            ! 
    193169         ENDIF ! ln_limini_file 
    194170          
    195 !$OMP PARALLEL 
    196 !$OMP DO schedule(static) private(jj,ji) 
    197          DO jj = 1, jpj 
    198             DO ji = 1, jpi 
    199                zvt_i_ini(ji,jj) = zht_i_ini(ji,jj) * zat_i_ini(ji,jj)   ! ice volume 
    200             END DO 
    201          END DO 
     171         zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)   ! ice volume 
    202172         !--------------------------------------------------------------------- 
    203173         ! 3.2) Distribute ice concentration and thickness into the categories 
    … …  
    206176         ! then we check whether the distribution fullfills 
    207177         ! volume and area conservation, positivity and ice categories bounds 
    208          DO jl = 1, jpl 
    209 !$OMP DO schedule(static) private(jj,ji) 
    210             DO jj = 1, jpj 
    211                DO ji = 1, jpi 
    212                   zh_i_ini(ji,jj,jl) = 0._wp  
    213                   za_i_ini(ji,jj,jl) = 0._wp 
    214                END DO 
    215             END DO 
    216          END DO 
     178         zh_i_ini(:,:,:) = 0._wp  
     179         za_i_ini(:,:,:) = 0._wp 
    217180         ! 
    218 !$OMP DO schedule(static) private(jj,ji,jl0,jl,i_fill,zarg,zV,zdv,zconv,itest) 
    219181         DO jj = 1, jpj 
    220182            DO ji = 1, jpi 
    … …  
    327289            END DO    
    328290         END DO    
    329 !$OMP END PARALLEL 
    330291 
    331292         !--------------------------------------------------------------------- 
    … …  
    335296         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 
    336297         DO jl = 1, jpl ! loop over categories 
    337 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    338298            DO jj = 1, jpj 
    339299               DO ji = 1, jpi 
    … …  
    373333         ENDIF 
    374334             
    375 !$OMP PARALLEL 
    376335         ! Snow temperature and heat content 
    377336         DO jk = 1, nlay_s 
    378337            DO jl = 1, jpl ! loop over categories 
    379 !$OMP DO schedule(static) private(jj,ji) 
    380338               DO jj = 1, jpj 
    381339                  DO ji = 1, jpi 
    … …  
    394352         DO jk = 1, nlay_i 
    395353            DO jl = 1, jpl ! loop over categories 
    396 !$OMP DO schedule(static) private(jj,ji) 
    397354               DO jj = 1, jpj 
    398355                  DO ji = 1, jpi 
    … …  
    413370         END DO 
    414371 
     372         tn_ice (:,:,:) = t_su (:,:,:) 
     373 
     374      ELSE ! if ln_limini=false 
     375         a_i  (:,:,:) = 0._wp 
     376         v_i  (:,:,:) = 0._wp 
     377         v_s  (:,:,:) = 0._wp 
     378         smv_i(:,:,:) = 0._wp 
     379         oa_i (:,:,:) = 0._wp 
     380         ht_i (:,:,:) = 0._wp 
     381         ht_s (:,:,:) = 0._wp 
     382         sm_i (:,:,:) = 0._wp 
     383         o_i  (:,:,:) = 0._wp 
     384 
     385         e_i(:,:,:,:) = 0._wp 
     386         e_s(:,:,:,:) = 0._wp 
     387 
    415388         DO jl = 1, jpl 
    416 !$OMP DO schedule(static) private(jj,ji) 
    417             DO jj = 1, jpj 
    418                DO ji = 1, jpi 
    419                   tn_ice (ji,jj,jl) = t_su (ji,jj,jl) 
    420                END DO 
     389            DO jk = 1, nlay_i 
     390               t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 
     391            END DO 
     392            DO jk = 1, nlay_s 
     393               t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    421394            END DO 
    422395         END DO 
    423 !$OMP END PARALLEL 
    424  
    425       ELSE ! if ln_limini=false 
    426 !$OMP PARALLEL 
    427          DO jl = 1, jpl 
    428 !$OMP DO schedule(static) private(jj,ji) 
    429             DO jj = 1, jpj 
    430                DO ji = 1, jpi 
    431                   a_i  (ji,jj,jl) = 0._wp 
    432                   v_i  (ji,jj,jl) = 0._wp 
    433                   v_s  (ji,jj,jl) = 0._wp 
    434                   smv_i(ji,jj,jl) = 0._wp 
    435                   oa_i (ji,jj,jl) = 0._wp 
    436                   ht_i (ji,jj,jl) = 0._wp 
    437                   ht_s (ji,jj,jl) = 0._wp 
    438                   sm_i (ji,jj,jl) = 0._wp 
    439                   o_i  (ji,jj,jl) = 0._wp 
    440                END DO 
    441             END DO 
    442          END DO 
    443  
    444          DO jk = 1, nlay_i 
    445             DO jl = 1, jpl 
    446 !$OMP DO schedule(static) private(jj,ji) 
    447                DO jj = 1, jpj 
    448                   DO ji = 1, jpi 
    449                      e_i(ji,jj,jl,jk) = 0._wp 
    450                   END DO 
    451                END DO 
    452             END DO 
    453          END DO 
    454          DO jk = 1, nlay_s 
    455             DO jl = 1, jpl 
    456 !$OMP DO schedule(static) private(jj,ji) 
    457                DO jj = 1, jpj 
    458                   DO ji = 1, jpi 
    459                      e_s(ji,jj,jl,jk) = 0._wp 
    460                   END DO 
    461                END DO 
    462             END DO 
    463          END DO 
    464  
    465          DO jl = 1, jpl 
    466             DO jk = 1, nlay_i 
    467 !$OMP DO schedule(static) private(jj,ji) 
    468                DO jj = 1, jpj 
    469                   DO ji = 1, jpi 
    470                      t_i(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) 
    471                   END DO 
    472                END DO 
    473             END DO 
    474             DO jk = 1, nlay_s 
    475 !$OMP DO schedule(static) private(jj,ji) 
    476                DO jj = 1, jpj 
    477                   DO ji = 1, jpi 
    478                      t_s(ji,jj,jk,jl) = rt0 * tmask(ji,jj,1) 
    479                   END DO 
    480                END DO 
    481             END DO 
    482          END DO 
    483 !$OMP END PARALLEL 
    484396 
    485397      ENDIF ! ln_limini 
    486398       
    487 !$OMP PARALLEL 
    488 !$OMP DO schedule(static) private(jj,ji) 
    489       DO jj = 1, jpj 
    490          DO ji = 1, jpi 
    491             at_i (ji,jj) = 0.0_wp 
    492          END DO 
    493       END DO 
     399      at_i (:,:) = 0.0_wp 
    494400      DO jl = 1, jpl 
    495 !$OMP DO schedule(static) private(jj,ji) 
    496          DO jj = 1, jpj 
    497             DO ji = 1, jpi 
    498                at_i (ji,jj) = at_i (ji,jj) + a_i (ji,jj,jl) 
    499             END DO 
    500          END DO 
     401         at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
    501402      END DO 
    502403      ! 
    503 !$OMP DO schedule(static) private(jj,ji) 
    504       DO jj = 1, jpj 
    505          DO ji = 1, jpi 
    506             !-------------------------------------------------------------------- 
    507             ! 4) Global ice variables for output diagnostics                    |  
    508             !-------------------------------------------------------------------- 
    509             u_ice (ji,jj)     = 0._wp 
    510             v_ice (ji,jj)     = 0._wp 
    511             stress1_i(ji,jj)  = 0._wp 
    512             stress2_i(ji,jj)  = 0._wp 
    513             stress12_i(ji,jj) = 0._wp 
    514  
    515             !-------------------------------------------------------------------- 
    516             ! 5) Moments for advection 
    517             !-------------------------------------------------------------------- 
    518  
    519             sxopw (ji,jj) = 0._wp  
    520             syopw (ji,jj) = 0._wp  
    521             sxxopw(ji,jj) = 0._wp  
    522             syyopw(ji,jj) = 0._wp  
    523             sxyopw(ji,jj) = 0._wp 
    524          END DO 
    525       END DO 
    526  
    527       DO jl = 1, jpl 
    528 !$OMP DO schedule(static) private(jj,ji) 
    529          DO jj = 1, jpj 
    530             DO ji = 1, jpi 
    531                sxice (ji,jj,jl)  = 0._wp   ;   sxsn (ji,jj,jl)  = 0._wp   ;   sxa  (ji,jj,jl)  = 0._wp 
    532                syice (ji,jj,jl)  = 0._wp   ;   sysn (ji,jj,jl)  = 0._wp   ;   sya  (ji,jj,jl)  = 0._wp 
    533                sxxice(ji,jj,jl)  = 0._wp   ;   sxxsn(ji,jj,jl)  = 0._wp   ;   sxxa (ji,jj,jl)  = 0._wp 
    534                syyice(ji,jj,jl)  = 0._wp   ;   syysn(ji,jj,jl)  = 0._wp   ;   syya (ji,jj,jl)  = 0._wp 
    535                sxyice(ji,jj,jl)  = 0._wp   ;   sxysn(ji,jj,jl)  = 0._wp   ;   sxya (ji,jj,jl)  = 0._wp 
    536  
    537                sxc0  (ji,jj,jl)  = 0._wp    
    538                syc0  (ji,jj,jl)  = 0._wp    
    539                sxxc0 (ji,jj,jl)  = 0._wp    
    540                syyc0 (ji,jj,jl)  = 0._wp    
    541                sxyc0 (ji,jj,jl)  = 0._wp    
    542  
    543                sxsal  (ji,jj,jl)  = 0._wp 
    544                sysal  (ji,jj,jl)  = 0._wp 
    545                sxxsal (ji,jj,jl)  = 0._wp 
    546                syysal (ji,jj,jl)  = 0._wp 
    547                sxysal (ji,jj,jl)  = 0._wp 
    548  
    549                sxage  (ji,jj,jl)  = 0._wp 
    550                syage  (ji,jj,jl)  = 0._wp 
    551                sxxage (ji,jj,jl)  = 0._wp 
    552                syyage (ji,jj,jl)  = 0._wp 
    553                sxyage (ji,jj,jl)  = 0._wp 
    554             END DO 
    555          END DO 
    556       END DO 
    557  
    558       DO jl = 1, jpl 
    559          DO jk = 1, nlay_i 
    560 !$OMP DO schedule(static) private(jj,ji) 
    561             DO jj = 1, jpj 
    562                DO ji = 1, jpi 
    563                   sxe  (ji,jj,jk,jl)= 0._wp 
    564                   sye  (ji,jj,jk,jl)= 0._wp 
    565                   sxxe (ji,jj,jk,jl)= 0._wp 
    566                   syye (ji,jj,jk,jl)= 0._wp 
    567                   sxye (ji,jj,jk,jl)= 0._wp 
    568                END DO 
    569             END DO 
    570          END DO 
    571       END DO 
    572 !$OMP END PARALLEL 
    573  
     404      !-------------------------------------------------------------------- 
     405      ! 4) Global ice variables for output diagnostics                    |  
     406      !-------------------------------------------------------------------- 
     407      u_ice (:,:)     = 0._wp 
     408      v_ice (:,:)     = 0._wp 
     409      stress1_i(:,:)  = 0._wp 
     410      stress2_i(:,:)  = 0._wp 
     411      stress12_i(:,:) = 0._wp 
     412 
     413      !-------------------------------------------------------------------- 
     414      ! 5) Moments for advection 
     415      !-------------------------------------------------------------------- 
     416 
     417      sxopw (:,:) = 0._wp  
     418      syopw (:,:) = 0._wp  
     419      sxxopw(:,:) = 0._wp  
     420      syyopw(:,:) = 0._wp  
     421      sxyopw(:,:) = 0._wp 
     422 
     423      sxice (:,:,:)  = 0._wp   ;   sxsn (:,:,:)  = 0._wp   ;   sxa  (:,:,:)  = 0._wp 
     424      syice (:,:,:)  = 0._wp   ;   sysn (:,:,:)  = 0._wp   ;   sya  (:,:,:)  = 0._wp 
     425      sxxice(:,:,:)  = 0._wp   ;   sxxsn(:,:,:)  = 0._wp   ;   sxxa (:,:,:)  = 0._wp 
     426      syyice(:,:,:)  = 0._wp   ;   syysn(:,:,:)  = 0._wp   ;   syya (:,:,:)  = 0._wp 
     427      sxyice(:,:,:)  = 0._wp   ;   sxysn(:,:,:)  = 0._wp   ;   sxya (:,:,:)  = 0._wp 
     428 
     429      sxc0  (:,:,:)  = 0._wp   ;   sxe  (:,:,:,:)= 0._wp    
     430      syc0  (:,:,:)  = 0._wp   ;   sye  (:,:,:,:)= 0._wp    
     431      sxxc0 (:,:,:)  = 0._wp   ;   sxxe (:,:,:,:)= 0._wp    
     432      syyc0 (:,:,:)  = 0._wp   ;   syye (:,:,:,:)= 0._wp    
     433      sxyc0 (:,:,:)  = 0._wp   ;   sxye (:,:,:,:)= 0._wp    
     434 
     435      sxsal  (:,:,:)  = 0._wp 
     436      sysal  (:,:,:)  = 0._wp 
     437      sxxsal (:,:,:)  = 0._wp 
     438      syysal (:,:,:)  = 0._wp 
     439      sxysal (:,:,:)  = 0._wp 
     440 
     441      sxage  (:,:,:)  = 0._wp 
     442      syage  (:,:,:)  = 0._wp 
     443      sxxage (:,:,:)  = 0._wp 
     444      syyage (:,:,:)  = 0._wp 
     445      sxyage (:,:,:)  = 0._wp 
    574446 
    575447!!!clem 
    … …  
    581453      CALL wrk_dealloc( jpi, jpj,      zht_i_ini, zat_i_ini, zvt_i_ini, zts_u_ini, zht_s_ini, zsm_i_ini, ztm_i_ini ) 
    582454      CALL wrk_dealloc( jpi, jpj,      zswitch ) 
     455      Call wrk_dealloc( 4,             itest ) 
    583456 
    584457   END SUBROUTINE lim_istate 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90

    r7698 r7753  
    115115      REAL(wp), POINTER, DIMENSION(:,:)   ::   opning          ! rate of opening due to divergence/shear 
    116116      REAL(wp), POINTER, DIMENSION(:,:)   ::   closing_gross   ! rate at which area removed, not counting area of new ridges 
    117       REAL(wp), POINTER, DIMENSION(:,:)   ::   z_ai 
    118117      ! 
    119118      INTEGER, PARAMETER ::   nitermax = 20     
    … …  
    123122      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    124123 
    125       CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, z_ai ) 
     124      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 
    126125 
    127126      ! conservation test 
    … …  
    136135      ! 
    137136 
    138 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    139137      DO jj = 1, jpj                                     ! Initialize arrays. 
    140138         DO ji = 1, jpi 
    … …  
    194192         !  closing rate to a gross closing rate.   
    195193         ! NOTE: 0 < aksum <= 1 
    196 !$OMP PARALLEL 
    197 !$OMP DO schedule(static) private(jj,ji) 
    198          DO jj = 1, jpj 
    199             DO ji = 1, jpi 
    200                closing_gross(ji,jj) = closing_net(ji,jj) / aksum(ji,jj) 
    201             END DO 
    202          END DO 
     194         closing_gross(:,:) = closing_net(:,:) / aksum(:,:) 
    203195 
    204196         ! correction to closing rate and opening if closing rate is excessive 
    … …  
    206198         ! Reduce the closing rate if more than 100% of the open water  
    207199         ! would be removed.  Reduce the opening rate proportionately. 
    208 !$OMP DO schedule(static) private(jj,ji,za,zfac) 
    209200         DO jj = 1, jpj 
    210201            DO ji = 1, jpi 
    … …  
    225216         ! would be removed.  Reduce the opening rate proportionately. 
    226217         DO jl = 1, jpl 
    227 !$OMP DO schedule(static) private(jj,ji,za,zfac) 
    228218            DO jj = 1, jpj 
    229219               DO ji = 1, jpi 
    … …  
    236226            END DO 
    237227         END DO 
    238 !$OMP END PARALLEL 
    239228 
    240229         ! 3.3 Redistribute area, volume, and energy. 
    … …  
    247236         !-----------------------------------------------------------------------------! 
    248237         ! This is in general not equal to one because of divergence during transport 
    249 !$OMP PARALLEL 
    250 !$OMP DO schedule(static) private(jj,ji) 
    251          DO jj = 1, jpj 
    252             DO ji = 1, jpi 
    253                asum(ji,jj) = 0._wp 
    254                z_ai(ji,jj) = 0._wp 
    255             END DO 
    256          END DO 
    257          DO jl = 1, jpl 
    258 !$OMP DO schedule(static) private(jj,ji) 
    259             DO jj = 1, jpj 
    260                DO ji = 1, jpi 
    261                   z_ai(ji,jj) = z_ai(ji,jj) + a_i(ji,jj,jl) 
    262                END DO 
    263             END DO 
    264          END DO 
    265 !$OMP DO schedule(static) private(jj,ji) 
    266          DO jj = 1, jpj 
    267             DO ji = 1, jpi 
    268                asum(ji,jj) = ato_i(ji,jj) + z_ai(ji,jj) 
    269             END DO 
    270          END DO 
     238         asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 
    271239 
    272240         ! 3.5 Do we keep on iterating ??? 
    … …  
    276244 
    277245         iterate_ridging = 0 
    278 !$OMP DO schedule(static) private(jj,ji) 
    279246         DO jj = 1, jpj 
    280247            DO ji = 1, jpi 
    … …  
    291258            END DO 
    292259         END DO 
    293 !$OMP END PARALLEL 
    294260 
    295261         IF( lk_mpp )   CALL mpp_max( iterate_ridging ) 
    … …  
    323289      IF( ln_ctl )       CALL lim_prt3D( 'limitd_me' ) 
    324290 
    325       CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, z_ai ) 
     291      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 
    326292      ! 
    327293      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
    … …  
    340306      REAL(wp) ::   Gstari, astari, hrmean, zdummy   ! local scalar 
    341307      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n 
    342       REAL(wp), POINTER, DIMENSION(:,:) ::   z_ai 
    343308      !------------------------------------------------------------------------------! 
    344309 
    345310      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    346       CALL wrk_alloc( jpi,jpj,z_ai ) 
    347311 
    348312      Gstari     = 1.0/rn_gstar     
    349313      astari     = 1.0/rn_astar     
    350 !$OMP PARALLEL 
    351 !$OMP DO schedule(static) private(jj,ji) 
    352       DO jj = 1, jpj 
    353          DO ji = 1, jpi 
    354             aksum(ji,jj)    = 0.0 
    355          END DO 
    356       END DO 
    357 !$OMP END DO NOWAIT 
    358       DO jl = 1, jpl 
    359 !$OMP DO schedule(static) private(jj,ji) 
    360          DO jj = 1, jpj 
    361             DO ji = 1, jpi 
    362                athorn(ji,jj,jl) = 0.0 
    363                aridge(ji,jj,jl) = 0.0 
    364                araft (ji,jj,jl) = 0.0 
    365             END DO 
    366          END DO 
    367       END DO 
    368 !$OMP END PARALLEL 
     314      aksum(:,:)    = 0.0 
     315      athorn(:,:,:) = 0.0 
     316      aridge(:,:,:) = 0.0 
     317      araft (:,:,:) = 0.0 
    369318 
    370319      ! Zero out categories with very small areas 
    371320      CALL lim_var_zapsmall 
    372321 
    373 !$OMP PARALLEL 
    374322      ! Ice thickness needed for rafting 
    375323      DO jl = 1, jpl 
    376 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    377324         DO jj = 1, jpj 
    378325            DO ji = 1, jpi 
    … …  
    389336      ! Compute total area of ice plus open water. 
    390337      ! This is in general not equal to one because of divergence during transport 
    391  
    392 !$OMP DO schedule(static) private(jj,ji) 
    393          DO jj = 1, jpj 
    394             DO ji = 1, jpi 
    395                asum(ji,jj) = 0._wp 
    396                z_ai(ji,jj) = 0._wp 
    397             END DO 
    398          END DO 
    399          DO jl = 1, jpl 
    400 !$OMP DO schedule(static) private(jj,ji) 
    401             DO jj = 1, jpj 
    402                DO ji = 1, jpi 
    403                   z_ai(ji,jj) = z_ai(ji,jj) + a_i(ji,jj,jl) 
    404                END DO 
    405             END DO 
    406          END DO 
    407 !$OMP DO schedule(static) private(jj,ji) 
    408          DO jj = 1, jpj 
    409             DO ji = 1, jpi 
    410                asum(ji,jj) = ato_i(ji,jj) + z_ai(ji,jj) 
    411             END DO 
    412          END DO 
     338      asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 
     339 
    413340      ! Compute cumulative thickness distribution function 
    414341      ! Compute the cumulative thickness distribution function Gsum, 
    415342      ! where Gsum(n) is the fractional area in categories 0 to n. 
    416343      ! initial value (in h = 0) equals open water area 
    417 !$OMP DO schedule(static) private(jj,ji) 
    418       DO jj = 1, jpj 
    419          DO ji = 1, jpi 
    420             Gsum(ji,jj,-1) = 0._wp 
    421             Gsum(ji,jj,0 ) = ato_i(ji,jj) 
    422          END DO 
    423       END DO 
     344      Gsum(:,:,-1) = 0._wp 
     345      Gsum(:,:,0 ) = ato_i(:,:) 
    424346      ! for each value of h, you have to add ice concentration then 
    425347      DO jl = 1, jpl 
    426 !$OMP DO schedule(static) private(jj,ji) 
    427          DO jj = 1, jpj 
    428             DO ji = 1, jpi 
    429                Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 
    430             END DO 
    431          END DO 
     348         Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
    432349      END DO 
    433350 
    434351      ! Normalize the cumulative distribution to 1 
    435352      DO jl = 0, jpl 
    436 !$OMP DO schedule(static) private(jj,ji) 
    437          DO jj = 1, jpj 
    438             DO ji = 1, jpi 
    439                Gsum(ji,jj,jl) = Gsum(ji,jj,jl) / asum(ji,jj) 
    440             END DO 
    441          END DO 
     353         Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:) 
    442354      END DO 
    443 !$OMP END PARALLEL 
    444355 
    445356      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) 
    … …  
    458369      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    459370         DO jl = 0, jpl     
    460 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    461371            DO jj = 1, jpj  
    462372               DO ji = 1, jpi 
    … …  
    477387         !                         
    478388         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array 
    479 !$OMP PARALLEL 
    480389         DO jl = -1, jpl 
    481 !$OMP DO schedule(static) private(jj,ji) 
    482             DO jj = 1, jpj  
    483                DO ji = 1, jpi 
    484                   Gsum(ji,jj,jl) = EXP( -Gsum(ji,jj,jl) * astari ) * zdummy 
    485                END DO 
    486             END DO 
     390            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 
    487391         END DO 
    488392         DO jl = 0, jpl 
    489 !$OMP DO schedule(static) private(jj,ji) 
    490             DO jj = 1, jpj  
    491                DO ji = 1, jpi 
    492                   athorn(ji,jj,jl) = Gsum(ji,jj,jl-1) - Gsum(ji,jj,jl) 
    493                END DO 
    494             END DO 
    495          END DO 
    496 !$OMP END PARALLEL 
     393             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 
     394         END DO 
    497395         ! 
    498396      ENDIF 
    … …  
    502400         ! 
    503401         DO jl = 1, jpl 
    504 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdummy) 
    505402            DO jj = 1, jpj  
    506403               DO ji = 1, jpi 
    … …  
    515412         ! 
    516413         DO jl = 1, jpl 
    517 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    518             DO jj = 1, jpj  
    519                DO ji = 1, jpi 
    520                   aridge(ji,jj,jl) = athorn(ji,jj,jl) 
    521                END DO 
    522             END DO 
     414            aridge(:,:,jl) = athorn(:,:,jl) 
    523415         END DO 
    524416         ! 
    … …  
    526418         ! 
    527419         DO jl = 1, jpl 
    528 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    529             DO jj = 1, jpj  
    530                DO ji = 1, jpi 
    531                   araft(ji,jj,jl) = athorn(ji,jj,jl) 
    532                END DO 
    533             END DO 
     420            araft(:,:,jl) = athorn(:,:,jl) 
    534421         END DO 
    535422         ! 
    … …  
    562449      !----------------------------------------------------------------- 
    563450 
    564 !$OMP PARALLEL 
    565 !$OMP DO schedule(static) private(jj,ji) 
    566       DO jj = 1, jpj  
    567          DO ji = 1, jpi 
    568             aksum(ji,jj) = athorn(ji,jj,0) 
    569          END DO 
    570       END DO 
     451      aksum(:,:) = athorn(:,:,0) 
    571452      ! Transfer function 
    572453      DO jl = 1, jpl !all categories have a specific transfer function 
    573 !$OMP DO schedule(static) private(jj,ji,hrmean) 
    574454         DO jj = 1, jpj 
    575455            DO ji = 1, jpi 
    … …  
    596476         END DO 
    597477      END DO 
    598 !$OMP END PARALLEL 
    599478      ! 
    600479      CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
    601       CALL wrk_dealloc( jpi,jpj,z_ai ) 
    602480      ! 
    603481   END SUBROUTINE lim_itd_me_ridgeprep 
    … …  
    661539      ! 1) Compute change in open water area due to closing and opening. 
    662540      !------------------------------------------------------------------------------- 
    663 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    664541      DO jj = 1, jpj 
    665542         DO ji = 1, jpi 
    … …  
    691568         END DO 
    692569 
    693 !$OMP PARALLEL 
    694 !$OMP DO schedule(static) private(ij,jj,ji) 
    695570         DO ij = 1, icells 
    696571            ji = indxi(ij) ; jj = indxj(ij) 
    … …  
    785660         !-------------------------------------------------------------------- 
    786661         DO jk = 1, nlay_i 
    787 !$OMP DO schedule(static) private(ij,jj,ji) 
    788662            DO ij = 1, icells 
    789663               ji = indxi(ij) ; jj = indxj(ij) 
    … …  
    813687         DO jl2  = 1, jpl  
    814688            ! over categories to which ridged/rafted ice is transferred 
    815 !$OMP DO schedule(static) private(ij,jj,ji,hL,hR,farea) 
    816689            DO ij = 1, icells 
    817690               ji = indxi(ij) ; jj = indxj(ij) 
    … …  
    848721            ! Transfer ice energy to category jl2 by ridging 
    849722            DO jk = 1, nlay_i 
    850 !$OMP DO schedule(static) private(ij,jj,ji) 
    851723               DO ij = 1, icells 
    852724                  ji = indxi(ij) ; jj = indxj(ij) 
    … …  
    856728            ! 
    857729         END DO ! jl2 
    858 !$OMP END PARALLEL 
    859730          
    860731      END DO ! jl1 (deforming categories) 
     732 
    861733      ! 
    862734      CALL wrk_dealloc( jpij,        indxi, indxj ) 
    … …  
    897769      ! 1) Initialize 
    898770      !------------------------------------------------------------------------------! 
    899 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    900       DO jj = 1, jpj 
    901          DO ji = 1, jpi 
    902             strength(ji,jj) = 0._wp 
    903          END DO 
    904       END DO 
     771      strength(:,:) = 0._wp 
    905772 
    906773      !------------------------------------------------------------------------------! 
    … …  
    914781      IF( kstrngth == 1 ) THEN 
    915782         z1_3 = 1._wp / 3._wp 
    916 !$OMP PARALLEL 
    917783         DO jl = 1, jpl 
    918 !$OMP DO schedule(static) private(jj,ji) 
    919784            DO jj= 1, jpj 
    920785               DO ji = 1, jpi 
    … …  
    945810         END DO 
    946811    
    947 !$OMP DO schedule(static) private(jj,ji) 
    948          DO jj= 1, jpj 
    949             DO ji = 1, jpi 
    950                strength(ji,jj) = rn_pe_rdg * Cp * strength(ji,jj) / aksum(ji,jj) * tmask(ji,jj,1) 
    951             END DO 
    952          END DO 
    953 !$OMP END PARALLEL 
     812         strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1) 
    954813                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 
    955814         ksmooth = 1 
    … …  
    959818      !------------------------------------------------------------------------------! 
    960819      ELSE                      ! kstrngth ne 1:  Hibler (1979) form 
    961 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    962          DO jj= 1, jpj 
    963             DO ji = 1, jpi 
    964                ! 
    965                strength(ji,jj) = rn_pstar * vt_i(ji,jj) * EXP( - rn_crhg * ( 1._wp - at_i(ji,jj) )  ) * tmask(ji,jj,1) 
    966             END DO 
    967          END DO 
     820         ! 
     821         strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) * tmask(:,:,1) 
    968822         ! 
    969823         ksmooth = 1 
    … …  
    976830      ! CAN BE REMOVED 
    977831      IF( ln_icestr_bvf ) THEN 
    978 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    979832         DO jj = 1, jpj 
    980833            DO ji = 1, jpi 
    … …  
    993846      IF ( ksmooth == 1 ) THEN 
    994847 
    995 !$OMP PARALLEL 
    996 !$OMP DO schedule(static) private(jj,ji) 
    997848         DO jj = 2, jpjm1 
    998849            DO ji = 2, jpim1 
    … …  
    1008859         END DO 
    1009860 
    1010 !$OMP DO schedule(static) private(jj,ji) 
    1011861         DO jj = 2, jpjm1 
    1012862            DO ji = 2, jpim1 
    … …  
    1014864            END DO 
    1015865         END DO 
    1016 !$OMP END PARALLEL 
    1017866         CALL lbc_lnk( strength, 'T', 1. ) 
    1018867 
    … …  
    1025874 
    1026875         IF ( numit == nit000 + nn_fsbc - 1 ) THEN 
    1027 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    1028             DO jj = 1, jpj 
    1029                DO ji = 1, jpi 
    1030                   zstrp1(ji,jj) = 0._wp 
    1031                   zstrp2(ji,jj) = 0._wp 
    1032                END DO 
    1033             END DO 
     876            zstrp1(:,:) = 0._wp 
     877            zstrp2(:,:) = 0._wp 
    1034878         ENDIF 
    1035879 
    1036 !$OMP PARALLEL DO schedule(static) private(jj,ji,numts_rm,zp) 
    1037880         DO jj = 2, jpjm1 
    1038881            DO ji = 2, jpim1 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90

    r7698 r7753  
    106106         CALL lim_column_sum (jpl,   v_s, vt_s_init) 
    107107         CALL lim_column_sum_energy (jpl, nlay_i,   e_i, et_i_init) 
    108          DO jl = 1, jpl 
    109 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    110             DO jj = 1, jpj 
    111                DO ji = 1, jpi 
    112                   dummy_es(ji,jj,jl) = e_s(ji,jj,1,jl) 
    113                END DO 
    114             END DO 
    115          END DO 
     108         dummy_es(:,:,:) = e_s(:,:,1,:) 
    116109         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_init) 
    117110      ENDIF 
    … …  
    128121      ENDIF 
    129122 
    130 !$OMP PARALLEL 
    131       DO jl = 1, jpl 
    132 !$OMP DO schedule(static) private(jj,ji) 
    133          DO jj = 1, jpj 
    134             DO ji = 1, jpi 
    135                zdhice(ji,jj,jl) = 0._wp 
    136             END DO 
    137          END DO 
    138       END DO 
     123      zdhice(:,:,:) = 0._wp 
    139124      DO jl = klbnd, kubnd 
    140 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    141125         DO jj = 1, jpj 
    142126            DO ji = 1, jpi 
    … …  
    153137      !  2) Compute fractional ice area in each grid cell 
    154138      !----------------------------------------------------------------------------------------------- 
    155 !$OMP DO schedule(static) private(jj,ji) 
    156       DO jj = 1, jpj 
    157          DO ji = 1, jpi 
    158             at_i(ji,jj) = 0._wp 
    159          END DO 
    160       END DO 
     139      at_i(:,:) = 0._wp 
    161140      DO jl = klbnd, kubnd 
    162 !$OMP DO schedule(static) private(jj,ji) 
    163          DO jj = 1, jpj 
    164             DO ji = 1, jpi 
    165                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
    166             END DO 
    167          END DO 
    168       END DO 
    169 !$OMP END PARALLEL 
     141         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     142      END DO 
    170143 
    171144      !----------------------------------------------------------------------------------------------- 
    … …  
    190163      !----------------------------------------------------------------------------------------------- 
    191164      !- 4.1 Compute category boundaries 
    192 !$OMP PARALLEL 
    193       DO jl = 0, jpl 
    194 !$OMP DO schedule(static) private(jj,ji) 
    195          DO jj = 1, jpj 
    196             DO ji = 1, jpi 
    197                zhbnew(ji,jj,jl) = 0._wp 
    198             END DO 
    199          END DO 
    200       END DO 
     165      zhbnew(:,:,:) = 0._wp 
    201166 
    202167      DO jl = klbnd, kubnd - 1 
    203 !$OMP DO schedule(static) private(ji,ii,ij,zslope) 
    204168         DO ji = 1, nbrem 
    205169            ii = nind_i(ji) 
    … …  
    219183 
    220184         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
    221 !$OMP DO schedule(static) private(ji,ii,ij) 
    222185         DO ji = 1, nbrem 
    223186            ii = nind_i(ji) 
    … …  
    242205 
    243206      END DO 
    244 !$OMP END PARALLEL 
    245207 
    246208      !----------------------------------------------------------------------------------------------- 
    … …  
    261223      !  6) Fill arrays with lowermost / uppermost boundaries of 'new' categories 
    262224      !----------------------------------------------------------------------------------------------- 
    263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    264225      DO jj = 1, jpj 
    265226         DO ji = 1, jpi 
    … …  
    293254 
    294255      !- 7.2 Area lost due to melting of thin ice (first category,  klbnd) 
    295 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij,zdh0,zetamax,zx1,zx2,zda0,zdamax) 
    296256      DO ji = 1, nbrem 
    297257         ii = nind_i(ji)  
    … …  
    339299      !----------------------------------------------------------------------------------------------- 
    340300 
    341 !$OMP PARALLEL 
    342301      DO jl = klbnd, kubnd - 1 
    343 !$OMP DO schedule(static) private(jj,ji) 
    344302         DO jj = 1, jpj 
    345303            DO ji = 1, jpi 
    … …  
    350308         END DO 
    351309 
    352 !$OMP DO schedule(static) private(ji,ii,ij,zetamax,zetamin,zx1,zwk1,zwk2,zx2,zx3,nd) 
    353310         DO ji = 1, nbrem 
    354311            ii = nind_i(ji) 
    … …  
    385342         END DO 
    386343      END DO 
    387 !$OMP END PARALLEL 
    388344 
    389345      !!---------------------------------------------------------------------------------------------- 
    … …  
    396352      !!---------------------------------------------------------------------------------------------- 
    397353 
    398 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij) 
    399354      DO ji = 1, nbrem 
    400355         ii = nind_i(ji) 
    … …  
    422377         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
    423378 
    424          DO jl = 1, jpl 
    425 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    426             DO jj = 1, jpj 
    427                DO ji = 1, jpi 
    428                   dummy_es(ji,jj,jl) = e_s(ji,jj,1,jl) 
    429                END DO 
    430             END DO 
    431          END DO 
     379         dummy_es(:,:,:) = e_s(:,:,1,:) 
    432380         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_final) 
    433381         fieldid = ' e_s : limitd_th ' 
    … …  
    473421      !!------------------------------------------------------------------ 
    474422      ! 
    475 !$OMP PARALLEL DO schedule(static) private(jj,ji,zh13,zh23,zdhr,zwk1,zwk2) 
    476423      DO jj = 1, jpj 
    477424         DO ji = 1, jpi 
    … …  
    553500 
    554501      DO jl = klbnd, kubnd 
    555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    556          DO jj = 1, jpj 
    557             DO ji = 1, jpi 
    558                zaTsfn(ji,jj,jl) = a_i(ji,jj,jl) * t_su(ji,jj,jl) 
    559             END DO 
    560          END DO 
     502         zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 
    561503      END DO 
    562504 
    … …  
    577519         END DO 
    578520 
    579 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,rswitch,zdvsnow,zdesnow,zdo_aice,zdsm_vice,zdaTsf) 
    580521         DO ji = 1, nbrem  
    581522            ii = nind_i(ji) 
    … …  
    643584 
    644585         DO jk = 1, nlay_i 
    645 !$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,zdeice) 
    646586            DO ji = 1, nbrem 
    647587               ii = nind_i(ji) 
    … …  
    668608 
    669609      DO jl = klbnd, kubnd 
    670 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    671610         DO jj = 1, jpj 
    672611            DO ji = 1, jpi  
    … …  
    724663      ! 1) Compute ice thickness. 
    725664      !------------------------------------------------------------------------------ 
    726 !$OMP PARALLEL 
    727665      DO jl = klbnd, kubnd 
    728 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    729666         DO jj = 1, jpj 
    730667            DO ji = 1, jpi  
    … …  
    743680      !------------------------- 
    744681      DO jl = klbnd, kubnd 
    745 !$OMP DO schedule(static) private(jj,ji) 
    746          DO jj = 1, jpj 
    747             DO ji = 1, jpi 
    748                zdonor(ji,jj,jl) = 0 
    749                zdaice(ji,jj,jl) = 0._wp 
    750                zdvice(ji,jj,jl) = 0._wp 
    751             END DO 
    752          END DO 
    753       END DO 
    754 !$OMP END PARALLEL 
     682         zdonor(:,:,jl) = 0 
     683         zdaice(:,:,jl) = 0._wp 
     684         zdvice(:,:,jl) = 0._wp 
     685      END DO 
    755686 
    756687      !------------------------- 
    … …  
    765696         zshiftflag = 0 
    766697 
    767 !$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag) 
    768698         DO jj = 1, jpj  
    769699            DO ji = 1, jpi  
    … …  
    786716            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    787717            ! Reset shift parameters 
    788 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    789             DO jj = 1, jpj 
    790                DO ji = 1, jpi 
    791                   zdonor(ji,jj,jl) = 0 
    792                   zdaice(ji,jj,jl) = 0._wp 
    793                   zdvice(ji,jj,jl) = 0._wp 
    794                END DO 
    795             END DO 
     718            zdonor(:,:,jl) = 0 
     719            zdaice(:,:,jl) = 0._wp 
     720            zdvice(:,:,jl) = 0._wp 
    796721         ENDIF 
    797722         ! 
    … …  
    809734         zshiftflag = 0 
    810735 
    811 !$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag) 
    812736         DO jj = 1, jpj 
    813737            DO ji = 1, jpi 
    814738               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
     739                  ! 
    815740                  zshiftflag = 1 
    816741                  zdonor(ji,jj,jl) = jl + 1 
    … …  
    826751            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    827752            ! Reset shift parameters 
    828 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    829             DO jj = 1, jpj 
    830                DO ji = 1, jpi 
    831                   zdonor(ji,jj,jl) = 0 
    832                   zdaice(ji,jj,jl) = 0._wp 
    833                   zdvice(ji,jj,jl) = 0._wp 
    834                END DO 
    835             END DO 
     753            zdonor(:,:,jl) = 0 
     754            zdaice(:,:,jl) = 0._wp 
     755            zdvice(:,:,jl) = 0._wp 
    836756         ENDIF 
    837757 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90

    r7698 r7753  
    164164      !------------------------------------------------------------------------------! 
    165165      ! ocean/land mask 
    166 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    167166      DO jj = 1, jpjm1 
    168167         DO ji = 1, jpim1      ! NO vector opt. 
    … …  
    173172 
    174173      ! Lateral boundary conditions on velocity (modify zfmask) 
    175 !$OMP PARALLEL 
    176 !$OMP DO schedule(static) private(jj, ji) 
    177       DO jj = 1, jpj 
    178          DO ji = 1, jpi 
    179             zwf(ji,jj) = zfmask(ji,jj) 
    180          END DO 
    181       END DO 
    182 !$OMP DO schedule(static) private(jj, ji) 
     174      zwf(:,:) = zfmask(:,:) 
    183175      DO jj = 2, jpjm1 
    184176         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    188180         END DO 
    189181      END DO 
    190 !$OMP DO schedule(static) private(jj) 
    191182      DO jj = 2, jpjm1 
    192183         IF( zfmask(1,jj) == 0._wp ) THEN 
    … …  
    197188         ENDIF 
    198189      END DO 
    199 !$OMP DO schedule(static) private(ji) 
    200190      DO ji = 2, jpim1 
    201191         IF( zfmask(ji,1) == 0._wp ) THEN 
    … …  
    206196         ENDIF 
    207197      END DO 
    208 !$OMP END PARALLEL 
    209198      CALL lbc_lnk( zfmask, 'F', 1._wp ) 
    210199 
    … …  
    236225 
    237226      ! Initialise stress tensor  
    238 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    239       DO jj = 1, jpj 
    240          DO ji = 1, jpi 
    241             zs1 (ji,jj) = stress1_i (ji,jj)  
    242             zs2 (ji,jj) = stress2_i (ji,jj) 
    243             zs12(ji,jj) = stress12_i(ji,jj) 
    244          END DO 
    245       END DO 
     227      zs1 (:,:) = stress1_i (:,:)  
     228      zs2 (:,:) = stress2_i (:,:) 
     229      zs12(:,:) = stress12_i(:,:) 
    246230 
    247231      ! Ice strength 
    … …  
    249233 
    250234      ! scale factors 
    251 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    252235      DO jj = 2, jpjm1 
    253236         DO ji = fs_2, fs_jpim1 
    … …  
    272255         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    273256         ! 
    274 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    275          DO jj = 1, jpj 
    276             DO ji = 1, jpi 
    277                zpice(ji,jj) = ssh_m(ji,jj) + (  zintn * snwice_mass(ji,jj) +  zintb * snwice_mass_b(ji,jj)  ) * r1_rau0 
    278             END DO 
    279          END DO 
     257         zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 
    280258         ! 
    281259      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
    282 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    283          DO jj = 1, jpj 
    284             DO ji = 1, jpi 
    285                zpice(ji,jj) = ssh_m(ji,jj) 
    286             END DO 
    287          END DO 
     260         zpice(:,:) = ssh_m(:,:) 
    288261      ENDIF 
    289262 
    290 !$OMP PARALLEL DO schedule(static) private(jj,ji,zm1,zm2,zm3,zmassU,zmassV) 
    291263      DO jj = 2, jpjm1 
    292264         DO ji = fs_2, fs_jpim1 
    … …  
    345317         !                                            !----------------------!         
    346318         IF(ln_ctl) THEN   ! Convergence test 
    347 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    348319            DO jj = 1, jpjm1 
    349                DO ji = 1, jpi 
    350                   zu_ice(ji,jj) = u_ice(ji,jj) ! velocity at previous time step 
    351                   zv_ice(ji,jj) = v_ice(ji,jj) 
    352                END DO 
     320               zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 
     321               zv_ice(:,jj) = v_ice(:,jj) 
    353322            END DO 
    354323         ENDIF 
    355324 
    356325         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    357 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    358326         DO jj = 1, jpjm1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 
    359327            DO ji = 1, jpim1 
    … …  
    368336         CALL lbc_lnk( zds, 'F', 1. ) 
    369337 
    370 !$OMP PARALLEL DO schedule(static) private(jj,ji,zds2,zdiv,zdiv2,zdt,zdt2,zdelta) 
    371338         DO jj = 2, jpjm1 
    372339            DO ji = 2, jpim1 ! no vector loop 
    … …  
    403370         CALL lbc_lnk( zp_delt, 'T', 1. ) 
    404371 
    405 !$OMP PARALLEL DO schedule(static) private(jj,ji,zp_delf) 
    406372         DO jj = 1, jpjm1 
    407373            DO ji = 1, jpim1 
    … …  
    419385 
    420386         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
    421 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    422387         DO jj = 2, jpjm1 
    423388            DO ji = fs_2, fs_jpim1                
    … …  
    455420         IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations 
    456421             
    457 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 
    458422            DO jj = 2, jpjm1 
    459423               DO ji = fs_2, fs_jpim1 
    … …  
    500464            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' ) 
    501465 
    502 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 
    503466            DO jj = 2, jpjm1 
    504467               DO ji = fs_2, fs_jpim1 
    … …  
    546509         ELSE ! odd iterations 
    547510 
    548 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 
    549511            DO jj = 2, jpjm1 
    550512               DO ji = fs_2, fs_jpim1 
    … …  
    590552            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' ) 
    591553 
    592 !$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 
    593554            DO jj = 2, jpjm1 
    594555               DO ji = fs_2, fs_jpim1 
    … …  
    637598          
    638599         IF(ln_ctl) THEN   ! Convergence test 
    639 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    640600            DO jj = 2 , jpjm1 
    641                DO ji = 1, jpi 
    642                   zresr(ji,jj) = MAX( ABS( u_ice(ji,jj) - zu_ice(ji,jj) ), ABS( v_ice(ji,jj) - zv_ice(ji,jj) ) ) 
    643                END DO 
     601               zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
    644602            END DO 
    645603            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 
    … …  
    654612      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)  
    655613      !------------------------------------------------------------------------------! 
    656 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    657614      DO jj = 1, jpjm1 
    658615         DO ji = 1, jpim1 
    … …  
    667624      CALL lbc_lnk( zds, 'F', 1. ) 
    668625       
    669 !$OMP PARALLEL DO schedule(static) private(jj,ji,zdt,zdt2,zds2,zdelta,rswitch) 
    670626      DO jj = 2, jpjm1 
    671627         DO ji = 2, jpim1 ! no vector loop 
    … …  
    700656       
    701657      ! --- Store the stress tensor for the next time step --- ! 
    702 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    703       DO jj = 1, jpj 
    704          DO ji = 1, jpi 
    705             stress1_i (ji,jj) = zs1 (ji,jj) 
    706             stress2_i (ji,jj) = zs2 (ji,jj) 
    707             stress12_i(ji,jj) = zs12(ji,jj) 
    708          END DO 
    709       END DO 
     658      stress1_i (:,:) = zs1 (:,:) 
     659      stress2_i (:,:) = zs2 (:,:) 
     660      stress12_i(:,:) = zs12(:,:) 
    710661      ! 
    711662 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r7698 r7753  
    130130         WRITE(zchar,'(I2.2)') jl 
    131131         znam = 'v_i'//'_htc'//zchar 
    132 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    133          DO jj = 1, jpj 
    134             DO ji = 1, jpi 
    135                z2d(ji,jj) = v_i(ji,jj,jl) 
    136             END DO 
    137          END DO 
     132         z2d(:,:) = v_i(:,:,jl) 
    138133         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    139134         znam = 'v_s'//'_htc'//zchar 
    140 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    141          DO jj = 1, jpj 
    142             DO ji = 1, jpi 
    143                z2d(ji,jj) = v_s(ji,jj,jl) 
    144             END DO 
    145          END DO 
     135         z2d(:,:) = v_s(:,:,jl) 
    146136         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    147137         znam = 'smv_i'//'_htc'//zchar 
    148 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    149          DO jj = 1, jpj 
    150             DO ji = 1, jpi 
    151                z2d(ji,jj) = smv_i(ji,jj,jl) 
    152             END DO 
    153          END DO 
     138         z2d(:,:) = smv_i(:,:,jl) 
    154139         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    155140         znam = 'oa_i'//'_htc'//zchar 
    156 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    157          DO jj = 1, jpj 
    158             DO ji = 1, jpi 
    159                z2d(ji,jj) = oa_i(ji,jj,jl) 
    160             END DO 
    161          END DO 
     141         z2d(:,:) = oa_i(:,:,jl) 
    162142         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    163143         znam = 'a_i'//'_htc'//zchar 
    164 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    165          DO jj = 1, jpj 
    166             DO ji = 1, jpi 
    167                z2d(ji,jj) = a_i(ji,jj,jl) 
    168             END DO 
    169          END DO 
     144         z2d(:,:) = a_i(:,:,jl) 
    170145         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    171146         znam = 't_su'//'_htc'//zchar 
    172 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    173          DO jj = 1, jpj 
    174             DO ji = 1, jpi 
    175                z2d(ji,jj) = t_su(ji,jj,jl) 
    176             END DO 
    177          END DO 
     147         z2d(:,:) = t_su(:,:,jl) 
    178148         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    179149      END DO 
    … …  
    182152         WRITE(zchar,'(I2.2)') jl 
    183153         znam = 'tempt_sl1'//'_htc'//zchar 
    184 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    185          DO jj = 1, jpj 
    186             DO ji = 1, jpi 
    187                z2d(ji,jj) = e_s(ji,jj,1,jl) 
    188             END DO 
    189          END DO 
     154         z2d(:,:) = e_s(:,:,1,jl) 
    190155         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    191156      END DO 
    … …  
    196161            WRITE(zchar1,'(I2.2)') jk 
    197162            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
    198 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    199             DO jj = 1, jpj 
    200                DO ji = 1, jpi 
    201                   z2d(ji,jj) = e_i(ji,jj,jk,jl) 
    202             END DO 
    203          END DO 
     163            z2d(:,:) = e_i(:,:,jk,jl) 
    204164            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    205165         END DO 
    … …  
    221181            WRITE(zchar,'(I2.2)') jl 
    222182            znam = 'sxice'//'_htc'//zchar 
    223 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    224             DO jj = 1, jpj 
    225                DO ji = 1, jpi 
    226                   z2d(ji,jj) = sxice(ji,jj,jl) 
    227                END DO 
    228             END DO 
     183            z2d(:,:) = sxice(:,:,jl) 
    229184            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    230185            znam = 'syice'//'_htc'//zchar 
    231 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    232             DO jj = 1, jpj 
    233                DO ji = 1, jpi 
    234                   z2d(ji,jj) = syice(ji,jj,jl) 
    235                END DO 
    236             END DO 
     186            z2d(:,:) = syice(:,:,jl) 
    237187            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    238188            znam = 'sxxice'//'_htc'//zchar 
    239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    240             DO jj = 1, jpj 
    241                DO ji = 1, jpi 
    242                   z2d(ji,jj) = sxxice(ji,jj,jl) 
    243                END DO 
    244             END DO 
     189            z2d(:,:) = sxxice(:,:,jl) 
    245190            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    246191            znam = 'syyice'//'_htc'//zchar 
    247 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    248             DO jj = 1, jpj 
    249                DO ji = 1, jpi 
    250                   z2d(ji,jj) = syyice(ji,jj,jl) 
    251                END DO 
    252             END DO 
     192            z2d(:,:) = syyice(:,:,jl) 
    253193            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    254194            znam = 'sxyice'//'_htc'//zchar 
    255 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    256             DO jj = 1, jpj 
    257                DO ji = 1, jpi 
    258                   z2d(ji,jj) = sxyice(ji,jj,jl) 
    259                END DO 
    260             END DO 
     195            z2d(:,:) = sxyice(:,:,jl) 
    261196            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    262197            znam = 'sxsn'//'_htc'//zchar 
    263 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    264             DO jj = 1, jpj 
    265                DO ji = 1, jpi 
    266                   z2d(ji,jj) = sxsn(ji,jj,jl) 
    267                END DO 
    268             END DO 
     198            z2d(:,:) = sxsn(:,:,jl) 
    269199            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    270200            znam = 'sysn'//'_htc'//zchar 
    271 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    272             DO jj = 1, jpj 
    273                DO ji = 1, jpi 
    274                   z2d(ji,jj) = sysn(ji,jj,jl) 
    275                END DO 
    276             END DO 
     201            z2d(:,:) = sysn(:,:,jl) 
    277202            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    278203            znam = 'sxxsn'//'_htc'//zchar 
    279 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    280             DO jj = 1, jpj 
    281                DO ji = 1, jpi 
    282                   z2d(ji,jj) = sxxsn(ji,jj,jl) 
    283                END DO 
    284             END DO 
     204            z2d(:,:) = sxxsn(:,:,jl) 
    285205            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    286206            znam = 'syysn'//'_htc'//zchar 
    287 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    288             DO jj = 1, jpj 
    289                DO ji = 1, jpi 
    290                   z2d(ji,jj) = syysn(ji,jj,jl) 
    291                END DO 
    292             END DO 
     207            z2d(:,:) = syysn(:,:,jl) 
    293208            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    294209            znam = 'sxysn'//'_htc'//zchar 
    295 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    296             DO jj = 1, jpj 
    297                DO ji = 1, jpi 
    298                   z2d(ji,jj) = sxysn(ji,jj,jl) 
    299                END DO 
    300             END DO 
     210            z2d(:,:) = sxysn(:,:,jl) 
    301211            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    302212            znam = 'sxa'//'_htc'//zchar 
    303 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    304             DO jj = 1, jpj 
    305                DO ji = 1, jpi 
    306                   z2d(ji,jj) = sxa(ji,jj,jl) 
    307                END DO 
    308             END DO 
     213            z2d(:,:) = sxa(:,:,jl) 
    309214            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    310215            znam = 'sya'//'_htc'//zchar 
    311 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    312             DO jj = 1, jpj 
    313                DO ji = 1, jpi 
    314                   z2d(ji,jj) = sya(ji,jj,jl) 
    315                END DO 
    316             END DO 
     216            z2d(:,:) = sya(:,:,jl) 
    317217            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    318218            znam = 'sxxa'//'_htc'//zchar 
    319 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    320             DO jj = 1, jpj 
    321                DO ji = 1, jpi 
    322                   z2d(ji,jj) = sxxa(ji,jj,jl) 
    323                END DO 
    324             END DO 
     219            z2d(:,:) = sxxa(:,:,jl) 
    325220            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    326221            znam = 'syya'//'_htc'//zchar 
    327 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    328             DO jj = 1, jpj 
    329                DO ji = 1, jpi 
    330                   z2d(ji,jj) = syya(ji,jj,jl) 
    331                END DO 
    332             END DO 
     222            z2d(:,:) = syya(:,:,jl) 
    333223            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    334224            znam = 'sxya'//'_htc'//zchar 
    335 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    336             DO jj = 1, jpj 
    337                DO ji = 1, jpi 
    338                   z2d(ji,jj) = sxya(ji,jj,jl) 
    339                END DO 
    340             END DO 
     225            z2d(:,:) = sxya(:,:,jl) 
    341226            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    342227            znam = 'sxc0'//'_htc'//zchar 
    343 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    344             DO jj = 1, jpj 
    345                DO ji = 1, jpi 
    346                   z2d(ji,jj) = sxc0(ji,jj,jl) 
    347                END DO 
    348             END DO 
     228            z2d(:,:) = sxc0(:,:,jl) 
    349229            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    350230            znam = 'syc0'//'_htc'//zchar 
    351 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    352             DO jj = 1, jpj 
    353                DO ji = 1, jpi 
    354                   z2d(ji,jj) = syc0(ji,jj,jl) 
    355                END DO 
    356             END DO 
     231            z2d(:,:) = syc0(:,:,jl) 
    357232            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    358233            znam = 'sxxc0'//'_htc'//zchar 
    359 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    360             DO jj = 1, jpj 
    361                DO ji = 1, jpi 
    362                   z2d(ji,jj) = sxxc0(ji,jj,jl) 
    363                END DO 
    364             END DO 
     234            z2d(:,:) = sxxc0(:,:,jl) 
    365235            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    366236            znam = 'syyc0'//'_htc'//zchar 
    367 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    368             DO jj = 1, jpj 
    369                DO ji = 1, jpi 
    370                   z2d(ji,jj) = syyc0(ji,jj,jl) 
    371                END DO 
    372             END DO 
     237            z2d(:,:) = syyc0(:,:,jl) 
    373238            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    374239            znam = 'sxyc0'//'_htc'//zchar 
    375 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    376             DO jj = 1, jpj 
    377                DO ji = 1, jpi 
    378                   z2d(ji,jj) = sxyc0(ji,jj,jl) 
    379                END DO 
    380             END DO 
     240            z2d(:,:) = sxyc0(:,:,jl) 
    381241            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    382242            znam = 'sxsal'//'_htc'//zchar 
    383 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    384             DO jj = 1, jpj 
    385                DO ji = 1, jpi 
    386                   z2d(ji,jj) = sxsal(ji,jj,jl) 
    387                END DO 
    388             END DO 
     243            z2d(:,:) = sxsal(:,:,jl) 
    389244            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    390245            znam = 'sysal'//'_htc'//zchar 
    391 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    392             DO jj = 1, jpj 
    393                DO ji = 1, jpi 
    394                   z2d(ji,jj) = sysal(ji,jj,jl) 
    395                END DO 
    396             END DO 
     246            z2d(:,:) = sysal(:,:,jl) 
    397247            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    398248            znam = 'sxxsal'//'_htc'//zchar 
    399 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    400             DO jj = 1, jpj 
    401                DO ji = 1, jpi 
    402                   z2d(ji,jj) = sxxsal(ji,jj,jl) 
    403                END DO 
    404             END DO 
     249            z2d(:,:) = sxxsal(:,:,jl) 
    405250            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    406251            znam = 'syysal'//'_htc'//zchar 
    407 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    408             DO jj = 1, jpj 
    409                DO ji = 1, jpi 
    410                   z2d(ji,jj) = syysal(ji,jj,jl) 
    411                END DO 
    412             END DO 
     252            z2d(:,:) = syysal(:,:,jl) 
    413253            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    414254            znam = 'sxysal'//'_htc'//zchar 
    415 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    416             DO jj = 1, jpj 
    417                DO ji = 1, jpi 
    418                   z2d(ji,jj) = sxysal(ji,jj,jl) 
    419                END DO 
    420             END DO 
     255            z2d(:,:) = sxysal(:,:,jl) 
    421256            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    422257            znam = 'sxage'//'_htc'//zchar 
    423 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    424             DO jj = 1, jpj 
    425                DO ji = 1, jpi 
    426                   z2d(ji,jj) = sxage(ji,jj,jl) 
    427                END DO 
    428             END DO 
     258            z2d(:,:) = sxage(:,:,jl) 
    429259            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    430260            znam = 'syage'//'_htc'//zchar 
    431 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    432             DO jj = 1, jpj 
    433                DO ji = 1, jpi 
    434                   z2d(ji,jj) = syage(ji,jj,jl) 
    435                END DO 
    436             END DO 
     261            z2d(:,:) = syage(:,:,jl) 
    437262            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    438263            znam = 'sxxage'//'_htc'//zchar 
    439 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    440             DO jj = 1, jpj 
    441                DO ji = 1, jpi 
    442                   z2d(ji,jj) = sxxage(ji,jj,jl) 
    443                END DO 
    444             END DO 
     264            z2d(:,:) = sxxage(:,:,jl) 
    445265            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    446266            znam = 'syyage'//'_htc'//zchar 
    447 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    448             DO jj = 1, jpj 
    449                DO ji = 1, jpi 
    450                   z2d(ji,jj) = syyage(ji,jj,jl) 
    451                END DO 
    452             END DO 
     267            z2d(:,:) = syyage(:,:,jl) 
    453268            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    454269            znam = 'sxyage'//'_htc'//zchar 
    455 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    456             DO jj = 1, jpj 
    457                DO ji = 1, jpi 
    458                   z2d(ji,jj) = sxyage(ji,jj,jl) 
    459                END DO 
    460             END DO 
     270            z2d(:,:) = sxyage(:,:,jl) 
    461271            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    462272         END DO 
    … …  
    473283               WRITE(zchar1,'(I2.2)') jk 
    474284               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
    475 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    476                DO jj = 1, jpj 
    477                   DO ji = 1, jpi 
    478                      z2d(ji,jj) = sxe(ji,jj,jk,jl) 
    479                   END DO 
    480                END DO 
     285               z2d(:,:) = sxe(:,:,jk,jl) 
    481286               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    482287               znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
    483 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    484                DO jj = 1, jpj 
    485                   DO ji = 1, jpi 
    486                      z2d(ji,jj) = sye(ji,jj,jk,jl) 
    487                   END DO 
    488                END DO 
     288               z2d(:,:) = sye(:,:,jk,jl) 
    489289               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    490290               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
    491 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    492                DO jj = 1, jpj 
    493                   DO ji = 1, jpi 
    494                      z2d(ji,jj) = sxxe(ji,jj,jk,jl) 
    495                   END DO 
    496                END DO 
     291               z2d(:,:) = sxxe(:,:,jk,jl) 
    497292               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    498293               znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
    499 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    500                DO jj = 1, jpj 
    501                   DO ji = 1, jpi 
    502                      z2d(ji,jj) = syye(ji,jj,jk,jl) 
    503                   END DO 
    504                END DO 
     294               z2d(:,:) = syye(:,:,jk,jl) 
    505295               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    506296               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
    507 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    508                DO jj = 1, jpj 
    509                   DO ji = 1, jpi 
    510                      z2d(ji,jj) = sxye(ji,jj,jk,jl) 
    511                   END DO 
    512                END DO 
     297               z2d(:,:) = sxye(:,:,jk,jl) 
    513298               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    514299            END DO 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r7698 r7753  
    112112      ! --- case we bypass ice thermodynamics --- ! 
    113113      IF( .NOT. ln_limthd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere 
    114 !$OMP PARALLEL 
    115 !$OMP DO schedule(static) private(jj,ji) 
    116          DO jj = 1, jpj 
    117             DO ji = 1, jpi 
    118                hfx_in   (ji,jj)   = pfrld(ji,jj) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj) 
    119                hfx_out  (ji,jj)   = pfrld(ji,jj) *   qns_oce(ji,jj)                  + qemp_oce(ji,jj) 
    120                emp_ice  (ji,jj)   = 0._wp 
    121                qemp_ice (ji,jj)   = 0._wp 
    122             END DO 
    123          END DO 
    124          DO jl = 1, jpl 
    125 !$OMP DO schedule(static) private(jj,ji) 
    126             DO jj = 1, jpj 
    127                DO ji = 1, jpi 
    128                   ftr_ice  (ji,jj,jl) = 0._wp 
    129                   qevap_ice(ji,jj,jl) = 0._wp 
    130                END DO 
    131             END DO 
    132          END DO 
    133 !$OMP END PARALLEL 
     114         hfx_in   (:,:)   = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     115         hfx_out  (:,:)   = pfrld(:,:) *   qns_oce(:,:)                  + qemp_oce(:,:) 
     116         ftr_ice  (:,:,:) = 0._wp 
     117         emp_ice  (:,:)   = 0._wp 
     118         qemp_ice (:,:)   = 0._wp 
     119         qevap_ice(:,:,:) = 0._wp 
    134120      ENDIF 
    135121       
    … …  
    137123      CALL wrk_alloc( jpi,jpj, zalb )     
    138124 
    139 !$OMP PARALLEL 
    140 !$OMP DO schedule(static) private(jj,ji) 
    141       DO jj = 1, jpj 
    142          DO ji = 1, jpi 
    143             zalb(ji,jj) = 0._wp 
    144          END DO 
    145       END DO 
    146 !$OMP DO schedule(static) private(jj,ji,jl) 
    147       DO jj = 1, jpj 
    148          DO ji = 1, jpi 
    149             IF ( at_i_b(ji,jj) <= epsi06 ) THEN 
    150                zalb(ji,jj) = 0.066_wp 
    151             ELSE   
    152                DO jl = 1, jpl 
    153                   zalb(ji,jj) = zalb(ji,jj) + ( alb_ice(ji,jj,jl) * a_i_b(ji,jj,jl) ) / at_i_b(ji,jj) 
    154                END DO 
    155             END IF 
    156           END DO 
    157       END DO 
    158 !$OMP END PARALLEL 
     125      zalb(:,:) = 0._wp 
     126      WHERE     ( at_i_b <= epsi06 )  ;  zalb(:,:) = 0.066_wp 
     127      ELSEWHERE                       ;  zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
     128      END WHERE 
    159129      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output 
    160130 
    161 !$OMP PARALLEL 
    162 !$OMP DO schedule(static) private(jj,ji) 
    163       DO jj = 1, jpj 
    164          DO ji = 1, jpi 
    165             zalb(ji,jj) = 0._wp 
    166          END DO 
    167       END DO 
    168       DO jl = 1, jpl 
    169 !$OMP DO schedule(static) private(jj,ji) 
    170          DO jj = 1, jpj 
    171             DO ji = 1, jpi 
    172                zalb(ji,jj) = zalb(ji,jj) + ( alb_ice(ji,jj,jl) * a_i_b(ji,jj,jl) ) + 0.066_wp * ( 1._wp - at_i_b(ji,jj) )       
    173             END DO 
    174          END DO 
    175       END DO 
    176 !$OMP END PARALLEL 
     131      zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b )       
    177132      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output 
    178133 
    179134      CALL wrk_dealloc( jpi,jpj, zalb )     
    180135 
    181 !$OMP PARALLEL 
    182 !$OMP DO schedule(static) private(jj,ji,jl,zqsr,zqmass) 
    183136      DO jj = 1, jpj 
    184137         DO ji = 1, jpi 
    … …  
    233186      !      salt flux at the ocean surface      ! 
    234187      !------------------------------------------! 
    235 !$OMP DO schedule(static) private(jj,ji) 
    236       DO jj = 1, jpj 
    237          DO ji = 1, jpi 
    238             sfx(ji,jj) = sfx_bog(ji,jj) + sfx_bom(ji,jj) + sfx_sum(ji,jj) + sfx_sni(ji,jj) + sfx_opw(ji,jj)   & 
    239                &     + sfx_res(ji,jj) + sfx_dyn(ji,jj) + sfx_bri(ji,jj) + sfx_sub(ji,jj) + sfx_lam(ji,jj) 
    240          END DO 
    241       END DO 
    242 !$OMP END PARALLEL 
     188      sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
     189         &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 
    243190 
    244191      !-------------------------------------------------------------! 
    … …  
    246193      !-------------------------------------------------------------! 
    247194      IF( nn_ice_embd /= 0 ) THEN 
    248 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    249          DO jj = 1, jpj 
    250             DO ji = 1, jpi 
    251                ! save mass from the previous ice time step 
    252                snwice_mass_b(ji,jj) = snwice_mass(ji,jj)                   
    253                ! new mass per unit area 
    254                snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj)  )  
    255                ! time evolution of snow+ice mass 
    256                snwice_fmass (ji,jj) = ( snwice_mass(ji,jj) - snwice_mass_b(ji,jj) ) * r1_rdtice 
    257             END DO 
    258          END DO 
     195         ! save mass from the previous ice time step 
     196         snwice_mass_b(:,:) = snwice_mass(:,:)                   
     197         ! new mass per unit area 
     198         snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  )  
     199         ! time evolution of snow+ice mass 
     200         snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) * r1_rdtice 
    259201      ENDIF 
    260202 
    … …  
    262204      !   Storing the transmitted variables           ! 
    263205      !-----------------------------------------------! 
    264 !$OMP PARALLEL 
    265 !$OMP DO schedule(static) private(jj,ji) 
    266       DO jj = 1, jpj 
    267          DO ji = 1, jpi 
    268             fr_i  (ji,jj)   = at_i(ji,jj)             ! Sea-ice fraction             
    269          END DO 
    270       END DO 
    271       DO jl = 1, jpl 
    272 !$OMP DO schedule(static) private(jj,ji) 
    273          DO jj = 1, jpj 
    274             DO ji = 1, jpi 
    275                tn_ice(ji,jj,jl) = t_su(ji,jj,jl)           ! Ice surface temperature                       
    276             END DO 
    277          END DO 
    278       END DO 
    279 !$OMP END PARALLEL 
     206      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction             
     207      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                       
    280208 
    281209      !------------------------------------------------------------------------! 
    … …  
    284212      CALL wrk_alloc( jpi,jpj,jpl,   zalb_cs, zalb_os )     
    285213      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    286       DO jl = 1, jpl 
    287 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    288          DO jj = 1, jpj 
    289             DO ji = 1, jpi 
    290                alb_ice(ji,jj,jl) = ( 1. - cldf_ice ) * zalb_cs(ji,jj,jl) + cldf_ice * zalb_os(ji,jj,jl) 
    291             END DO 
    292          END DO 
    293       END DO 
     214      alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
    294215      CALL wrk_dealloc( jpi,jpj,jpl,   zalb_cs, zalb_os ) 
    295216 
    … …  
    339260      ! 
    340261      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step) 
    341 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_t,zv_t,zmodt) 
    342262         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
    343263            DO ji = fs_2, fs_jpim1 
    … …  
    354274         CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 
    355275         ! 
    356 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    357          DO jj = 1, jpj 
    358             DO ji = 1, jpi 
    359                utau_oce(ji,jj) = utau(ji,jj)                    !* save the air-ocean stresses at ice time-step 
    360                vtau_oce(ji,jj) = vtau(ji,jj) 
    361             END DO 
    362          END DO 
     276         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
     277         vtau_oce(:,:) = vtau(:,:) 
    363278         ! 
    364279      ENDIF 
    … …  
    366281      !                                      !==  every ocean time-step  ==! 
    367282      ! 
    368 !$OMP PARALLEL DO schedule(static) private(jj,ji,zat_u,zat_v,zutau_ice,zvtau_ice) 
    369283      DO jj = 2, jpjm1                                !* update the stress WITHOUT a ice-ocean rotation angle 
    370284         DO ji = fs_2, fs_jpim1   ! Vect. Opt. 
    … …  
    405319      IF( lim_sbc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 
    406320      ! 
    407 !$OMP PARALLEL 
    408 !$OMP DO schedule(static) private(jj,ji) 
    409       DO jj = 1, jpj 
    410          DO ji = 1, jpi 
    411             soce_0(ji,jj) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    412             sice_0(ji,jj) = sice 
    413          END DO 
    414       END DO 
     321      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
     322      sice_0(:,:) = sice 
    415323      !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area 
    416 !$OMP DO schedule(static) private(jj,ji) 
    417       DO jj = 1, jpj 
    418          DO ji = 1, jpi 
    419             IF ( 14._wp <= glamt(ji,jj) .AND. glamt(ji,jj) <= 32._wp .AND.   & 
    420                &   54._wp <= gphit(ji,jj) .AND. gphit(ji,jj) <= 66._wp         ) THEN 
    421                soce_0(ji,jj) = 4._wp 
    422                sice_0(ji,jj) = 2._wp 
    423             END IF 
    424          END DO 
    425       END DO 
    426 !$OMP END PARALLEL 
     324      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     325         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     326         soce_0(:,:) = 4._wp 
     327         sice_0(:,:) = 2._wp 
     328      END WHERE 
    427329      ! 
    428330      IF( .NOT. ln_rstart ) THEN 
    429331         !                                      ! embedded sea ice 
    430332         IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    431 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    432             DO jj = 1, jpj 
    433                DO ji = 1, jpi 
    434                   snwice_mass  (ji,jj) = tmask(ji,jj,1) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj)  ) 
    435                   snwice_mass_b(ji,jj) = snwice_mass(ji,jj) 
    436                END DO 
    437             END DO 
     333            snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
     334            snwice_mass_b(:,:) = snwice_mass(:,:) 
    438335         ELSE 
    439 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    440             DO jj = 1, jpj 
    441                DO ji = 1, jpi 
    442                   snwice_mass  (ji,jj) = 0._wp          ! no mass exchanges 
    443                   snwice_mass_b(ji,jj) = 0._wp          ! no mass exchanges 
    444                END DO 
    445             END DO 
     336            snwice_mass  (:,:) = 0._wp          ! no mass exchanges 
     337            snwice_mass_b(:,:) = 0._wp          ! no mass exchanges 
    446338         ENDIF 
    447339         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 
    448 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    449             DO jj = 1, jpj 
    450                DO ji = 1, jpi 
    451                   sshn(ji,jj) = sshn(ji,jj) - snwice_mass(ji,jj) * r1_rau0 
    452                   sshb(ji,jj) = sshb(ji,jj) - snwice_mass(ji,jj) * r1_rau0 
    453                END DO 
    454             END DO 
     340            sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
     341            sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    455342 
    456343!!gm I really don't like this stuff here...  Find a way to put that elsewhere or differently 
    457344!!gm 
    458345            IF( .NOT.ln_linssh ) THEN 
    459 !$OMP PARALLEL 
    460 !$OMP DO schedule(static) private(jj,ji) 
    461346               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    462                   DO jj = 1, jpj 
    463                      DO ji = 1, jpi 
    464                         e3t_n(ji,jj,jk) = e3t_0(ji,jj,jk)*( 1._wp + sshn(ji,jj)*tmask(ji,jj,1)/(ht_0(ji,jj) + 1.0 - tmask(ji,jj,1)) ) 
    465                         e3t_b(ji,jj,jk) = e3t_0(ji,jj,jk)*( 1._wp + sshb(ji,jj)*tmask(ji,jj,1)/(ht_0(ji,jj) + 1.0 - tmask(ji,jj,1)) ) 
    466                      END DO 
    467                   END DO 
     347                  e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     348                  e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    468349               END DO 
    469 !$OMP DO schedule(static) private(jj,ji) 
    470                DO jk = 1,jpk 
    471                   DO jj = 1, jpj 
    472                      DO ji = 1, jpi 
    473                         e3t_a(ji,jj,jk) = e3t_b(ji,jj,jk) 
    474                      END DO 
    475                   END DO 
    476                END DO 
    477 !$OMP END PARALLEL 
     350               e3t_a(:,:,:) = e3t_b(:,:,:) 
    478351               ! Reconstruction of all vertical scale factors at now and before time-steps 
    479352               ! ========================================================================= 
    … …  
    495368               ! ---------------------- 
    496369!!gm not sure of that.... 
    497 !$OMP PARALLEL 
    498 !$OMP DO schedule(static) private(jj,ji) 
    499                DO jj = 1, jpj 
    500                   DO ji = 1, jpi 
    501                      gdept_n(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) 
    502                      gdepw_n(ji,jj,1) = 0.0_wp 
    503                      gde3w_n(ji,jj,1) = gdept_n(ji,jj,1) - sshn(ji,jj) 
    504                   END DO 
     370               gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
     371               gdepw_n(:,:,1) = 0.0_wp 
     372               gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
     373               DO jk = 2, jpk 
     374                  gdept_n(:,:,jk) = gdept_n(:,:,jk-1) + e3w_n(:,:,jk) 
     375                  gdepw_n(:,:,jk) = gdepw_n(:,:,jk-1) + e3t_n(:,:,jk-1) 
     376                  gde3w_n(:,:,jk) = gdept_n(:,:,jk  ) - sshn   (:,:) 
    505377               END DO 
    506                DO jk = 2, jpk 
    507 !$OMP DO schedule(static) private(jj,ji) 
    508                   DO jj = 1, jpj 
    509                      DO ji = 1, jpi 
    510                         gdept_n(ji,jj,jk) = gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk) 
    511                         gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
    512                         gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk  ) - sshn   (ji,jj) 
    513                      END DO 
    514                   END DO 
    515                END DO 
    516 !$OMP END PARALLEL 
    517378            ENDIF 
    518379         ENDIF 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r7698 r7753  
    110110      !---------------------------------------------! 
    111111      IF( ln_limdyn ) THEN 
    112 !$OMP PARALLEL 
    113 !$OMP DO schedule(static) private(jj,ji) 
    114          DO jj = 1, jpj 
    115             DO ji = 1, jpi 
    116                zu_io(ji,jj) = u_ice(ji,jj) - ssu_m(ji,jj) 
    117                zv_io(ji,jj) = v_ice(ji,jj) - ssv_m(ji,jj) 
    118             END DO 
    119          END DO 
    120 !$OMP DO schedule(static) private(jj,ji) 
     112         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
     113         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    121114         DO jj = 2, jpjm1  
    122115            DO ji = fs_2, fs_jpim1 
    … …  
    126119            END DO 
    127120         END DO 
    128 !$OMP END PARALLEL 
    129121      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
    130 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    131122         DO jj = 2, jpjm1 
    132123            DO ji = fs_2, fs_jpim1 
    … …  
    142133      ! Initialization and units change 
    143134      !----------------------------------! 
    144 !$OMP PARALLEL 
    145       DO jl = 1, jpl 
    146 !$OMP DO schedule(static) private(jj,ji) 
    147          DO jj = 1, jpj 
    148             DO ji = 1, jpi 
    149                ftr_ice(ji,jj,jl) = 0._wp  ! part of solar radiation transmitted through the ice 
    150             END DO 
    151          END DO 
    152       END DO 
     135      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
    153136 
    154137      ! Change the units of heat content; from J/m2 to J/m3 
    155138      DO jl = 1, jpl 
    156139         DO jk = 1, nlay_i 
    157 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    158140            DO jj = 1, jpj 
    159141               DO ji = 1, jpi 
    … …  
    165147         END DO 
    166148         DO jk = 1, nlay_s 
    167 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    168149            DO jj = 1, jpj 
    169150               DO ji = 1, jpi 
    … …  
    179160      ! Partial computation of forcing for the thermodynamic sea ice model 
    180161      !--------------------------------------------------------------------! 
    181 !$OMP DO schedule(static) private(jj,ji,rswitch,zqld,zqfr,zfric_u) 
    182162      DO jj = 1, jpj 
    183163         DO ji = 1, jpi 
    … …  
    221201         END DO 
    222202      END DO 
    223 !$OMP END PARALLEL 
    224203       
    225204      ! In case we bypass open-water ice formation 
    226       IF( .NOT. ln_limdO ) THEN 
    227 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    228          DO jj = 1, jpj 
    229             DO ji = 1, jpi 
    230                qlead(ji,jj) = 0._wp 
    231             END DO 
    232          END DO 
    233       END IF 
     205      IF( .NOT. ln_limdO )  qlead(:,:) = 0._wp 
    234206      ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 
    235       IF( .NOT. ln_limdH ) THEN 
    236 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    237          DO jj = 1, jpj 
    238             DO ji = 1, jpi 
    239                hfx_in(ji,jj) = pfrld(ji,jj) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj) 
    240                fhtur (ji,jj) = 0._wp 
    241             END DO 
    242          END DO 
    243       END IF 
    244 !$OMP PARALLEL 
    245 !$OMP DO schedule(static) private(jj,ji) 
    246       DO jj = 1, jpj 
    247          DO ji = 1, jpi 
    248             fhld (ji,jj) = 0._wp 
    249          END DO 
    250       END DO 
     207      IF( .NOT. ln_limdH )  hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) 
     208      IF( .NOT. ln_limdH )  fhtur (:,:) = 0._wp  ;  fhld  (:,:) = 0._wp 
    251209 
    252210      ! --------------------------------------------------------------------- 
    … …  
    256214      !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
    257215      !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
    258 !$OMP DO schedule(static) private(jj,ji) 
    259216      DO jj = 1, jpj 
    260217         DO ji = 1, jpi 
    … …  
    266223         END DO 
    267224      END DO 
    268 !$OMP END PARALLEL 
    269225 
    270226      !------------------------------------------------------------------------------! 
    … …  
    332288 
    333289      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
    334 !$OMP PARALLEL 
    335290      DO jl = 1, jpl 
    336291         DO jk = 1, nlay_i 
    337 !$OMP DO schedule(static) private(jj,ji) 
    338             DO jj = 1, jpj 
    339                DO ji = 1, jpi 
    340                   e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i 
    341                END DO 
    342             END DO 
     292            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i 
    343293         END DO 
    344294         DO jk = 1, nlay_s 
    345 !$OMP DO schedule(static) private(jj,ji) 
    346             DO jj = 1, jpj 
    347                DO ji = 1, jpi 
    348                   e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_s(ji,jj,jl) * r1_nlay_s 
    349                END DO 
    350             END DO 
     295            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 
    351296         END DO 
    352297      END DO 
    353  
    354 ! Change thickness to volume 
    355       DO jl = 1, jpl 
    356 !$OMP DO schedule(static) private(jj,ji) 
    357          DO jj = 1, jpj 
    358             DO ji = 1, jpi 
    359                v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
    360                v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl) 
    361                smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl) 
    362             END DO 
    363          END DO 
    364       END DO 
     298  
     299      ! Change thickness to volume 
     300      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:) 
     301      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:) 
     302      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 
    365303 
    366304      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 
    367305      DO jl  = 1, jpl 
    368 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    369306         DO jj = 1, jpj 
    370307            DO ji = 1, jpi 
    … …  
    374311         END DO 
    375312      END DO 
    376 !$OMP END PARALLEL 
    377313 
    378314      CALL lim_var_zapsmall 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90

    r7698 r7753  
    113113      zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 
    114114       
    115 !$OMP PARALLEL 
    116 !$OMP DO schedule(static) private(jj,ji,zdfloe,zperi,zwlat) 
    117115      DO jj = 1, jpj 
    118116         DO ji = 1, jpi 
    … …  
    137135      !---------------------------------------------------------------------------------------------! 
    138136      DO jl = jpl, 1, -1 
    139 !$OMP DO schedule(static) private(jj,ji,rswitch,zda) 
    140137         DO jj = 1, jpj 
    141138            DO ji = 1, jpi 
    … …  
    166163       
    167164      ! total concentration 
    168 !$OMP DO schedule(static) private(jj,ji) 
    169       DO jj = 1, jpj 
    170          DO ji = 1, jpi 
    171             at_i(ji,jj) = 0._wp 
    172          END DO 
    173       END DO 
    174       DO jl = 1, jpl 
    175 !$OMP DO schedule(static) private(jj,ji) 
    176          DO jj = 1, jpj 
    177             DO ji = 1, jpi 
    178                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
    179             END DO 
    180          END DO 
    181       END DO 
     165      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     166       
    182167      ! --- ensure that ht_i = 0 where a_i = 0 --- 
    183       DO jl = 1, jpl 
    184 !$OMP DO schedule(static) private(jj,ji) 
    185          DO jj = 1, jpj 
    186             DO ji = 1, jpi 
    187                IF(a_i(ji,jj,jl)  == 0._wp) ht_i(ji,jj,jl) = 0._wp 
    188             END DO 
    189          END DO 
    190       END DO 
    191 !$OMP END PARALLEL 
    192  
     168      WHERE( a_i == 0._wp ) ht_i = 0._wp 
    193169      ! 
    194170      CALL wrk_dealloc( jpi,jpj, zda_tot ) 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90

    r7698 r7753  
    125125      ! 2) Convert units for ice internal energy 
    126126      !------------------------------------------------------------------------------| 
    127 !$OMP PARALLEL 
    128127      DO jl = 1, jpl 
    129128         DO jk = 1, nlay_i 
    130 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    131129            DO jj = 1, jpj 
    132130               DO ji = 1, jpi 
    … …  
    152150      !  
    153151 
    154 !$OMP DO schedule(static) private(jj,ji) 
    155       DO jj = 1, jpj 
    156          DO ji = 1, jpi 
    157             zvrel(ji,jj) = 0._wp 
    158          END DO 
    159       END DO 
    160  
    161 !$OMP DO schedule(static) private(jj,ji) 
    162       DO jj = 1, jpj 
    163          DO ji = 1, jpi 
    164             ! Default new ice thickness 
    165             IF( qlead(ji,jj) < 0._wp ) THEN ; hicol(ji,jj) = rn_hnewice 
    166             ELSE                            ; hicol(ji,jj) = 0._wp 
    167             END IF 
    168          END DO 
    169       END DO 
    170 !$OMP END PARALLEL 
     152      zvrel(:,:) = 0._wp 
     153 
     154      ! Default new ice thickness 
     155      WHERE( qlead(:,:) < 0._wp ) ; hicol(:,:) = rn_hnewice 
     156      ELSEWHERE                   ; hicol(:,:) = 0._wp 
     157      END WHERE 
    171158 
    172159      IF( ln_frazil ) THEN 
    … …  
    175162         ! Physical constants 
    176163         !-------------------- 
     164         hicol(:,:) = 0._wp 
    177165 
    178166         zhicrit = 0.04 ! frazil ice thickness 
    … …  
    181169         zgamafr = 0.03 
    182170 
    183 !$OMP PARALLEL 
    184 !$OMP DO schedule(static) private(jj,ji) 
    185          DO jj = 1, jpj 
    186             DO ji = 1, jpi 
    187                hicol(ji,jj) = 0._wp 
    188             END DO 
    189          END DO 
    190  
    191 !$OMP DO schedule(static) private(jj,ji,ztaux,ztauy,ztenagm,rswitch,zvfrx,zvfry,zvgx,zvgy,zvrel2,iter,zf,zfp) 
    192171         DO jj = 2, jpjm1 
    193172            DO ji = 2, jpim1 
    … …  
    247226            END DO  
    248227         END DO  
    249 !$OMP END PARALLEL 
    250228         !  
    251229         CALL lbc_lnk( zvrel, 'T', 1. ) 
    … …  
    452430 
    453431         DO jk = 1, nlay_i 
    454 !$OMP PARALLEL DO schedule(static) private(ji,jl,rswitch) 
    455432            DO ji = 1, nbpac 
    456433               jl = jcat(ji) 
    … …  
    471448            qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 
    472449            DO jk = 1, nlay_i 
    473 !$OMP PARALLEL DO schedule(static) private(ji) 
    474450               DO ji = 1, nbpac 
    475451                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i 
    … …  
    479455 
    480456            ! new volumes including lateral/bottom accretion + residual 
    481 !$OMP PARALLEL DO schedule(static) private(ji,rswitch,zv_newfra) 
    482457            DO ji = 1, nbpac 
    483458               rswitch        = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 
    … …  
    497472         !----------------- 
    498473         DO jl = 1, jpl 
    499 !$OMP PARALLEL DO schedule(static) private(ji,zdv) 
    500474            DO ji = 1, nbpac 
    501475               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl) 
    … …  
    528502      DO jl = 1, jpl 
    529503         DO jk = 1, nlay_i 
    530 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    531504            DO jj = 1, jpj 
    532505               DO ji = 1, jpi 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90

    r7698 r7753  
    114114      zviold = v_i 
    115115      zvsold = v_s 
    116 !$OMP PARALLEL 
    117 !$OMP DO schedule(static) private(jj,ji) 
    118       DO jj = 1, jpj 
    119          DO ji = 1, jpi 
    120             zsmvold(ji,jj) = 0._wp 
    121          END DO 
    122       END DO 
     116      zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 ) 
     117      zeiold (:,:) = et_i 
     118      zesold (:,:) = et_s  
     119 
     120      !--- Thickness correction init. --- ! 
     121      zatold(:,:) = at_i 
    123122      DO jl = 1, jpl 
    124 !$OMP DO schedule(static) private(jj,ji) 
    125          DO jj = 1, jpj 
    126             DO ji = 1, jpi 
    127                zsmvold(ji,jj) = zsmvold(ji,jj) + smv_i(ji,jj,jl) 
    128             END DO 
    129          END DO 
    130       END DO 
    131 !$OMP DO schedule(static) private(jj,ji) 
    132       DO jj = 1, jpj 
    133          DO ji = 1, jpi 
    134             zeiold (ji,jj) = et_i(ji,jj) 
    135             zesold (ji,jj) = et_s(ji,jj) 
    136  
    137             !--- Thickness correction init. --- ! 
    138             zatold (ji,jj) = at_i(ji,jj) 
    139          END DO 
    140       END DO 
    141       DO jl = 1, jpl 
    142 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    143123         DO jj = 1, jpj 
    144124            DO ji = 1, jpi 
    … …  
    150130      END DO 
    151131      ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- ! 
     132      zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 
    152133      DO jl = 1, jpl 
    153 !$OMP DO schedule(static) private(jj,ji) 
    154          DO jj = 1, jpj 
    155             DO ji = 1, jpi 
    156                zhimax(ji,jj,jl) = ht_i(ji,jj,jl) + ht_s(ji,jj,jl) 
    157             END DO 
    158          END DO 
    159       END DO 
    160 !$OMP END PARALLEL 
    161       DO jl = 1, jpl 
    162 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    163134         DO jj = 2, jpjm1 
    164135            DO ji = 2, jpim1 
    … …  
    202173         zdt = rdt_ice / REAL(initad) 
    203174          
    204 !$OMP PARALLEL 
    205175         ! transport 
    206 !$OMP DO schedule(static) private(jj,ji) 
    207          DO jj = 1, jpj 
    208             DO ji = 1, jpi 
    209                zudy(ji,jj) = u_ice(ji,jj) * e2u(ji,jj) 
    210                zvdx(ji,jj) = v_ice(ji,jj) * e1v(ji,jj) 
    211             END DO 
    212          END DO 
     176         zudy(:,:) = u_ice(:,:) * e2u(:,:) 
     177         zvdx(:,:) = v_ice(:,:) * e1v(:,:) 
    213178          
    214179         ! define velocity for advection: u*grad(H) 
    215 !$OMP DO schedule(static) private(jj,ji) 
    216180         DO jj = 2, jpjm1 
    217181            DO ji = fs_2, fs_jpim1 
    … …  
    227191            END DO 
    228192         END DO 
    229 !$OMP END PARALLEL 
    230193          
    231194         ! advection 
    … …  
    245208         END DO 
    246209         ! 
    247 !$OMP PARALLEL 
    248 !$OMP DO schedule(static) private(jj,ji) 
    249          DO jj = 1, jpj 
    250             DO ji = 1, jpi 
    251                at_i(ji,jj) = a_i(ji,jj,1)      ! total ice fraction 
    252             END DO 
    253          END DO 
     210         at_i(:,:) = a_i(:,:,1)      ! total ice fraction 
    254211         DO jl = 2, jpl 
    255 !$OMP DO schedule(static) private(jj,ji) 
    256             DO jj = 1, jpj 
    257                DO ji = 1, jpi 
    258                   at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
    259                END DO 
    260             END DO 
    261          END DO 
    262 !$OMP END PARALLEL 
     212            at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     213         END DO 
    263214         ! 
    264215         CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) 
    … …  
    279230         ENDIF 
    280231          
    281 !$OMP PARALLEL 
    282 !$OMP DO schedule(static) private(jj,ji) 
    283          DO jj = 1, jpj 
    284             DO ji = 1, jpi 
    285                zarea(ji,jj) = e1e2t(ji,jj) 
    286           
    287                !------------------------- 
    288                ! transported fields                                         
    289                !------------------------- 
    290                z0opw(ji,jj,1) = ato_i(ji,jj) * e1e2t(ji,jj)             ! Open water area  
    291             END DO 
    292          END DO 
     232         zarea(:,:) = e1e2t(:,:) 
     233          
     234         !------------------------- 
     235         ! transported fields                                         
     236         !------------------------- 
     237         z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:)             ! Open water area  
    293238         DO jl = 1, jpl 
    294 !$OMP DO schedule(static) private(jj,ji) 
    295             DO jj = 1, jpj 
    296                DO ji = 1, jpi 
    297                   z0snw (ji,jj,jl)  = v_s  (ji,jj,  jl) * e1e2t(ji,jj)  ! Snow volume 
    298                   z0ice(ji,jj,jl)   = v_i  (ji,jj,  jl) * e1e2t(ji,jj)  ! Ice  volume 
    299                   z0ai  (ji,jj,jl)  = a_i  (ji,jj,  jl) * e1e2t(ji,jj)  ! Ice area 
    300                   z0smi (ji,jj,jl)  = smv_i(ji,jj,  jl) * e1e2t(ji,jj)  ! Salt content 
    301                   z0oi (ji,jj,jl)   = oa_i (ji,jj,  jl) * e1e2t(ji,jj)  ! Age content 
    302                   z0es (ji,jj,jl)   = e_s  (ji,jj,1,jl) * e1e2t(ji,jj)  ! Snow heat content 
    303                END DO 
    304             END DO 
     239            z0snw (:,:,jl)  = v_s  (:,:,  jl) * e1e2t(:,:)  ! Snow volume 
     240            z0ice(:,:,jl)   = v_i  (:,:,  jl) * e1e2t(:,:)  ! Ice  volume 
     241            z0ai  (:,:,jl)  = a_i  (:,:,  jl) * e1e2t(:,:)  ! Ice area 
     242            z0smi (:,:,jl)  = smv_i(:,:,  jl) * e1e2t(:,:)  ! Salt content 
     243            z0oi (:,:,jl)   = oa_i (:,:,  jl) * e1e2t(:,:)  ! Age content 
     244            z0es (:,:,jl)   = e_s  (:,:,1,jl) * e1e2t(:,:)  ! Snow heat content 
    305245            DO jk = 1, nlay_i 
    306 !$OMP DO schedule(static) private(jj,ji) 
    307                DO jj = 1, jpj 
    308                   DO ji = 1, jpi 
    309                      z0ei  (ji,jj,jk,jl) = e_i  (ji,jj,jk,jl) * e1e2t(ji,jj) ! Ice  heat content 
    310                   END DO 
    311                END DO 
    312             END DO 
    313          END DO 
    314 !$OMP END PARALLEL 
     246               z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
     247            END DO 
     248         END DO 
    315249 
    316250 
    … …  
    402336         ! Recover the properties from their contents 
    403337         !------------------------------------------- 
    404 !$OMP PARALLEL 
    405 !$OMP DO schedule(static) private(jj,ji) 
    406          DO jj = 1, jpj 
    407             DO ji = 1, jpi 
    408                ato_i(ji,jj) = z0opw(ji,jj,1) * r1_e1e2t(ji,jj) 
    409             END DO 
    410          END DO 
     338         ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) 
    411339         DO jl = 1, jpl 
    412 !$OMP DO schedule(static) private(jj,ji) 
    413             DO jj = 1, jpj 
    414                DO ji = 1, jpi 
    415                   v_i  (ji,jj,  jl) = z0ice(ji,jj,jl) * r1_e1e2t(ji,jj) 
    416                   v_s  (ji,jj,  jl) = z0snw(ji,jj,jl) * r1_e1e2t(ji,jj) 
    417                   smv_i(ji,jj,  jl) = z0smi(ji,jj,jl) * r1_e1e2t(ji,jj) 
    418                   oa_i (ji,jj,  jl) = z0oi (ji,jj,jl) * r1_e1e2t(ji,jj) 
    419                   a_i  (ji,jj,  jl) = z0ai (ji,jj,jl) * r1_e1e2t(ji,jj) 
    420                   e_s  (ji,jj,1,jl) = z0es (ji,jj,jl) * r1_e1e2t(ji,jj) 
    421                END DO 
    422             END DO 
     340            v_i  (:,:,  jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) 
     341            v_s  (:,:,  jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) 
     342            smv_i(:,:,  jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) 
     343            oa_i (:,:,  jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) 
     344            a_i  (:,:,  jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) 
     345            e_s  (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:) 
    423346            DO jk = 1, nlay_i 
    424 !$OMP DO schedule(static) private(jj,ji) 
    425                DO jj = 1, jpj 
    426                   DO ji = 1, jpi 
    427                      e_i(ji,jj,jk,jl) = z0ei(ji,jj,jk,jl) * r1_e1e2t(ji,jj) 
    428                   END DO 
    429                END DO 
    430             END DO 
    431          END DO 
    432  
    433 !$OMP DO schedule(static) private(jj,ji) 
    434          DO jj = 1, jpj 
    435             DO ji = 1, jpi 
    436                at_i(ji,jj) = a_i(ji,jj,1)      ! total ice fraction 
    437             END DO 
    438          END DO 
     347               e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) 
     348            END DO 
     349         END DO 
     350 
     351         at_i(:,:) = a_i(:,:,1)      ! total ice fraction 
    439352         DO jl = 2, jpl 
    440 !$OMP DO schedule(static) private(jj,ji) 
    441             DO jj = 1, jpj 
    442                DO ji = 1, jpi 
    443                   at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
    444                END DO 
    445             END DO 
    446          END DO 
    447 !$OMP END PARALLEL 
     353            at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     354         END DO 
    448355          
    449356         CALL wrk_dealloc( jpi,jpj,            zarea ) 
    … …  
    462369         !     mask eddy diffusivity coefficient at ocean U- and V-points 
    463370         jm=1 
    464 !$OMP PARALLEL 
    465371         DO jl = 1, jpl 
    466 !$OMP DO schedule(static) private(jj,ji) 
    467372            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    468373               DO ji = 1 , fs_jpim1 
    … …  
    474379            END DO 
    475380 
    476 !$OMP DO schedule(static) private(jj,ji) 
    477             DO jj = 1, jpj 
    478                DO ji = 1, jpi 
    479                   zhdfptab(ji,jj,jm)= a_i  (ji,jj,  jl) 
    480                END DO 
    481             END DO 
    482             jm = jm + 1 
    483 !$OMP DO schedule(static) private(jj,ji) 
    484             DO jj = 1, jpj 
    485                DO ji = 1, jpi 
    486                   zhdfptab(ji,jj,jm)= v_i  (ji,jj,  jl) 
    487                END DO 
    488             END DO 
    489             jm = jm + 1 
    490 !$OMP DO schedule(static) private(jj,ji) 
    491             DO jj = 1, jpj 
    492                DO ji = 1, jpi 
    493                   zhdfptab(ji,jj,jm)= v_s  (ji,jj,  jl) 
    494                END DO 
    495             END DO 
    496             jm = jm + 1 
    497 !$OMP DO schedule(static) private(jj,ji) 
    498             DO jj = 1, jpj 
    499                DO ji = 1, jpi 
    500                   zhdfptab(ji,jj,jm)= smv_i(ji,jj,  jl) 
    501                END DO 
    502             END DO 
    503             jm = jm + 1 
    504 !$OMP DO schedule(static) private(jj,ji) 
    505             DO jj = 1, jpj 
    506                DO ji = 1, jpi 
    507                   zhdfptab(ji,jj,jm)= oa_i (ji,jj,  jl) 
    508                END DO 
    509             END DO 
    510             jm = jm + 1 
    511 !$OMP DO schedule(static) private(jj,ji) 
    512             DO jj = 1, jpj 
    513                DO ji = 1, jpi 
    514                   zhdfptab(ji,jj,jm)= e_s  (ji,jj,1,jl) 
    515                END DO 
    516             END DO 
    517             jm = jm + 1 
     381            zhdfptab(:,:,jm)= a_i  (:,:,  jl); jm = jm + 1 
     382            zhdfptab(:,:,jm)= v_i  (:,:,  jl); jm = jm + 1 
     383            zhdfptab(:,:,jm)= v_s  (:,:,  jl); jm = jm + 1 
     384            zhdfptab(:,:,jm)= smv_i(:,:,  jl); jm = jm + 1 
     385            zhdfptab(:,:,jm)= oa_i (:,:,  jl); jm = jm + 1 
     386            zhdfptab(:,:,jm)= e_s  (:,:,1,jl); jm = jm + 1 
    518387            ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 
    519388            !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1   
    520389            !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1  
    521390            DO jk = 1, nlay_i 
    522 !$OMP DO schedule(static) private(jj,ji) 
    523                DO jj = 1, jpj 
    524                   DO ji = 1, jpi 
    525                      zhdfptab(ji,jj,jm)=e_i(ji,jj,jk,jl) 
    526                   END DO 
    527                END DO 
    528                jm= jm+1 
     391              zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 
    529392            END DO 
    530393         END DO 
    … …  
    532395         ! --- Prepare diffusion for open water area --- ! 
    533396         !     mask eddy diffusivity coefficient at ocean U- and V-points 
    534 !$OMP DO schedule(static) private(jj,ji) 
    535397         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    536398            DO ji = 1 , fs_jpim1 
    … …  
    542404         END DO 
    543405         ! 
    544 !$OMP DO schedule(static) private(jj,ji) 
    545          DO jj = 1, jpj 
    546             DO ji = 1, jpi 
    547                zhdfptab(ji,jj,jm)= ato_i  (ji,jj); 
    548             END DO 
    549          END DO 
    550 !$OMP END PARALLEL 
     406         zhdfptab(:,:,jm)= ato_i  (:,:); 
    551407 
    552408         ! --- Apply diffusion --- ! 
    … …  
    555411         ! --- Recover properties --- ! 
    556412         jm=1 
    557 !$OMP PARALLEL 
    558413         DO jl = 1, jpl 
    559 !$OMP DO schedule(static) private(jj,ji) 
    560             DO jj = 1, jpj 
    561                DO ji = 1, jpi 
    562                   a_i  (ji,jj,  jl)=zhdfptab(ji,jj,jm) 
    563                END DO 
    564             END DO 
    565             jm = jm + 1 
    566 !$OMP DO schedule(static) private(jj,ji) 
    567             DO jj = 1, jpj 
    568                DO ji = 1, jpi 
    569                   v_i  (ji,jj,  jl)=zhdfptab(ji,jj,jm) 
    570                END DO 
    571             END DO 
    572             jm = jm + 1 
    573 !$OMP DO schedule(static) private(jj,ji) 
    574             DO jj = 1, jpj 
    575                DO ji = 1, jpi 
    576                   v_s  (ji,jj,  jl)=zhdfptab(ji,jj,jm) 
    577                END DO 
    578             END DO 
    579             jm = jm + 1 
    580 !$OMP DO schedule(static) private(jj,ji) 
    581             DO jj = 1, jpj 
    582                DO ji = 1, jpi 
    583                   smv_i(ji,jj,  jl)=zhdfptab(ji,jj,jm) 
    584                END DO 
    585             END DO 
    586             jm = jm + 1 
    587 !$OMP DO schedule(static) private(jj,ji) 
    588             DO jj = 1, jpj 
    589                DO ji = 1, jpi 
    590                   oa_i (ji,jj,  jl)=zhdfptab(ji,jj,jm) 
    591                END DO 
    592             END DO 
    593             jm = jm + 1 
    594 !$OMP DO schedule(static) private(jj,ji) 
    595             DO jj = 1, jpj 
    596                DO ji = 1, jpi 
    597                   e_s  (ji,jj,1,jl)=zhdfptab(ji,jj,jm) 
    598                END DO 
    599             END DO 
    600             jm = jm + 1 
    601  
     414            a_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     415            v_i  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     416            v_s  (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     417            smv_i(:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     418            oa_i (:,:,  jl) = zhdfptab(:,:,jm); jm = jm + 1 
     419            e_s  (:,:,1,jl) = zhdfptab(:,:,jm); jm = jm + 1 
    602420            ! Sample of adding more variables to apply lim_hdf 
    603421            !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1  
    604422            !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
    605423            DO jk = 1, nlay_i 
    606 !$OMP DO schedule(static) private(jj,ji) 
    607                DO jj = 1, jpj 
    608                   DO ji = 1, jpi 
    609                      e_i(ji,jj,jk,jl) = zhdfptab(ji,jj,jm) 
    610                   END DO 
    611                END DO 
    612                jm = jm + 1 
    613             END DO 
    614          END DO 
    615 !$OMP DO schedule(static) private(jj,ji) 
    616          DO jj = 1, jpj 
    617             DO ji = 1, jpi 
    618                ato_i  (ji,jj) = zhdfptab(ji,jj,jm) 
    619             END DO 
    620          END DO 
    621 !$OMP END PARALLEL 
     424               e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 
     425            END DO 
     426         END DO 
     427         ato_i  (:,:) = zhdfptab(:,:,jm) 
    622428               
    623429      ENDIF 
    624430 
    625431      ! --- diags --- 
    626 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    627432      DO jj = 1, jpj 
    628433         DO ji = 1, jpi 
    … …  
    641446            
    642447         !--- Thickness correction in case too high --- ! 
    643 !$OMP PARALLEL 
    644448         DO jl = 1, jpl 
    645 !$OMP DO schedule(static) private(jj,ji,rswitch,zdv) 
    646449            DO jj = 1, jpj 
    647450               DO ji = 1, jpi 
    … …  
    678481          
    679482         ! Force the upper limit of ht_i to always be < hi_max (99 m). 
    680 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    681483         DO jj = 1, jpj 
    682484            DO ji = 1, jpi 
    … …  
    686488            END DO 
    687489         END DO 
    688 !$OMP END PARALLEL 
    689490 
    690491      ENDIF 
    … …  
    694495      !------------------------------------------------------------ 
    695496      ! 
    696 !$OMP PARALLEL 
    697 !$OMP DO schedule(static) private(jj,ji) 
    698          DO jj = 1, jpj 
    699             DO ji = 1, jpi 
    700                at_i(ji,jj) = 0._wp 
    701             END DO 
    702          END DO 
    703          DO jl = 1, jpl 
    704 !$OMP DO schedule(static) private(jj,ji) 
    705             DO jj = 1, jpj 
    706                DO ji = 1, jpi 
    707                   at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
    708                END DO 
    709             END DO 
    710          END DO 
    711 !$OMP END PARALLEL 
    712  
     497      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    713498      IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 
    714499         DO jl = 1, jpl 
    715 !$OMP PARALLEL DO schedule(static) private(jj,ji,rswitch,zda) 
    716500            DO jj = 1, jpj 
    717501               DO ji = 1, jpi 
    … …  
    726510       
    727511      ! --- agglomerate variables ----------------- 
    728 !$OMP PARALLEL 
    729 !$OMP DO schedule(static) private(jj,ji) 
    730       DO jj = 1, jpj 
    731          DO ji = 1, jpi 
    732             vt_i(ji,jj) = 0._wp 
    733             vt_s(ji,jj) = 0._wp 
    734             at_i(ji,jj) = 0._wp 
    735          END DO 
    736       END DO 
    737       DO jl = 1, jpl 
    738 !$OMP DO schedule(static) private(jj,ji) 
    739          DO jj = 1, jpj 
    740             DO ji = 1, jpi 
    741                vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) 
    742                vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) 
    743                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
    744             END DO 
    745          END DO 
    746       END DO 
     512      vt_i(:,:) = SUM( v_i(:,:,:), dim=3 ) 
     513      vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 
     514      at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    747515       
    748516      ! --- open water = 1 if at_i=0 -------------------------------- 
    749 !$OMP DO schedule(static) private(jj,ji) 
    750       DO jj = 1, jpj 
    751          DO ji = 1, jpi 
    752             IF( at_i(ji,jj) == 0._wp ) ato_i(ji,jj) = 1._wp  
    753          END DO 
    754       END DO 
    755 !$OMP END PARALLEL 
     517      WHERE( at_i == 0._wp ) ato_i = 1._wp  
    756518       
    757519      ! conservation test 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90

    r7698 r7753  
    7070      ! ice concentration should not exceed amax  
    7171      !----------------------------------------------------- 
    72 !$OMP PARALLEL 
    73 !$OMP DO schedule(static) private(jj, ji) 
    74       DO jj = 1, jpj 
    75          DO ji = 1, jpi 
    76             at_i(ji,jj) = 0._wp 
    77          END DO 
    78       END DO 
     72      at_i(:,:) = 0._wp 
    7973      DO jl = 1, jpl 
    80 !$OMP DO schedule(static) private(jj, ji) 
    81          DO jj = 1, jpj 
    82             DO ji = 1, jpi 
    83                at_i(ji,jj) = a_i(ji,jj,jl) + at_i(ji,jj) 
    84             END DO 
    85          END DO 
     74         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    8675      END DO 
    8776 
    8877      DO jl  = 1, jpl 
    89 !$OMP DO schedule(static) private(jj, ji) 
    9078         DO jj = 1, jpj 
    9179            DO ji = 1, jpi 
    … …  
    9785         END DO 
    9886      END DO 
    99 !$OMP END PARALLEL 
    10087     
    10188      !--------------------- 
    … …  
    10491      IF (  nn_icesal == 2  ) THEN  
    10592         DO jl = 1, jpl 
    106 !$OMP PARALLEL DO schedule(static) private(jj,ji,zsal,rswitch) 
    10793            DO jj = 1, jpj  
    10894               DO ji = 1, jpi 
    … …  
    132118      ! ------------------------------------------------- 
    133119      DO jl  = 1, jpl 
    134 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    135          DO jj = 1, jpj 
    136             DO ji = 1, jpi 
    137                afx_dyn(ji,jj) = afx_dyn(ji,jj) + ( a_i(ji,jj,jl) - a_i_b(ji,jj,jl) ) * r1_rdtice 
    138             END DO 
    139          END DO 
     120         afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
    140121      END DO 
    141122 
    142 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    143123      DO jj = 1, jpj 
    144124         DO ji = 1, jpi             

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90

    r7698 r7753  
    7171      ! Constrain the thickness of the smallest category above himin 
    7272      !---------------------------------------------------------------------- 
    73 !$OMP PARALLEL 
    74 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    7573      DO jj = 1, jpj  
    7674         DO ji = 1, jpi 
    … …  
    8785      ! ice concentration should not exceed amax  
    8886      !----------------------------------------------------- 
    89 !$OMP DO schedule(static) private(jj, ji) 
    90       DO jj = 1, jpj 
    91          DO ji = 1, jpi 
    92             at_i(ji,jj) = 0._wp 
    93          END DO 
    94       END DO 
     87      at_i(:,:) = 0._wp 
    9588      DO jl = 1, jpl 
    96 !$OMP DO schedule(static) private(jj, ji) 
    97          DO jj = 1, jpj 
    98             DO ji = 1, jpi 
    99                at_i(ji,jj) = a_i(ji,jj,jl) + at_i(ji,jj) 
    100             END DO 
    101          END DO 
     89         at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
    10290      END DO 
    10391 
    10492      DO jl  = 1, jpl 
    105 !$OMP DO schedule(static) private(jj, ji) 
    10693         DO jj = 1, jpj 
    10794            DO ji = 1, jpi 
    … …  
    113100         END DO 
    114101      END DO 
    115 !$OMP END PARALLEL 
    116102 
    117103      !--------------------- 
    … …  
    120106      IF (  nn_icesal == 2  ) THEN  
    121107         DO jl = 1, jpl 
    122 !$OMP PARALLEL DO schedule(static) private(jj,ji,zsal,rswitch) 
    123108            DO jj = 1, jpj  
    124109               DO ji = 1, jpi 
    … …  
    149134      ! Ice drift 
    150135      !------------ 
    151 !$OMP PARALLEL DO schedule(static) private(jj, ji) 
    152136      DO jj = 2, jpjm1 
    153137         DO ji = 2, jpim1 
    … …  
    164148      CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    165149      !mask velocities 
    166 !$OMP PARALLEL 
    167 !$OMP DO schedule(static) private(jj, ji) 
    168       DO jj = 1, jpj 
    169          DO ji = 1, jpi 
    170             u_ice(ji,jj) = u_ice(ji,jj) * umask(ji,jj,1) 
    171             v_ice(ji,jj) = v_ice(ji,jj) * vmask(ji,jj,1) 
    172          END DO 
    173       END DO 
     150      u_ice(:,:) = u_ice(:,:) * umask(:,:,1) 
     151      v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 
    174152  
    175153      ! ------------------------------------------------- 
    … …  
    177155      ! ------------------------------------------------- 
    178156      DO jl  = 1, jpl 
    179 !$OMP DO schedule(static) private(jj, ji) 
    180          DO jj = 1, jpj 
    181             DO ji = 1, jpi 
    182                oa_i(ji,jj,jl) = oa_i(ji,jj,jl) + a_i(ji,jj,jl) * rdt_ice / rday   ! ice natural aging 
    183                afx_thd(ji,jj) = afx_thd(ji,jj) + ( a_i(ji,jj,jl) - a_i_b(ji,jj,jl) ) * r1_rdtice 
    184             END DO 
    185          END DO 
     157         oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday   ! ice natural aging 
     158         afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
    186159      END DO 
    187160      afx_tot = afx_thd + afx_dyn 
    188161 
    189 !$OMP DO schedule(static) private(jj, ji) 
    190162      DO jj = 1, jpj 
    191163         DO ji = 1, jpi             
    … …  
    201173         END DO 
    202174      END DO 
    203 !$OMP END PARALLEL 
    204175 
    205176      ! conservation test 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r7698 r7753  
    8080      !!------------------------------------------------------------------ 
    8181      INTEGER, INTENT( in ) ::   kn     ! =1 at_i & vt only ; = what is needed 
    82       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_s, ze_i 
    8382      ! 
    8483      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    8584      !!------------------------------------------------------------------ 
    8685 
    87       CALL wrk_alloc( jpi, jpj, nlay_s, ze_s ) 
    88       CALL wrk_alloc( jpi, jpj, nlay_i, ze_i ) 
    8986      ! integrated values 
    90 !$OMP PARALLEL 
    91 !$OMP DO schedule(static) private(jj, ji) 
    92       DO jj = 1, jpj 
    93          DO ji = 1, jpi 
    94             vt_i (ji,jj) = 0._wp 
    95             vt_s (ji,jj) = 0._wp 
    96             at_i (ji,jj) = 0._wp 
    97             et_s(ji,jj)  = 0._wp 
    98             et_i(ji,jj)  = 0._wp 
    99          END DO 
    100       END DO 
    101       DO jl = 1, jpl 
    102 !$OMP DO schedule(static) private(jj, ji) 
    103          DO jj = 1, jpj 
    104             DO ji = 1, jpi 
    105                vt_i (ji,jj) = vt_i (ji,jj) + v_i (ji,jj,jl) 
    106                vt_s (ji,jj) = vt_s (ji,jj) + v_s (ji,jj,jl) 
    107                at_i (ji,jj) = at_i (ji,jj) + a_i (ji,jj,jl) 
    108             END DO 
    109          END DO 
    110       END DO 
    111       DO jk = 1, nlay_s 
    112 !$OMP DO schedule(static) private(jj, ji) 
    113          DO jj = 1, jpj 
    114             DO ji = 1, jpi 
    115                ze_s(ji,jj,jk)  = 0._wp 
    116             END DO 
    117          END DO 
    118       END DO 
    119       DO jk = 1, nlay_i 
    120 !$OMP DO schedule(static) private(jj, ji) 
    121          DO jj = 1, jpj 
    122             DO ji = 1, jpi 
    123                ze_i(ji,jj,jk)  = 0._wp 
    124             END DO 
    125          END DO 
    126       END DO 
    127       DO jl = 1, jpl 
    128          DO jk = 1, nlay_s 
    129 !$OMP DO schedule(static) private(jj, ji) 
    130             DO jj = 1, jpj 
    131                DO ji = 1, jpi 
    132                   ze_s(ji,jj,jk)  = ze_s(ji,jj,jk) + e_s(ji,jj,jk,jl) 
    133                END DO 
    134             END DO 
    135          END DO 
    136       END DO 
    137       DO jl = 1, jpl 
    138          DO jk = 1, nlay_i 
    139 !$OMP DO schedule(static) private(jj, ji) 
    140             DO jj = 1, jpj 
    141                DO ji = 1, jpi 
    142                   ze_i(ji,jj,jk)  = ze_i(ji,jj,jk) + e_i(ji,jj,jk,jl) 
    143                END DO 
    144             END DO 
    145          END DO 
    146       END DO 
    147       DO jk = 1, nlay_s 
    148 !$OMP DO schedule(static) private(jj, ji) 
    149          DO jj = 1, jpj 
    150             DO ji = 1, jpi 
    151                et_s(ji,jj)  = et_s(ji,jj) + ze_s(ji,jj,jk) 
    152             END DO 
    153          END DO 
    154       END DO 
    155       DO jk = 1, nlay_i 
    156 !$OMP DO schedule(static) private(jj, ji) 
    157          DO jj = 1, jpj 
    158             DO ji = 1, jpi 
    159                et_i(ji,jj)  = et_i(ji,jj) + ze_i(ji,jj,jk) 
    160             END DO 
    161          END DO 
    162       END DO 
     87      vt_i (:,:) = SUM( v_i, dim=3 ) 
     88      vt_s (:,:) = SUM( v_s, dim=3 ) 
     89      at_i (:,:) = SUM( a_i, dim=3 ) 
     90      et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 
     91      et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 
    16392 
    16493      ! open water fraction 
    165 !$OMP DO schedule(static) private(jj, ji) 
    16694      DO jj = 1, jpj 
    16795         DO ji = 1, jpi 
    … …  
    16997         END DO 
    17098      END DO 
    171 !$OMP END PARALLEL 
    17299 
    173100      IF( kn > 1 ) THEN 
    174101 
    175 !$OMP PARALLEL 
    176102         ! mean ice/snow thickness 
    177 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    178103         DO jj = 1, jpj 
    179104            DO ji = 1, jpi 
    … …  
    185110 
    186111         ! mean temperature (K), salinity and age 
    187 !$OMP DO schedule(static) private(jj,ji) 
    188          DO jj = 1, jpj 
    189             DO ji = 1, jpi 
    190                smt_i(ji,jj) = 0._wp 
    191                tm_i(ji,jj)  = 0._wp 
    192                tm_su(ji,jj) = 0._wp 
    193                om_i (ji,jj) = 0._wp 
    194             ENDDO 
    195          ENDDO 
     112         smt_i(:,:) = 0._wp 
     113         tm_i(:,:)  = 0._wp 
     114         tm_su(:,:) = 0._wp 
     115         om_i (:,:) = 0._wp 
    196116         DO jl = 1, jpl 
    197117             
    198 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    199118            DO jj = 1, jpj 
    200119               DO ji = 1, jpi 
    … …  
    206125             
    207126            DO jk = 1, nlay_i 
    208 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    209127               DO jj = 1, jpj 
    210128                  DO ji = 1, jpi 
    … …  
    218136            END DO 
    219137         END DO 
    220 !$OMP END PARALLEL 
    221138         tm_i  = tm_i  + rt0 
    222139         tm_su = tm_su + rt0 
    223140         ! 
    224141      ENDIF 
    225       CALL wrk_dealloc( jpi, jpj, nlay_s, ze_s ) 
    226       CALL wrk_dealloc( jpi, jpj, nlay_i, ze_i ) 
    227142      ! 
    228143   END SUBROUTINE lim_var_agg 
    … …  
    244159      ! Ice thickness, snow thickness, ice salinity, ice age 
    245160      !------------------------------------------------------- 
    246 !$OMP PARALLEL 
    247       DO jl = 1, jpl 
    248 !$OMP DO schedule(static) private(jj,ji,rswitch) 
     161      DO jl = 1, jpl 
    249162         DO jj = 1, jpj 
    250163            DO ji = 1, jpi 
    … …  
    255168      END DO 
    256169      ! Force the upper limit of ht_i to always be < hi_max (99 m). 
    257 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    258170      DO jj = 1, jpj 
    259171         DO ji = 1, jpi 
    … …  
    265177 
    266178      DO jl = 1, jpl 
    267 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    268179         DO jj = 1, jpj 
    269180            DO ji = 1, jpi 
    … …  
    277188      IF(  nn_icesal == 2  )THEN 
    278189         DO jl = 1, jpl 
    279 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    280190            DO jj = 1, jpj 
    281191               DO ji = 1, jpi 
    … …  
    288198         END DO 
    289199      ENDIF 
    290 !$OMP END PARALLEL 
    291200 
    292201      CALL lim_var_salprof      ! salinity profile 
    … …  
    295204      ! Ice temperatures 
    296205      !------------------- 
    297 !$OMP PARALLEL 
    298206      DO jl = 1, jpl 
    299207         DO jk = 1, nlay_i 
    300 !$OMP DO schedule(static) private(jj,ji,rswitch,zq_i,ztmelts,zaaa,zbbb,zccc,zdiscrim) 
    301208            DO jj = 1, jpj 
    302209               DO ji = 1, jpi 
    … …  
    324231      DO jl = 1, jpl 
    325232         DO jk = 1, nlay_s 
    326 !$OMP DO schedule(static) private(jj,ji,rswitch,zq_s) 
    327233            DO jj = 1, jpj 
    328234               DO ji = 1, jpi 
    … …  
    339245 
    340246      ! integrated values 
    341 !$OMP DO schedule(static) private(jj, ji) 
    342       DO jj = 1, jpj 
    343          DO ji = 1, jpi 
    344             vt_i (ji,jj) = 0._wp 
    345             vt_s (ji,jj) = 0._wp 
    346             at_i (ji,jj) = 0._wp 
    347          END DO 
    348       END DO 
    349       DO jl = 1, jpl 
    350 !$OMP DO schedule(static) private(jj, ji) 
    351          DO jj = 1, jpj 
    352             DO ji = 1, jpi 
    353                vt_i (ji,jj) = vt_i (ji,jj) + v_i (ji,jj,jl) 
    354                vt_s (ji,jj) = vt_s (ji,jj) + v_s (ji,jj,jl) 
    355                at_i (ji,jj) = at_i (ji,jj) + a_i (ji,jj,jl) 
    356             END DO 
    357          END DO 
    358       END DO 
    359 !$OMP END PARALLEL 
     247      vt_i (:,:) = SUM( v_i, dim=3 ) 
     248      vt_s (:,:) = SUM( v_s, dim=3 ) 
     249      at_i (:,:) = SUM( a_i, dim=3 ) 
     250 
    360251      ! 
    361252   END SUBROUTINE lim_var_glo2eqv 
    … …  
    409300      !--------------------------------------- 
    410301      IF(  nn_icesal == 1  )  THEN 
    411 !$OMP PARALLEL 
    412          DO jl = 1, jpl 
    413             DO jk = 1, nlay_i 
    414 !$OMP DO schedule(static) private(jj, ji) 
    415                DO jj = 1, jpj 
    416                   DO ji = 1, jpi 
    417                      s_i (ji,jj,jk,jl) = rn_icesal 
    418                   END DO 
    419                END DO 
    420             END DO 
    421          END DO 
    422          DO jl = 1, jpl  
    423 !$OMP DO schedule(static) private(jj, ji) 
    424             DO jj = 1, jpj 
    425                DO ji = 1, jpi 
    426                   sm_i(ji,jj,jl)   = rn_icesal 
    427                END DO 
    428             END DO 
    429          END DO 
    430 !$OMP END PARALLEL 
     302         s_i (:,:,:,:) = rn_icesal 
     303         sm_i(:,:,:)   = rn_icesal 
    431304      ENDIF 
    432305 
    … …  
    436309      IF(  nn_icesal == 2  ) THEN 
    437310         ! 
    438 !$OMP PARALLEL 
    439          DO jl = 1, jpl 
    440             DO jk = 1, nlay_i 
    441 !$OMP DO schedule(static) private(jj, ji) 
    442                DO jj = 1, jpj 
    443                   DO ji = 1, jpi 
    444                      s_i(ji,jj,jk,jl)  = sm_i(ji,jj,jl) 
    445                   END DO 
    446                END DO 
    447 !$OMP END DO NOWAIT 
    448             END DO 
     311         DO jk = 1, nlay_i 
     312            s_i(:,:,jk,:)  = sm_i(:,:,:) 
    449313         END DO 
    450314         ! 
    451315         DO jl = 1, jpl                               ! Slope of the linear profile  
    452 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    453316            DO jj = 1, jpj 
    454317               DO ji = 1, jpi 
    … …  
    457320               END DO 
    458321            END DO 
    459 !$OMP END DO NOWAIT 
    460322         END DO 
    461323         ! 
    … …  
    463325         zfac1 = zsi1  / ( zsi1 - zsi0 ) 
    464326         ! 
     327         zalpha(:,:,:) = 0._wp 
    465328         DO jl = 1, jpl 
    466 !$OMP DO schedule(static) private(jj, ji) 
    467             DO jj = 1, jpj 
    468                DO ji = 1, jpi 
    469                   zalpha(ji,jj,jl) = 0._wp 
    470                END DO 
    471             END DO 
    472          END DO 
    473          DO jl = 1, jpl 
    474 !$OMP DO schedule(static) private(jj,ji,zswi0,zswi01,rswitch) 
    475329            DO jj = 1, jpj 
    476330               DO ji = 1, jpi 
    … …  
    491345         DO jl = 1, jpl 
    492346            DO jk = 1, nlay_i 
    493 !$OMP DO schedule(static) private(jj,ji,zs_zero) 
    494347               DO jj = 1, jpj 
    495348                  DO ji = 1, jpi 
    … …  
    504357            END DO 
    505358         END DO 
    506 !$OMP END PARALLEL 
    507359         ! 
    508360      ENDIF ! nn_icesal 
    … …  
    514366      IF(  nn_icesal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    515367         ! 
    516 !$OMP PARALLEL 
    517          DO jl = 1, jpl 
    518 !$OMP DO schedule(static) private(jj,ji) 
    519             DO jj = 1, jpj 
    520                DO ji = 1, jpi 
    521                   sm_i(ji,jj,jl) = 2.30_wp 
    522                END DO 
    523             END DO 
    524 !$OMP END DO NOWAIT 
    525          END DO 
     368         sm_i(:,:,:) = 2.30_wp 
    526369         ! 
    527370         DO jl = 1, jpl 
    … …  
    529372               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    530373               zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    531 !$OMP DO schedule(static) private(jj,ji) 
    532                DO jj = 1, jpj 
    533                   DO ji = 1, jpi 
    534                      s_i(ji,jj,jk,jl) =  zsal 
    535                   END DO 
    536                END DO 
    537             END DO 
    538          END DO 
    539 !$OMP END PARALLEL 
     374               s_i(:,:,jk,jl) =  zsal 
     375            END DO 
     376         END DO 
    540377         ! 
    541378      ENDIF ! nn_icesal 
    … …  
    559396      !!------------------------------------------------------------------ 
    560397      ! 
    561 !$OMP PARALLEL 
    562 !$OMP DO schedule(static) private(jj,ji) 
    563       DO jj = 1, jpj 
    564          DO ji = 1, jpi 
    565             bvm_i(ji,jj) = 0._wp 
    566          END DO 
    567       END DO 
    568       DO jl = 1, jpl 
    569 !$OMP DO schedule(static) private(jj,ji) 
    570          DO jj = 1, jpj 
    571             DO ji = 1, jpi 
    572                bv_i (ji,jj,jl) = 0._wp 
    573             END DO 
    574          END DO 
    575       END DO 
     398      bvm_i(:,:)   = 0._wp 
     399      bv_i (:,:,:) = 0._wp 
    576400      DO jl = 1, jpl 
    577401         DO jk = 1, nlay_i 
    578 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    579402            DO jj = 1, jpj 
    580403               DO ji = 1, jpi 
    … …  
    586409         END DO 
    587410          
    588 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    589411         DO jj = 1, jpj 
    590412            DO ji = 1, jpi 
    … …  
    594416         END DO 
    595417      END DO 
    596 !$OMP END PARALLEL 
    597418      ! 
    598419   END SUBROUTINE lim_var_bv 
    … …  
    697518      REAL(wp) ::   zsal, zvi, zvs, zei, zes 
    698519      !!------------------------------------------------------------------- 
    699 !$OMP PARALLEL 
    700 !$OMP DO schedule(static) private(jj,ji) 
    701       DO jj = 1, jpj 
    702          DO ji = 1, jpi 
    703             at_i (ji,jj) = 0._wp 
    704          END DO 
    705       END DO 
    706       DO jl = 1, jpl 
    707 !$OMP DO schedule(static) private(jj,ji) 
    708          DO jj = 1, jpj 
    709             DO ji = 1, jpi 
    710                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
    711             END DO 
    712          END DO 
     520      at_i (:,:) = 0._wp 
     521      DO jl = 1, jpl 
     522         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    713523      END DO 
    714524 
    … …  
    719529         !----------------------------------------------------------------- 
    720530         DO jk = 1, nlay_i 
    721 !$OMP DO schedule(static) private(jj,ji,rswitch,zei) 
    722531            DO jj = 1 , jpj 
    723532               DO ji = 1 , jpi 
    … …  
    736545         END DO 
    737546 
    738 !$OMP DO schedule(static) private(jj,ji,rswitch,zsal,zvi,zvs,zes) 
    739547         DO jj = 1 , jpj 
    740548            DO ji = 1 , jpi 
    … …  
    775583 
    776584      ! to be sure that at_i is the sum of a_i(jl) 
    777 !$OMP DO schedule(static) private(jj,ji) 
    778       DO jj = 1, jpj 
    779          DO ji = 1, jpi 
    780             at_i (ji,jj) = 0._wp 
    781          END DO 
    782       END DO 
    783       DO jl = 1, jpl 
    784 !$OMP DO schedule(static) private(jj,ji) 
    785          DO jj = 1, jpj 
    786             DO ji = 1, jpi 
    787                at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) 
    788             END DO 
    789          END DO 
     585      at_i (:,:) = 0._wp 
     586      DO jl = 1, jpl 
     587         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    790588      END DO 
    791589 
    792590      ! open water = 1 if at_i=0 
    793 !$OMP DO schedule(static) private(jj,ji,rswitch) 
    794591      DO jj = 1, jpj 
    795592         DO ji = 1, jpi 
    … …  
    798595         END DO 
    799596      END DO 
    800 !$OMP END PARALLEL 
    801597 
    802598      ! 

  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90

    r7698 r7753  
    7474 
    7575      ! tresholds for outputs 
    76 !$OMP PARALLEL 
    77 !$OMP DO schedule(static) private(jj,ji) 
    7876      DO jj = 1, jpj 
    7977         DO ji = 1, jpi 
    … …  
    8280      END DO 
    8381      DO jl = 1, jpl 
    84 !$OMP DO schedule(static) private(jj,ji) 
    8582         DO jj = 1, jpj 
    8683            DO ji = 1, jpi 
    … …  
    8986         END DO 
    9087      END DO 
    91 !$OMP END PARALLEL 
    9288      ! 
    9389      ! fluxes 
    … …  
    108104      ! velocity 
    109105      IF ( iom_use( "uice_ipa" ) .OR. iom_use( "vice_ipa" ) .OR. iom_use( "icevel" ) ) THEN  
    110 !$OMP PARALLEL DO schedule(static) private(jj,ji,z2da,z2db) 
    111106         DO jj = 2 , jpjm1 
    112107            DO ji = 2 , jpim1 
    … …  
    178173 
    179174      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations   
    180 !$OMP PARALLEL DO schedule(static) private(jj,ji) 
    181          DO jj = 1, jpj 
    182             DO ji = 1, jpi 
    183                IF (htm_i(ji,jj) < 0.2 .AND. htm_i(ji,jj) > 0. ) THEN 
    184                   z2d(ji,jj) = wfx_bog(ji,jj) 
    185                ELSE 
    186                   z2d(ji,jj) = 0._wp 
    187                END IF 
    188             END DO 
    189          END DO 
     175         WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 
     176         ELSEWHERE                                       ; z2d = 0._wp 
     177         END WHERE 
    190178         CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 
    191179      ENDIF 
Note: See TracChangeset for help on using the changeset viewer.