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

Changeset 7698


Ignore:
Timestamp:
2017-02-18T10:02:03+01:00 (7 years ago)
Author:
mocavero
Message:

update trunk with OpenMP parallelization

Location:
trunk/NEMOGCM
Files:
122 edited

Legend:

Unmodified
Added
Removed

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

    r7646 r7698  
    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) 
    7779      DO jj = 1, jpjm1         ! upstream tracer flux in the i and j direction 
    7880         DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    8688      END DO 
    8789       
     90!$OMP DO schedule(static) private(jj,ji,ztra) 
    8891      DO jj = 2, jpjm1            ! total intermediate advective trends 
    8992         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    9598         END DO 
    9699      END DO 
     100!$OMP END PARALLEL 
    97101      CALL lbc_lnk( zt_ups, 'T', 1. )        ! Lateral boundary conditions   (unchanged sign) 
    98102       
    … …  
    101105      SELECT CASE( nn_limadv_ord ) 
    102106      CASE ( 20 )                          ! centered second order 
     107!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    103108         DO jj = 2, jpjm1 
    104109            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    111116         CALL macho( kt, nn_limadv_ord, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v ) 
    112117         ! 
     118!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    113119         DO jj = 2, jpjm1 
    114120            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    122128      ! antidiffusive flux : high order minus low order 
    123129      ! -------------------------------------------------- 
     130!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    124131      DO jj = 2, jpjm1 
    125132         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    136143      ! final trend with corrected fluxes 
    137144      ! ------------------------------------ 
     145!$OMP PARALLEL DO schedule(static) private(jj,ji,ztra) 
    138146      DO jj = 2, jpjm1 
    139147         DO ji = fs_2, fs_jpim1   ! vector opt.   
    … …  
    187195         ! 
    188196         !                                                           !--  advective form update in zzt  --! 
     197!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    189198         DO jj = 2, jpjm1 
    190199            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    205214         ! 
    206215         !                                                           !--  advective form update in zzt  --! 
     216!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    207217         DO jj = 2, jpjm1 
    208218            DO ji = fs_2, fs_jpim1 
    … …  
    253263      ! 
    254264      !                                                     !--  Laplacian in i-direction  --! 
     265!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    255266      DO jj = 2, jpjm1         ! First derivative (gradient) 
    256267         DO ji = 1, fs_jpim1 
    … …  
    265276      ! 
    266277      !                                                     !--  BiLaplacian in i-direction  --! 
     278!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    267279      DO jj = 2, jpjm1         ! Third derivative 
    268280         DO ji = 1, fs_jpim1 
    … …  
    281293      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21) 
    282294         !         
     295!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    283296         DO jj = 1, jpj 
    284297            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    290303      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23) 
    291304         ! 
     305!$OMP PARALLEL DO schedule(static) private(jj,ji,zcu) 
    292306         DO jj = 1, jpj 
    293307            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    301315      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24) 
    302316         ! 
     317!$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2) 
    303318         DO jj = 1, jpj 
    304319            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    315330      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27) 
    316331         ! 
     332!$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2) 
    317333         DO jj = 1, jpj 
    318334            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    329345      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29) 
    330346         ! 
     347!$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2,zdx4) 
    331348         DO jj = 1, jpj 
    332349            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    380397      ! 
    381398      !                                                     !--  Laplacian in j-direction  --! 
     399!$OMP PARALLEL 
     400!$OMP DO schedule(static) private(jj,ji) 
    382401      DO jj = 1, jpjm1         ! First derivative (gradient) 
    383402         DO ji = fs_2, fs_jpim1 
    … …  
    385404         END DO 
    386405      END DO 
     406!$OMP DO schedule(static) private(jj,ji) 
    387407      DO jj = 2, jpjm1         ! Second derivative (Laplacian) 
    388408         DO ji = fs_2, fs_jpim1 
    … …  
    390410         END DO 
    391411      END DO 
     412!$OMP END PARALLEL 
    392413      CALL lbc_lnk( ztv2, 'T', 1. ) 
    393414      ! 
    394415      !                                                     !--  BiLaplacian in j-direction  --! 
     416!$OMP PARALLEL 
     417!$OMP DO schedule(static) private(jj,ji) 
    395418      DO jj = 1, jpjm1         ! First derivative 
    396419         DO ji = fs_2, fs_jpim1 
    … …  
    398421         END DO 
    399422      END DO 
     423!$OMP DO schedule(static) private(jj,ji) 
    400424      DO jj = 2, jpjm1         ! Second derivative 
    401425         DO ji = fs_2, fs_jpim1 
    … …  
    403427         END DO 
    404428      END DO 
     429!$OMP END PARALLEL 
    405430      CALL lbc_lnk( ztv4, 'T', 1. ) 
    406431      ! 
    … …  
    410435      CASE( 1 )                                                   !==  1st order central TIM  ==! (Eq. 21) 
    411436         !         
     437!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    412438         DO jj = 1, jpjm1 
    413439            DO ji = 1, jpi 
    … …  
    418444         ! 
    419445      CASE( 2 )                                                   !==  2nd order central TIM  ==! (Eq. 23) 
     446!$OMP PARALLEL DO schedule(static) private(jj,ji,zcv) 
    420447         DO jj = 1, jpjm1 
    421448            DO ji = 1, jpi 
    … …  
    429456      CASE( 3 )                                                   !==  3rd order central TIM  ==! (Eq. 24) 
    430457         ! 
     458!$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2) 
    431459         DO jj = 1, jpjm1 
    432460            DO ji = 1, jpi 
    … …  
    443471      CASE( 4 )                                                   !==  4th order central TIM  ==! (Eq. 27) 
    444472         ! 
     473!$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2) 
    445474         DO jj = 1, jpjm1 
    446475            DO ji = 1, jpi 
    … …  
    457486      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29) 
    458487         ! 
     488!$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2,zdy4) 
    459489         DO jj = 1, jpjm1 
    460490            DO ji = 1, jpi 
    … …  
    513543 
    514544      ! clem test 
     545!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    515546      DO jj = 2, jpjm1 
    516547         DO ji = fs_2, fs_jpim1   ! vector opt.   
    … …  
    522553 
    523554      ! Determine ice masks for before and after tracers  
    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 
     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 
    527565 
    528566      ! Search local extrema 
    … …  
    533571!      zbdo(:,:) = MIN( pbef(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ),   & 
    534572!         &             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(:,:) )  ) 
    539573 
    540574      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) 
    541588      DO jj = 2, jpjm1 
    542589         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    557604         END DO 
    558605      END DO 
     606!$OMP END PARALLEL 
    559607      CALL lbc_lnk_multi( zbetup, 'T', 1., zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
    560608 
    561609      ! monotonic flux in the i & j direction (paa & pbb) 
    562610      ! ------------------------------------- 
     611!$OMP PARALLEL DO schedule(static) private(jj,ji,zau,zbu,zcu,zav,zbv,zcv) 
    563612      DO jj = 2, jpjm1 
    564613         DO ji = fs_2, fs_jpim1   ! vector opt. 

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

    r7646 r7698  
    5858      INTEGER, INTENT(in) ::   kt     ! number of iteration 
    5959      !! 
    60       INTEGER  :: jl, jk ! dummy loop indices 
     60      INTEGER  :: ji, jj, 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       ! ice velocities before rheology 
    72       u_ice_b(:,:) = u_ice(:,:) * umask(:,:,1) 
    73       v_ice_b(:,:) = v_ice(:,:) * vmask(:,:,1) 
     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) 
    7477       
    75       ! Landfast ice parameterization: define max bottom friction 
    76       tau_icebfr(:,:) = 0._wp 
     78            ! Landfast ice parameterization: define max bottom friction 
     79            tau_icebfr(ji,jj) = 0._wp 
     80         END DO 
     81      END DO 
    7782      IF( ln_landfast ) THEN 
    7883         DO jl = 1, jpl 
    79             WHERE( ht_i(:,:,jl) > ht_n(:,:) * rn_gamma )  tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 
     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 
    8090         END DO 
    8191      ENDIF 

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

    r7646 r7698  
    254254 
    255255      CASE( 0 ) 
    256          ahiu(:,:) = rn_ahi0_ref 
    257          ahiv(:,:) = rn_ahi0_ref 
     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 
    258263 
    259264         IF(lwp) WRITE(numout,*) '' 
    … …  
    265270         IF( lk_mpp )   CALL mpp_max( zd_max )          ! max over the global domain 
    266271          
    267          ahiu(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp   ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
     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 
    268276                                                        !                    (60deg = min latitude for ice cover)   
    269          ahiv(:,:) = rn_ahi0_ref * zd_max * 1.e-05_wp 
     277               ahiv(ji,jj) = rn_ahi0_ref * zd_max * 1.e-05_wp 
     278            END DO 
     279         END DO 
    270280 
    271281         IF(lwp) WRITE(numout,*) '' 
    … …  
    280290         za00 = rn_ahi0_ref * 1.e-05_wp          ! 1.e05 = 100km = max grid space at 60deg latitude in orca2 
    281291                                                 !                    (60deg = min latitude for ice cover)   
     292!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    282293         DO jj = 1, jpj 
    283294            DO ji = 1, jpi 

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

    r7646 r7698  
    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 , POINTER, DIMENSION(:)     :: itest 
     88      INTEGER , DIMENSION(4)     :: 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 ) 
    9594 
    9695      IF(lwp) WRITE(numout,*) 
    … …  
    106105      ! init surface temperature 
    107106      DO jl = 1, jpl 
    108          t_su  (:,:,jl) = rt0 * tmask(:,:,1) 
    109          tn_ice(:,:,jl) = rt0 * tmask(:,:,1) 
     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 
    110114      END DO 
    111115 
    112116      ! init basal temperature (considered at freezing point) 
    113117      CALL eos_fzp( sss_m(:,:), t_bo(:,:) ) 
    114       t_bo(:,:) = ( t_bo(:,:) + rt0 ) * tmask(:,:,1)  
     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 
    115124 
    116125 
    … …  
    122131         IF( ln_limini_file )THEN 
    123132         ! 
    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             ! 
     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         ! 
    135149         ELSE ! ln_limini_file = F 
    136150 
    … …  
    139153            !-------------------------------------------------------------------- 
    140154            ! no ice if sst <= t-freez + ttest 
    141             WHERE( ( sst_m(:,:) - (t_bo(:,:) - rt0) ) * tmask(:,:,1) >= rn_thres_sst ) ; zswitch(:,:) = 0._wp  
    142             ELSEWHERE                                                                  ; zswitch(:,:) = tmask(:,:,1) 
    143             END WHERE 
     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 
    144166 
    145167            !----------------------------- 
    … …  
    147169            !----------------------------- 
    148170            ! assign initial thickness, concentration, snow depth and salinity to an hemisphere-dependent array 
     171!$OMP DO schedule(static) private(jj,ji) 
    149172            DO jj = 1, jpj 
    150173               DO ji = 1, jpi 
    … …  
    166189               END DO 
    167190            END DO 
     191!$OMP END PARALLEL 
    168192            ! 
    169193         ENDIF ! ln_limini_file 
    170194          
    171          zvt_i_ini(:,:) = zht_i_ini(:,:) * zat_i_ini(:,:)   ! ice volume 
     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 
    172202         !--------------------------------------------------------------------- 
    173203         ! 3.2) Distribute ice concentration and thickness into the categories 
    … …  
    176206         ! then we check whether the distribution fullfills 
    177207         ! volume and area conservation, positivity and ice categories bounds 
    178          zh_i_ini(:,:,:) = 0._wp  
    179          za_i_ini(:,:,:) = 0._wp 
     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 
    180217         ! 
     218!$OMP DO schedule(static) private(jj,ji,jl0,jl,i_fill,zarg,zV,zdv,zconv,itest) 
    181219         DO jj = 1, jpj 
    182220            DO ji = 1, jpi 
    … …  
    289327            END DO    
    290328         END DO    
     329!$OMP END PARALLEL 
    291330 
    292331         !--------------------------------------------------------------------- 
    … …  
    296335         ! Ice concentration, thickness and volume, ice salinity, ice age, surface temperature 
    297336         DO jl = 1, jpl ! loop over categories 
     337!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    298338            DO jj = 1, jpj 
    299339               DO ji = 1, jpi 
    … …  
    333373         ENDIF 
    334374             
     375!$OMP PARALLEL 
    335376         ! Snow temperature and heat content 
    336377         DO jk = 1, nlay_s 
    337378            DO jl = 1, jpl ! loop over categories 
     379!$OMP DO schedule(static) private(jj,ji) 
    338380               DO jj = 1, jpj 
    339381                  DO ji = 1, jpi 
    … …  
    352394         DO jk = 1, nlay_i 
    353395            DO jl = 1, jpl ! loop over categories 
     396!$OMP DO schedule(static) private(jj,ji) 
    354397               DO jj = 1, jpj 
    355398                  DO ji = 1, jpi 
    … …  
    370413         END DO 
    371414 
    372          tn_ice (:,:,:) = t_su (:,:,:) 
     415         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 
     421            END DO 
     422         END DO 
     423!$OMP END PARALLEL 
    373424 
    374425      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 
     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 
    387464 
    388465         DO jl = 1, jpl 
    389466            DO jk = 1, nlay_i 
    390                t_i(:,:,jk,jl) = rt0 * tmask(:,:,1) 
     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 
    391473            END DO 
    392474            DO jk = 1, nlay_s 
    393                t_s(:,:,jk,jl) = rt0 * tmask(:,:,1) 
    394             END DO 
    395          END DO 
     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 
    396484 
    397485      ENDIF ! ln_limini 
    398486       
    399       at_i (:,:) = 0.0_wp 
     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 
    400494      DO jl = 1, jpl 
    401          at_i (:,:) = at_i (:,:) + a_i (:,:,jl) 
     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 
    402501      END DO 
    403502      ! 
    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 
     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 
    446574 
    447575!!!clem 
    … …  
    453581      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 ) 
    454582      CALL wrk_dealloc( jpi, jpj,      zswitch ) 
    455       Call wrk_dealloc( 4,             itest ) 
    456583 
    457584   END SUBROUTINE lim_istate 

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

    r7646 r7698  
    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 
    117118      ! 
    118119      INTEGER, PARAMETER ::   nitermax = 20     
    … …  
    122123      IF( nn_timing == 1 )  CALL timing_start('limitd_me') 
    123124 
    124       CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross ) 
     125      CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, z_ai ) 
    125126 
    126127      ! conservation test 
    … …  
    135136      ! 
    136137 
     138!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    137139      DO jj = 1, jpj                                     ! Initialize arrays. 
    138140         DO ji = 1, jpi 
    … …  
    192194         !  closing rate to a gross closing rate.   
    193195         ! NOTE: 0 < aksum <= 1 
    194          closing_gross(:,:) = closing_net(:,:) / aksum(:,:) 
     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 
    195203 
    196204         ! correction to closing rate and opening if closing rate is excessive 
    … …  
    198206         ! Reduce the closing rate if more than 100% of the open water  
    199207         ! would be removed.  Reduce the opening rate proportionately. 
     208!$OMP DO schedule(static) private(jj,ji,za,zfac) 
    200209         DO jj = 1, jpj 
    201210            DO ji = 1, jpi 
    … …  
    216225         ! would be removed.  Reduce the opening rate proportionately. 
    217226         DO jl = 1, jpl 
     227!$OMP DO schedule(static) private(jj,ji,za,zfac) 
    218228            DO jj = 1, jpj 
    219229               DO ji = 1, jpi 
    … …  
    226236            END DO 
    227237         END DO 
     238!$OMP END PARALLEL 
    228239 
    229240         ! 3.3 Redistribute area, volume, and energy. 
    … …  
    236247         !-----------------------------------------------------------------------------! 
    237248         ! This is in general not equal to one because of divergence during transport 
    238          asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 
     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 
    239271 
    240272         ! 3.5 Do we keep on iterating ??? 
    … …  
    244276 
    245277         iterate_ridging = 0 
     278!$OMP DO schedule(static) private(jj,ji) 
    246279         DO jj = 1, jpj 
    247280            DO ji = 1, jpi 
    … …  
    258291            END DO 
    259292         END DO 
     293!$OMP END PARALLEL 
    260294 
    261295         IF( lk_mpp )   CALL mpp_max( iterate_ridging ) 
    … …  
    289323      IF( ln_ctl )       CALL lim_prt3D( 'limitd_me' ) 
    290324 
    291       CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross ) 
     325      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, z_ai ) 
    292326      ! 
    293327      IF( nn_timing == 1 )  CALL timing_stop('limitd_me') 
    … …  
    306340      REAL(wp) ::   Gstari, astari, hrmean, zdummy   ! local scalar 
    307341      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n 
     342      REAL(wp), POINTER, DIMENSION(:,:) ::   z_ai 
    308343      !------------------------------------------------------------------------------! 
    309344 
    310345      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
     346      CALL wrk_alloc( jpi,jpj,z_ai ) 
    311347 
    312348      Gstari     = 1.0/rn_gstar     
    313349      astari     = 1.0/rn_astar     
    314       aksum(:,:)    = 0.0 
    315       athorn(:,:,:) = 0.0 
    316       aridge(:,:,:) = 0.0 
    317       araft (:,:,:) = 0.0 
     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 
    318369 
    319370      ! Zero out categories with very small areas 
    320371      CALL lim_var_zapsmall 
    321372 
     373!$OMP PARALLEL 
    322374      ! Ice thickness needed for rafting 
    323375      DO jl = 1, jpl 
     376!$OMP DO schedule(static) private(jj,ji,rswitch) 
    324377         DO jj = 1, jpj 
    325378            DO ji = 1, jpi 
    … …  
    336389      ! Compute total area of ice plus open water. 
    337390      ! This is in general not equal to one because of divergence during transport 
    338       asum(:,:) = ato_i(:,:) + SUM( a_i, dim=3 ) 
    339  
     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 
    340413      ! Compute cumulative thickness distribution function 
    341414      ! Compute the cumulative thickness distribution function Gsum, 
    342415      ! where Gsum(n) is the fractional area in categories 0 to n. 
    343416      ! initial value (in h = 0) equals open water area 
    344       Gsum(:,:,-1) = 0._wp 
    345       Gsum(:,:,0 ) = ato_i(:,:) 
     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 
    346424      ! for each value of h, you have to add ice concentration then 
    347425      DO jl = 1, jpl 
    348          Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 
     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 
    349432      END DO 
    350433 
    351434      ! Normalize the cumulative distribution to 1 
    352435      DO jl = 0, jpl 
    353          Gsum(:,:,jl) = Gsum(:,:,jl) / asum(:,:) 
     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 
    354442      END DO 
     443!$OMP END PARALLEL 
    355444 
    356445      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn) 
    … …  
    369458      IF( nn_partfun == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975) 
    370459         DO jl = 0, jpl     
     460!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    371461            DO jj = 1, jpj  
    372462               DO ji = 1, jpi 
    … …  
    387477         !                         
    388478         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array 
     479!$OMP PARALLEL 
    389480         DO jl = -1, jpl 
    390             Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy 
     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 
    391487         END DO 
    392488         DO jl = 0, jpl 
    393              athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl) 
    394          END DO 
     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 
    395497         ! 
    396498      ENDIF 
    … …  
    400502         ! 
    401503         DO jl = 1, jpl 
     504!$OMP PARALLEL DO schedule(static) private(jj,ji,zdummy) 
    402505            DO jj = 1, jpj  
    403506               DO ji = 1, jpi 
    … …  
    412515         ! 
    413516         DO jl = 1, jpl 
    414             aridge(:,:,jl) = athorn(:,:,jl) 
     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 
    415523         END DO 
    416524         ! 
    … …  
    418526         ! 
    419527         DO jl = 1, jpl 
    420             araft(:,:,jl) = athorn(:,:,jl) 
     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 
    421534         END DO 
    422535         ! 
    … …  
    449562      !----------------------------------------------------------------- 
    450563 
    451       aksum(:,:) = athorn(:,:,0) 
     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 
    452571      ! Transfer function 
    453572      DO jl = 1, jpl !all categories have a specific transfer function 
     573!$OMP DO schedule(static) private(jj,ji,hrmean) 
    454574         DO jj = 1, jpj 
    455575            DO ji = 1, jpi 
    … …  
    476596         END DO 
    477597      END DO 
     598!$OMP END PARALLEL 
    478599      ! 
    479600      CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 ) 
     601      CALL wrk_dealloc( jpi,jpj,z_ai ) 
    480602      ! 
    481603   END SUBROUTINE lim_itd_me_ridgeprep 
    … …  
    539661      ! 1) Compute change in open water area due to closing and opening. 
    540662      !------------------------------------------------------------------------------- 
     663!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    541664      DO jj = 1, jpj 
    542665         DO ji = 1, jpi 
    … …  
    568691         END DO 
    569692 
     693!$OMP PARALLEL 
     694!$OMP DO schedule(static) private(ij,jj,ji) 
    570695         DO ij = 1, icells 
    571696            ji = indxi(ij) ; jj = indxj(ij) 
    … …  
    660785         !-------------------------------------------------------------------- 
    661786         DO jk = 1, nlay_i 
     787!$OMP DO schedule(static) private(ij,jj,ji) 
    662788            DO ij = 1, icells 
    663789               ji = indxi(ij) ; jj = indxj(ij) 
    … …  
    687813         DO jl2  = 1, jpl  
    688814            ! over categories to which ridged/rafted ice is transferred 
     815!$OMP DO schedule(static) private(ij,jj,ji,hL,hR,farea) 
    689816            DO ij = 1, icells 
    690817               ji = indxi(ij) ; jj = indxj(ij) 
    … …  
    721848            ! Transfer ice energy to category jl2 by ridging 
    722849            DO jk = 1, nlay_i 
     850!$OMP DO schedule(static) private(ij,jj,ji) 
    723851               DO ij = 1, icells 
    724852                  ji = indxi(ij) ; jj = indxj(ij) 
    … …  
    728856            ! 
    729857         END DO ! jl2 
     858!$OMP END PARALLEL 
    730859          
    731860      END DO ! jl1 (deforming categories) 
    732  
    733861      ! 
    734862      CALL wrk_dealloc( jpij,        indxi, indxj ) 
    … …  
    769897      ! 1) Initialize 
    770898      !------------------------------------------------------------------------------! 
    771       strength(:,:) = 0._wp 
     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 
    772905 
    773906      !------------------------------------------------------------------------------! 
    … …  
    781914      IF( kstrngth == 1 ) THEN 
    782915         z1_3 = 1._wp / 3._wp 
     916!$OMP PARALLEL 
    783917         DO jl = 1, jpl 
     918!$OMP DO schedule(static) private(jj,ji) 
    784919            DO jj= 1, jpj 
    785920               DO ji = 1, jpi 
    … …  
    810945         END DO 
    811946    
    812          strength(:,:) = rn_pe_rdg * Cp * strength(:,:) / aksum(:,:) * tmask(:,:,1) 
     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 
    813954                         ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and rn_pe_rdg accounts for frictional dissipation 
    814955         ksmooth = 1 
    … …  
    818959      !------------------------------------------------------------------------------! 
    819960      ELSE                      ! kstrngth ne 1:  Hibler (1979) form 
    820          ! 
    821          strength(:,:) = rn_pstar * vt_i(:,:) * EXP( - rn_crhg * ( 1._wp - at_i(:,:) )  ) * tmask(:,:,1) 
     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 
    822968         ! 
    823969         ksmooth = 1 
    … …  
    830976      ! CAN BE REMOVED 
    831977      IF( ln_icestr_bvf ) THEN 
     978!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    832979         DO jj = 1, jpj 
    833980            DO ji = 1, jpi 
    … …  
    846993      IF ( ksmooth == 1 ) THEN 
    847994 
     995!$OMP PARALLEL 
     996!$OMP DO schedule(static) private(jj,ji) 
    848997         DO jj = 2, jpjm1 
    849998            DO ji = 2, jpim1 
    … …  
    8591008         END DO 
    8601009 
     1010!$OMP DO schedule(static) private(jj,ji) 
    8611011         DO jj = 2, jpjm1 
    8621012            DO ji = 2, jpim1 
    … …  
    8641014            END DO 
    8651015         END DO 
     1016!$OMP END PARALLEL 
    8661017         CALL lbc_lnk( strength, 'T', 1. ) 
    8671018 
    … …  
    8741025 
    8751026         IF ( numit == nit000 + nn_fsbc - 1 ) THEN 
    876             zstrp1(:,:) = 0._wp 
    877             zstrp2(:,:) = 0._wp 
     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 
    8781034         ENDIF 
    8791035 
     1036!$OMP PARALLEL DO schedule(static) private(jj,ji,numts_rm,zp) 
    8801037         DO jj = 2, jpjm1 
    8811038            DO ji = 2, jpim1 

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

    r7646 r7698  
    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          dummy_es(:,:,:) = e_s(:,:,1,:) 
     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 
    109116         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_init) 
    110117      ENDIF 
    … …  
    121128      ENDIF 
    122129 
    123       zdhice(:,:,:) = 0._wp 
     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 
    124139      DO jl = klbnd, kubnd 
     140!$OMP DO schedule(static) private(jj,ji,rswitch) 
    125141         DO jj = 1, jpj 
    126142            DO ji = 1, jpi 
    … …  
    137153      !  2) Compute fractional ice area in each grid cell 
    138154      !----------------------------------------------------------------------------------------------- 
    139       at_i(:,:) = 0._wp 
     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 
    140161      DO jl = klbnd, kubnd 
    141          at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    142       END DO 
     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 
    143170 
    144171      !----------------------------------------------------------------------------------------------- 
    … …  
    163190      !----------------------------------------------------------------------------------------------- 
    164191      !- 4.1 Compute category boundaries 
    165       zhbnew(:,:,:) = 0._wp 
     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 
    166201 
    167202      DO jl = klbnd, kubnd - 1 
     203!$OMP DO schedule(static) private(ji,ii,ij,zslope) 
    168204         DO ji = 1, nbrem 
    169205            ii = nind_i(ji) 
    … …  
    183219 
    184220         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness 
     221!$OMP DO schedule(static) private(ji,ii,ij) 
    185222         DO ji = 1, nbrem 
    186223            ii = nind_i(ji) 
    … …  
    205242 
    206243      END DO 
     244!$OMP END PARALLEL 
    207245 
    208246      !----------------------------------------------------------------------------------------------- 
    … …  
    223261      !  6) Fill arrays with lowermost / uppermost boundaries of 'new' categories 
    224262      !----------------------------------------------------------------------------------------------- 
     263!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    225264      DO jj = 1, jpj 
    226265         DO ji = 1, jpi 
    … …  
    254293 
    255294      !- 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) 
    256296      DO ji = 1, nbrem 
    257297         ii = nind_i(ji)  
    … …  
    299339      !----------------------------------------------------------------------------------------------- 
    300340 
     341!$OMP PARALLEL 
    301342      DO jl = klbnd, kubnd - 1 
     343!$OMP DO schedule(static) private(jj,ji) 
    302344         DO jj = 1, jpj 
    303345            DO ji = 1, jpi 
    … …  
    308350         END DO 
    309351 
     352!$OMP DO schedule(static) private(ji,ii,ij,zetamax,zetamin,zx1,zwk1,zwk2,zx2,zx3,nd) 
    310353         DO ji = 1, nbrem 
    311354            ii = nind_i(ji) 
    … …  
    342385         END DO 
    343386      END DO 
     387!$OMP END PARALLEL 
    344388 
    345389      !!---------------------------------------------------------------------------------------------- 
    … …  
    352396      !!---------------------------------------------------------------------------------------------- 
    353397 
     398!$OMP PARALLEL DO schedule(static) private(ji,ii,ij) 
    354399      DO ji = 1, nbrem 
    355400         ii = nind_i(ji) 
    … …  
    377422         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid)  
    378423 
    379          dummy_es(:,:,:) = e_s(:,:,1,:) 
     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 
    380432         CALL lim_column_sum (jpl, dummy_es(:,:,:) , et_s_final) 
    381433         fieldid = ' e_s : limitd_th ' 
    … …  
    421473      !!------------------------------------------------------------------ 
    422474      ! 
     475!$OMP PARALLEL DO schedule(static) private(jj,ji,zh13,zh23,zdhr,zwk1,zwk2) 
    423476      DO jj = 1, jpj 
    424477         DO ji = 1, jpi 
    … …  
    500553 
    501554      DO jl = klbnd, kubnd 
    502          zaTsfn(:,:,jl) = a_i(:,:,jl) * t_su(:,:,jl) 
     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 
    503561      END DO 
    504562 
    … …  
    519577         END DO 
    520578 
     579!$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,rswitch,zdvsnow,zdesnow,zdo_aice,zdsm_vice,zdaTsf) 
    521580         DO ji = 1, nbrem  
    522581            ii = nind_i(ji) 
    … …  
    584643 
    585644         DO jk = 1, nlay_i 
     645!$OMP PARALLEL DO schedule(static) private(ji,ii,ij,jl1,jl2,zdeice) 
    586646            DO ji = 1, nbrem 
    587647               ii = nind_i(ji) 
    … …  
    608668 
    609669      DO jl = klbnd, kubnd 
     670!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    610671         DO jj = 1, jpj 
    611672            DO ji = 1, jpi  
    … …  
    663724      ! 1) Compute ice thickness. 
    664725      !------------------------------------------------------------------------------ 
     726!$OMP PARALLEL 
    665727      DO jl = klbnd, kubnd 
     728!$OMP DO schedule(static) private(jj,ji,rswitch) 
    666729         DO jj = 1, jpj 
    667730            DO ji = 1, jpi  
    … …  
    680743      !------------------------- 
    681744      DO jl = klbnd, kubnd 
    682          zdonor(:,:,jl) = 0 
    683          zdaice(:,:,jl) = 0._wp 
    684          zdvice(:,:,jl) = 0._wp 
    685       END DO 
     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 
    686755 
    687756      !------------------------- 
    … …  
    696765         zshiftflag = 0 
    697766 
     767!$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag) 
    698768         DO jj = 1, jpj  
    699769            DO ji = 1, jpi  
    … …  
    716786            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    717787            ! Reset shift parameters 
    718             zdonor(:,:,jl) = 0 
    719             zdaice(:,:,jl) = 0._wp 
    720             zdvice(:,:,jl) = 0._wp 
     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 
    721796         ENDIF 
    722797         ! 
    … …  
    734809         zshiftflag = 0 
    735810 
     811!$OMP PARALLEL DO schedule(static) private(jj,ji) REDUCTION(MAX:zshiftflag) 
    736812         DO jj = 1, jpj 
    737813            DO ji = 1, jpi 
    738814               IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN 
    739                   ! 
    740815                  zshiftflag = 1 
    741816                  zdonor(ji,jj,jl) = jl + 1 
    … …  
    751826            CALL lim_itd_shiftice( klbnd, kubnd, zdonor, zdaice, zdvice ) 
    752827            ! Reset shift parameters 
    753             zdonor(:,:,jl) = 0 
    754             zdaice(:,:,jl) = 0._wp 
    755             zdvice(:,:,jl) = 0._wp 
     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 
    756836         ENDIF 
    757837 

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

    r7646 r7698  
    164164      !------------------------------------------------------------------------------! 
    165165      ! ocean/land mask 
     166!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    166167      DO jj = 1, jpjm1 
    167168         DO ji = 1, jpim1      ! NO vector opt. 
    … …  
    172173 
    173174      ! Lateral boundary conditions on velocity (modify zfmask) 
    174       zwf(:,:) = 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) 
    175183      DO jj = 2, jpjm1 
    176184         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    180188         END DO 
    181189      END DO 
     190!$OMP DO schedule(static) private(jj) 
    182191      DO jj = 2, jpjm1 
    183192         IF( zfmask(1,jj) == 0._wp ) THEN 
    … …  
    188197         ENDIF 
    189198      END DO 
     199!$OMP DO schedule(static) private(ji) 
    190200      DO ji = 2, jpim1 
    191201         IF( zfmask(ji,1) == 0._wp ) THEN 
    … …  
    196206         ENDIF 
    197207      END DO 
     208!$OMP END PARALLEL 
    198209      CALL lbc_lnk( zfmask, 'F', 1._wp ) 
    199210 
    … …  
    225236 
    226237      ! Initialise stress tensor  
    227       zs1 (:,:) = stress1_i (:,:)  
    228       zs2 (:,:) = stress2_i (:,:) 
    229       zs12(:,:) = stress12_i(:,:) 
     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 
    230246 
    231247      ! Ice strength 
    … …  
    233249 
    234250      ! scale factors 
     251!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    235252      DO jj = 2, jpjm1 
    236253         DO ji = fs_2, fs_jpim1 
    … …  
    255272         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    256273         ! 
    257          zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0 
     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 
    258280         ! 
    259281      ELSE                                    !== non-embedded sea ice: use ocean surface for slope calculation ==! 
    260          zpice(:,:) = ssh_m(:,:) 
     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 
    261288      ENDIF 
    262289 
     290!$OMP PARALLEL DO schedule(static) private(jj,ji,zm1,zm2,zm3,zmassU,zmassV) 
    263291      DO jj = 2, jpjm1 
    264292         DO ji = fs_2, fs_jpim1 
    … …  
    317345         !                                            !----------------------!         
    318346         IF(ln_ctl) THEN   ! Convergence test 
     347!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    319348            DO jj = 1, jpjm1 
    320                zu_ice(:,jj) = u_ice(:,jj) ! velocity at previous time step 
    321                zv_ice(:,jj) = v_ice(:,jj) 
     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 
    322353            END DO 
    323354         ENDIF 
    324355 
    325356         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
     357!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    326358         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 
    327359            DO ji = 1, jpim1 
    … …  
    336368         CALL lbc_lnk( zds, 'F', 1. ) 
    337369 
     370!$OMP PARALLEL DO schedule(static) private(jj,ji,zds2,zdiv,zdiv2,zdt,zdt2,zdelta) 
    338371         DO jj = 2, jpjm1 
    339372            DO ji = 2, jpim1 ! no vector loop 
    … …  
    370403         CALL lbc_lnk( zp_delt, 'T', 1. ) 
    371404 
     405!$OMP PARALLEL DO schedule(static) private(jj,ji,zp_delf) 
    372406         DO jj = 1, jpjm1 
    373407            DO ji = 1, jpim1 
    … …  
    385419 
    386420         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
     421!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    387422         DO jj = 2, jpjm1 
    388423            DO ji = fs_2, fs_jpim1                
    … …  
    420455         IF( MOD(jter,2) .EQ. 0 ) THEN ! even iterations 
    421456             
     457!$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 
    422458            DO jj = 2, jpjm1 
    423459               DO ji = fs_2, fs_jpim1 
    … …  
    464500            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'V' ) 
    465501 
     502!$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 
    466503            DO jj = 2, jpjm1 
    467504               DO ji = fs_2, fs_jpim1 
    … …  
    509546         ELSE ! odd iterations 
    510547 
     548!$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 
    511549            DO jj = 2, jpjm1 
    512550               DO ji = fs_2, fs_jpim1 
    … …  
    552590            IF( ln_bdy ) CALL bdy_ice_lim_dyn( 'U' ) 
    553591 
     592!$OMP PARALLEL DO schedule(static) private(jj,ji,zTauO,zvel,zTauB,zCor,zTauE,rswitch) 
    554593            DO jj = 2, jpjm1 
    555594               DO ji = fs_2, fs_jpim1 
    … …  
    598637          
    599638         IF(ln_ctl) THEN   ! Convergence test 
     639!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    600640            DO jj = 2 , jpjm1 
    601                zresr(:,jj) = MAX( ABS( u_ice(:,jj) - zu_ice(:,jj) ), ABS( v_ice(:,jj) - zv_ice(:,jj) ) ) 
     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 
    602644            END DO 
    603645            zresm = MAXVAL( zresr( 1:jpi, 2:jpjm1 ) ) 
    … …  
    612654      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution)  
    613655      !------------------------------------------------------------------------------! 
     656!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    614657      DO jj = 1, jpjm1 
    615658         DO ji = 1, jpim1 
    … …  
    624667      CALL lbc_lnk( zds, 'F', 1. ) 
    625668       
     669!$OMP PARALLEL DO schedule(static) private(jj,ji,zdt,zdt2,zds2,zdelta,rswitch) 
    626670      DO jj = 2, jpjm1 
    627671         DO ji = 2, jpim1 ! no vector loop 
    … …  
    656700       
    657701      ! --- Store the stress tensor for the next time step --- ! 
    658       stress1_i (:,:) = zs1 (:,:) 
    659       stress2_i (:,:) = zs2 (:,:) 
    660       stress12_i(:,:) = zs12(:,:) 
     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 
    661710      ! 
    662711 

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

    r7646 r7698  
    130130         WRITE(zchar,'(I2.2)') jl 
    131131         znam = 'v_i'//'_htc'//zchar 
    132          z2d(:,:) = v_i(:,:,jl) 
     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 
    133138         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    134139         znam = 'v_s'//'_htc'//zchar 
    135          z2d(:,:) = v_s(:,:,jl) 
     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 
    136146         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    137147         znam = 'smv_i'//'_htc'//zchar 
    138          z2d(:,:) = smv_i(:,:,jl) 
     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 
    139154         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    140155         znam = 'oa_i'//'_htc'//zchar 
    141          z2d(:,:) = oa_i(:,:,jl) 
     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 
    142162         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    143163         znam = 'a_i'//'_htc'//zchar 
    144          z2d(:,:) = a_i(:,:,jl) 
     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 
    145170         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    146171         znam = 't_su'//'_htc'//zchar 
    147          z2d(:,:) = t_su(:,:,jl) 
     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 
    148178         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    149179      END DO 
    … …  
    152182         WRITE(zchar,'(I2.2)') jl 
    153183         znam = 'tempt_sl1'//'_htc'//zchar 
    154          z2d(:,:) = e_s(:,:,1,jl) 
     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 
    155190         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    156191      END DO 
    … …  
    161196            WRITE(zchar1,'(I2.2)') jk 
    162197            znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 
    163             z2d(:,:) = e_i(:,:,jk,jl) 
     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 
    164204            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    165205         END DO 
    … …  
    181221            WRITE(zchar,'(I2.2)') jl 
    182222            znam = 'sxice'//'_htc'//zchar 
    183             z2d(:,:) = sxice(:,:,jl) 
     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 
    184229            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    185230            znam = 'syice'//'_htc'//zchar 
    186             z2d(:,:) = syice(:,:,jl) 
     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 
    187237            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    188238            znam = 'sxxice'//'_htc'//zchar 
    189             z2d(:,:) = sxxice(:,:,jl) 
     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 
    190245            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    191246            znam = 'syyice'//'_htc'//zchar 
    192             z2d(:,:) = syyice(:,:,jl) 
     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 
    193253            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    194254            znam = 'sxyice'//'_htc'//zchar 
    195             z2d(:,:) = sxyice(:,:,jl) 
     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 
    196261            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    197262            znam = 'sxsn'//'_htc'//zchar 
    198             z2d(:,:) = sxsn(:,:,jl) 
     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 
    199269            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    200270            znam = 'sysn'//'_htc'//zchar 
    201             z2d(:,:) = sysn(:,:,jl) 
     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 
    202277            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    203278            znam = 'sxxsn'//'_htc'//zchar 
    204             z2d(:,:) = sxxsn(:,:,jl) 
     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 
    205285            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    206286            znam = 'syysn'//'_htc'//zchar 
    207             z2d(:,:) = syysn(:,:,jl) 
     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 
    208293            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    209294            znam = 'sxysn'//'_htc'//zchar 
    210             z2d(:,:) = sxysn(:,:,jl) 
     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 
    211301            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    212302            znam = 'sxa'//'_htc'//zchar 
    213             z2d(:,:) = sxa(:,:,jl) 
     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 
    214309            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    215310            znam = 'sya'//'_htc'//zchar 
    216             z2d(:,:) = sya(:,:,jl) 
     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 
    217317            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    218318            znam = 'sxxa'//'_htc'//zchar 
    219             z2d(:,:) = sxxa(:,:,jl) 
     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 
    220325            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    221326            znam = 'syya'//'_htc'//zchar 
    222             z2d(:,:) = syya(:,:,jl) 
     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 
    223333            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    224334            znam = 'sxya'//'_htc'//zchar 
    225             z2d(:,:) = sxya(:,:,jl) 
     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 
    226341            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    227342            znam = 'sxc0'//'_htc'//zchar 
    228             z2d(:,:) = sxc0(:,:,jl) 
     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 
    229349            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    230350            znam = 'syc0'//'_htc'//zchar 
    231             z2d(:,:) = syc0(:,:,jl) 
     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 
    232357            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    233358            znam = 'sxxc0'//'_htc'//zchar 
    234             z2d(:,:) = sxxc0(:,:,jl) 
     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 
    235365            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    236366            znam = 'syyc0'//'_htc'//zchar 
    237             z2d(:,:) = syyc0(:,:,jl) 
     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 
    238373            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    239374            znam = 'sxyc0'//'_htc'//zchar 
    240             z2d(:,:) = sxyc0(:,:,jl) 
     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 
    241381            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    242382            znam = 'sxsal'//'_htc'//zchar 
    243             z2d(:,:) = sxsal(:,:,jl) 
     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 
    244389            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    245390            znam = 'sysal'//'_htc'//zchar 
    246             z2d(:,:) = sysal(:,:,jl) 
     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 
    247397            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    248398            znam = 'sxxsal'//'_htc'//zchar 
    249             z2d(:,:) = sxxsal(:,:,jl) 
     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 
    250405            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    251406            znam = 'syysal'//'_htc'//zchar 
    252             z2d(:,:) = syysal(:,:,jl) 
     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 
    253413            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    254414            znam = 'sxysal'//'_htc'//zchar 
    255             z2d(:,:) = sxysal(:,:,jl) 
     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 
    256421            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    257422            znam = 'sxage'//'_htc'//zchar 
    258             z2d(:,:) = sxage(:,:,jl) 
     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 
    259429            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    260430            znam = 'syage'//'_htc'//zchar 
    261             z2d(:,:) = syage(:,:,jl) 
     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 
    262437            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    263438            znam = 'sxxage'//'_htc'//zchar 
    264             z2d(:,:) = sxxage(:,:,jl) 
     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 
    265445            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    266446            znam = 'syyage'//'_htc'//zchar 
    267             z2d(:,:) = syyage(:,:,jl) 
     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 
    268453            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    269454            znam = 'sxyage'//'_htc'//zchar 
    270             z2d(:,:) = sxyage(:,:,jl) 
     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 
    271461            CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    272462         END DO 
    … …  
    283473               WRITE(zchar1,'(I2.2)') jk 
    284474               znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 
    285                z2d(:,:) = sxe(:,:,jk,jl) 
     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 
    286481               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    287482               znam = 'sye'//'_il'//zchar1//'_htc'//zchar 
    288                z2d(:,:) = sye(:,:,jk,jl) 
     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 
    289489               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    290490               znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 
    291                z2d(:,:) = sxxe(:,:,jk,jl) 
     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 
    292497               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    293498               znam = 'syye'//'_il'//zchar1//'_htc'//zchar 
    294                z2d(:,:) = syye(:,:,jk,jl) 
     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 
    295505               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    296506               znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 
    297                z2d(:,:) = sxye(:,:,jk,jl) 
     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 
    298513               CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    299514            END DO 

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

    r7646 r7698  
    112112      ! --- case we bypass ice thermodynamics --- ! 
    113113      IF( .NOT. ln_limthd ) THEN   ! we suppose ice is impermeable => ocean is isolated from atmosphere 
    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 
     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 
    120134      ENDIF 
    121135       
    … …  
    123137      CALL wrk_alloc( jpi,jpj, zalb )     
    124138 
    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 
     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 
    129159      IF( iom_use('alb_ice' ) )  CALL iom_put( "alb_ice"  , zalb(:,:) )           ! ice albedo output 
    130160 
    131       zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + 0.066_wp * ( 1._wp - at_i_b )       
     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 
    132177      IF( iom_use('albedo'  ) )  CALL iom_put( "albedo"  , zalb(:,:) )           ! ice albedo output 
    133178 
    134179      CALL wrk_dealloc( jpi,jpj, zalb )     
    135180 
     181!$OMP PARALLEL 
     182!$OMP DO schedule(static) private(jj,ji,jl,zqsr,zqmass) 
    136183      DO jj = 1, jpj 
    137184         DO ji = 1, jpi 
    … …  
    186233      !      salt flux at the ocean surface      ! 
    187234      !------------------------------------------! 
    188       sfx(:,:) = sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + sfx_opw(:,:)   & 
    189          &     + sfx_res(:,:) + sfx_dyn(:,:) + sfx_bri(:,:) + sfx_sub(:,:) + sfx_lam(:,:) 
     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 
    190243 
    191244      !-------------------------------------------------------------! 
    … …  
    193246      !-------------------------------------------------------------! 
    194247      IF( nn_ice_embd /= 0 ) THEN 
    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 
     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 
    201259      ENDIF 
    202260 
    … …  
    204262      !   Storing the transmitted variables           ! 
    205263      !-----------------------------------------------! 
    206       fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction             
    207       tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                       
     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 
    208280 
    209281      !------------------------------------------------------------------------! 
    … …  
    212284      CALL wrk_alloc( jpi,jpj,jpl,   zalb_cs, zalb_os )     
    213285      CALL albedo_ice( t_su, ht_i, ht_s, zalb_cs, zalb_os )  ! cloud-sky and overcast-sky ice albedos 
    214       alb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 
     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 
    215294      CALL wrk_dealloc( jpi,jpj,jpl,   zalb_cs, zalb_os ) 
    216295 
    … …  
    260339      ! 
    261340      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) 
    262342         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point) 
    263343            DO ji = fs_2, fs_jpim1 
    … …  
    274354         CALL lbc_lnk_multi( taum, 'T', 1., tmod_io, 'T', 1. ) 
    275355         ! 
    276          utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step 
    277          vtau_oce(:,:) = vtau(:,:) 
     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 
    278363         ! 
    279364      ENDIF 
    … …  
    281366      !                                      !==  every ocean time-step  ==! 
    282367      ! 
     368!$OMP PARALLEL DO schedule(static) private(jj,ji,zat_u,zat_v,zutau_ice,zvtau_ice) 
    283369      DO jj = 2, jpjm1                                !* update the stress WITHOUT a ice-ocean rotation angle 
    284370         DO ji = fs_2, fs_jpim1   ! Vect. Opt. 
    … …  
    319405      IF( lim_sbc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'lim_sbc_init : unable to allocate standard arrays' ) 
    320406      ! 
    321       soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    322       sice_0(:,:) = sice 
     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 
    323415      !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area 
    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 
     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 
    329427      ! 
    330428      IF( .NOT. ln_rstart ) THEN 
    331429         !                                      ! embedded sea ice 
    332430         IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    333             snwice_mass  (:,:) = tmask(:,:,1) * ( rhosn * vt_s(:,:) + rhoic * vt_i(:,:)  ) 
    334             snwice_mass_b(:,:) = snwice_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 
    335438         ELSE 
    336             snwice_mass  (:,:) = 0._wp          ! no mass exchanges 
    337             snwice_mass_b(:,:) = 0._wp          ! no mass exchanges 
     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 
    338446         ENDIF 
    339447         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 
    340             sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    341             sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     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 
    342455 
    343456!!gm I really don't like this stuff here...  Find a way to put that elsewhere or differently 
    344457!!gm 
    345458            IF( .NOT.ln_linssh ) THEN 
     459!$OMP PARALLEL 
     460!$OMP DO schedule(static) private(jj,ji) 
    346461               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    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)) ) 
    349                END DO 
    350                e3t_a(:,:,:) = e3t_b(:,:,:) 
     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 
     468               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 
    351478               ! Reconstruction of all vertical scale factors at now and before time-steps 
    352479               ! ========================================================================= 
    … …  
    368495               ! ---------------------- 
    369496!!gm not sure of that.... 
    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(:,:) 
     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 
     505               END DO 
    373506               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   (:,:) 
    377                END DO 
     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 
    378517            ENDIF 
    379518         ENDIF 

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

    r7646 r7698  
    110110      !---------------------------------------------! 
    111111      IF( ln_limdyn ) THEN 
    112          zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
    113          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
     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) 
    114121         DO jj = 2, jpjm1  
    115122            DO ji = fs_2, fs_jpim1 
    … …  
    119126            END DO 
    120127         END DO 
     128!$OMP END PARALLEL 
    121129      ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
     130!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    122131         DO jj = 2, jpjm1 
    123132            DO ji = fs_2, fs_jpim1 
    … …  
    133142      ! Initialization and units change 
    134143      !----------------------------------! 
    135       ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice 
     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 
    136153 
    137154      ! Change the units of heat content; from J/m2 to J/m3 
    138155      DO jl = 1, jpl 
    139156         DO jk = 1, nlay_i 
     157!$OMP DO schedule(static) private(jj,ji,rswitch) 
    140158            DO jj = 1, jpj 
    141159               DO ji = 1, jpi 
    … …  
    147165         END DO 
    148166         DO jk = 1, nlay_s 
     167!$OMP DO schedule(static) private(jj,ji,rswitch) 
    149168            DO jj = 1, jpj 
    150169               DO ji = 1, jpi 
    … …  
    160179      ! Partial computation of forcing for the thermodynamic sea ice model 
    161180      !--------------------------------------------------------------------! 
     181!$OMP DO schedule(static) private(jj,ji,rswitch,zqld,zqfr,zfric_u) 
    162182      DO jj = 1, jpj 
    163183         DO ji = 1, jpi 
    … …  
    201221         END DO 
    202222      END DO 
     223!$OMP END PARALLEL 
    203224       
    204225      ! In case we bypass open-water ice formation 
    205       IF( .NOT. ln_limdO )  qlead(:,:) = 0._wp 
     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 
    206234      ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere 
    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 
     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 
    209251 
    210252      ! --------------------------------------------------------------------- 
    … …  
    214256      !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema)  
    215257      !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar 
     258!$OMP DO schedule(static) private(jj,ji) 
    216259      DO jj = 1, jpj 
    217260         DO ji = 1, jpi 
    … …  
    223266         END DO 
    224267      END DO 
     268!$OMP END PARALLEL 
    225269 
    226270      !------------------------------------------------------------------------------! 
    … …  
    288332 
    289333      ! Enthalpies are global variables we have to readjust the units (heat content in J/m2) 
     334!$OMP PARALLEL 
    290335      DO jl = 1, jpl 
    291336         DO jk = 1, nlay_i 
    292             e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_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 
    293343         END DO 
    294344         DO jk = 1, nlay_s 
    295             e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s 
    296          END DO 
    297       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(:,:,:) 
     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 
     351         END DO 
     352      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 
    303365 
    304366      ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 
    305367      DO jl  = 1, jpl 
     368!$OMP DO schedule(static) private(jj,ji,rswitch) 
    306369         DO jj = 1, jpj 
    307370            DO ji = 1, jpi 
    … …  
    311374         END DO 
    312375      END DO 
     376!$OMP END PARALLEL 
    313377 
    314378      CALL lim_var_zapsmall 

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

    r7646 r7698  
    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) 
    115117      DO jj = 1, jpj 
    116118         DO ji = 1, jpi 
    … …  
    135137      !---------------------------------------------------------------------------------------------! 
    136138      DO jl = jpl, 1, -1 
     139!$OMP DO schedule(static) private(jj,ji,rswitch,zda) 
    137140         DO jj = 1, jpj 
    138141            DO ji = 1, jpi 
    … …  
    163166       
    164167      ! total concentration 
    165       at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
    166        
     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 
    167182      ! --- ensure that ht_i = 0 where a_i = 0 --- 
    168       WHERE( a_i == 0._wp ) ht_i = 0._wp 
     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 
    169193      ! 
    170194      CALL wrk_dealloc( jpi,jpj, zda_tot ) 

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

    r7646 r7698  
    125125      ! 2) Convert units for ice internal energy 
    126126      !------------------------------------------------------------------------------| 
     127!$OMP PARALLEL 
    127128      DO jl = 1, jpl 
    128129         DO jk = 1, nlay_i 
     130!$OMP DO schedule(static) private(jj,ji,rswitch) 
    129131            DO jj = 1, jpj 
    130132               DO ji = 1, jpi 
    … …  
    150152      !  
    151153 
    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 
     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 
    158171 
    159172      IF( ln_frazil ) THEN 
    … …  
    162175         ! Physical constants 
    163176         !-------------------- 
    164          hicol(:,:) = 0._wp 
    165177 
    166178         zhicrit = 0.04 ! frazil ice thickness 
    … …  
    169181         zgamafr = 0.03 
    170182 
     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) 
    171192         DO jj = 2, jpjm1 
    172193            DO ji = 2, jpim1 
    … …  
    226247            END DO  
    227248         END DO  
     249!$OMP END PARALLEL 
    228250         !  
    229251         CALL lbc_lnk( zvrel, 'T', 1. ) 
    … …  
    430452 
    431453         DO jk = 1, nlay_i 
     454!$OMP PARALLEL DO schedule(static) private(ji,jl,rswitch) 
    432455            DO ji = 1, nbpac 
    433456               jl = jcat(ji) 
    … …  
    448471            qh_i_old(1:nbpac,0:nlay_i+1) = 0._wp 
    449472            DO jk = 1, nlay_i 
     473!$OMP PARALLEL DO schedule(static) private(ji) 
    450474               DO ji = 1, nbpac 
    451475                  h_i_old (ji,jk) = zv_i_1d(ji,jl) * r1_nlay_i 
    … …  
    455479 
    456480            ! new volumes including lateral/bottom accretion + residual 
     481!$OMP PARALLEL DO schedule(static) private(ji,rswitch,zv_newfra) 
    457482            DO ji = 1, nbpac 
    458483               rswitch        = MAX( 0._wp, SIGN( 1._wp , zat_i_1d(ji) - epsi20 ) ) 
    … …  
    472497         !----------------- 
    473498         DO jl = 1, jpl 
     499!$OMP PARALLEL DO schedule(static) private(ji,zdv) 
    474500            DO ji = 1, nbpac 
    475501               zdv   = zv_i_1d(ji,jl) - zv_b(ji,jl) 
    … …  
    502528      DO jl = 1, jpl 
    503529         DO jk = 1, nlay_i 
     530!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    504531            DO jj = 1, jpj 
    505532               DO ji = 1, jpi 

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

    r7646 r7698  
    114114      zviold = v_i 
    115115      zvsold = v_s 
    116       zsmvold(:,:) = SUM( smv_i(:,:,:), dim=3 ) 
    117       zeiold (:,:) = et_i 
    118       zesold (:,:) = et_s  
    119  
    120       !--- Thickness correction init. --- ! 
    121       zatold(:,:) = at_i 
     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 
    122123      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) 
    123143         DO jj = 1, jpj 
    124144            DO ji = 1, jpi 
    … …  
    130150      END DO 
    131151      ! --- Record max of the surrounding ice thicknesses for correction in case advection creates ice too thick --- ! 
    132       zhimax(:,:,:) = ht_i(:,:,:) + ht_s(:,:,:) 
    133152      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) 
    134163         DO jj = 2, jpjm1 
    135164            DO ji = 2, jpim1 
    … …  
    173202         zdt = rdt_ice / REAL(initad) 
    174203          
     204!$OMP PARALLEL 
    175205         ! transport 
    176          zudy(:,:) = u_ice(:,:) * e2u(:,:) 
    177          zvdx(:,:) = v_ice(:,:) * e1v(:,:) 
     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 
    178213          
    179214         ! define velocity for advection: u*grad(H) 
     215!$OMP DO schedule(static) private(jj,ji) 
    180216         DO jj = 2, jpjm1 
    181217            DO ji = fs_2, fs_jpim1 
    … …  
    191227            END DO 
    192228         END DO 
     229!$OMP END PARALLEL 
    193230          
    194231         ! advection 
    … …  
    208245         END DO 
    209246         ! 
    210          at_i(:,:) = a_i(:,:,1)      ! total ice fraction 
     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 
    211254         DO jl = 2, jpl 
    212             at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    213          END DO 
     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 
    214263         ! 
    215264         CALL wrk_dealloc( jpi,jpj, zudy, zvdx, zcu_box, zcv_box ) 
    … …  
    230279         ENDIF 
    231280          
    232          zarea(:,:) = e1e2t(:,:) 
    233           
    234          !------------------------- 
    235          ! transported fields                                         
    236          !------------------------- 
    237          z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:)             ! Open water area  
     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 
    238293         DO jl = 1, jpl 
    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 
     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 
    245305            DO jk = 1, nlay_i 
    246                z0ei  (:,:,jk,jl) = e_i  (:,:,jk,jl) * e1e2t(:,:) ! Ice  heat content 
    247             END DO 
    248          END DO 
     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 
    249315 
    250316 
    … …  
    336402         ! Recover the properties from their contents 
    337403         !------------------------------------------- 
    338          ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) 
     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 
    339411         DO jl = 1, jpl 
    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(:,:) 
     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 
    346423            DO jk = 1, nlay_i 
    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 
     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 
    352439         DO jl = 2, jpl 
    353             at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
    354          END DO 
     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 
    355448          
    356449         CALL wrk_dealloc( jpi,jpj,            zarea ) 
    … …  
    369462         !     mask eddy diffusivity coefficient at ocean U- and V-points 
    370463         jm=1 
     464!$OMP PARALLEL 
    371465         DO jl = 1, jpl 
     466!$OMP DO schedule(static) private(jj,ji) 
    372467            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row 
    373468               DO ji = 1 , fs_jpim1 
    … …  
    379474            END DO 
    380475 
    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 
     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 
    387518            ! Sample of adding more variables to apply lim_hdf (ihdf_vars must be increased) 
    388519            !   zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1   
    389520            !   zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1  
    390521            DO jk = 1, nlay_i 
    391               zhdfptab(:,:,jm)=e_i(:,:,jk,jl); jm= jm+1 
     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 
    392529            END DO 
    393530         END DO 
    … …  
    395532         ! --- Prepare diffusion for open water area --- ! 
    396533         !     mask eddy diffusivity coefficient at ocean U- and V-points 
     534!$OMP DO schedule(static) private(jj,ji) 
    397535         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row 
    398536            DO ji = 1 , fs_jpim1 
    … …  
    404542         END DO 
    405543         ! 
    406          zhdfptab(:,:,jm)= ato_i  (:,:); 
     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 
    407551 
    408552         ! --- Apply diffusion --- ! 
    … …  
    411555         ! --- Recover properties --- ! 
    412556         jm=1 
     557!$OMP PARALLEL 
    413558         DO jl = 1, jpl 
    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 
     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 
    420602            ! Sample of adding more variables to apply lim_hdf 
    421603            !   variable_1  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1  
    422604            !   variable_2  (:,:,1,jl) = zhdfptab(:,:, jm  ) ; jm + 1 
    423605            DO jk = 1, nlay_i 
    424                e_i(:,:,jk,jl) = zhdfptab(:,:,jm);jm= jm + 1 
    425             END DO 
    426          END DO 
    427          ato_i  (:,:) = zhdfptab(:,:,jm) 
     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 
    428622               
    429623      ENDIF 
    430624 
    431625      ! --- diags --- 
     626!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    432627      DO jj = 1, jpj 
    433628         DO ji = 1, jpi 
    … …  
    446641            
    447642         !--- Thickness correction in case too high --- ! 
     643!$OMP PARALLEL 
    448644         DO jl = 1, jpl 
     645!$OMP DO schedule(static) private(jj,ji,rswitch,zdv) 
    449646            DO jj = 1, jpj 
    450647               DO ji = 1, jpi 
    … …  
    481678          
    482679         ! Force the upper limit of ht_i to always be < hi_max (99 m). 
     680!$OMP DO schedule(static) private(jj,ji,rswitch) 
    483681         DO jj = 1, jpj 
    484682            DO ji = 1, jpi 
    … …  
    488686            END DO 
    489687         END DO 
     688!$OMP END PARALLEL 
    490689 
    491690      ENDIF 
    … …  
    495694      !------------------------------------------------------------ 
    496695      ! 
    497       at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     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 
    498713      IF ( nn_limdyn == 1 .OR. ( ( nn_monocat == 2 ) .AND. ( jpl == 1 ) ) ) THEN ! simple conservative piling, comparable with LIM2 
    499714         DO jl = 1, jpl 
     715!$OMP PARALLEL DO schedule(static) private(jj,ji,rswitch,zda) 
    500716            DO jj = 1, jpj 
    501717               DO ji = 1, jpi 
    … …  
    510726       
    511727      ! --- agglomerate variables ----------------- 
    512       vt_i(:,:) = SUM( v_i(:,:,:), dim=3 ) 
    513       vt_s(:,:) = SUM( v_s(:,:,:), dim=3 ) 
    514       at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     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 
    515747       
    516748      ! --- open water = 1 if at_i=0 -------------------------------- 
    517       WHERE( at_i == 0._wp ) ato_i = 1._wp  
     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 
    518756       
    519757      ! conservation test 

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

    r7646 r7698  
    7070      ! ice concentration should not exceed amax  
    7171      !----------------------------------------------------- 
    72       at_i(:,:) = 0._wp 
     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 
    7379      DO jl = 1, jpl 
    74          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     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 
    7586      END DO 
    7687 
    7788      DO jl  = 1, jpl 
     89!$OMP DO schedule(static) private(jj, ji) 
    7890         DO jj = 1, jpj 
    7991            DO ji = 1, jpi 
    … …  
    8597         END DO 
    8698      END DO 
     99!$OMP END PARALLEL 
    87100     
    88101      !--------------------- 
    … …  
    91104      IF (  nn_icesal == 2  ) THEN  
    92105         DO jl = 1, jpl 
     106!$OMP PARALLEL DO schedule(static) private(jj,ji,zsal,rswitch) 
    93107            DO jj = 1, jpj  
    94108               DO ji = 1, jpi 
    … …  
    118132      ! ------------------------------------------------- 
    119133      DO jl  = 1, jpl 
    120          afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 
     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 
    121140      END DO 
    122141 
     142!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    123143      DO jj = 1, jpj 
    124144         DO ji = 1, jpi             

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

    r7646 r7698  
    7171      ! Constrain the thickness of the smallest category above himin 
    7272      !---------------------------------------------------------------------- 
     73!$OMP PARALLEL 
     74!$OMP DO schedule(static) private(jj,ji,rswitch) 
    7375      DO jj = 1, jpj  
    7476         DO ji = 1, jpi 
    … …  
    8587      ! ice concentration should not exceed amax  
    8688      !----------------------------------------------------- 
    87       at_i(:,:) = 0._wp 
     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 
    8895      DO jl = 1, jpl 
    89          at_i(:,:) = a_i(:,:,jl) + at_i(:,:) 
     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 
    90102      END DO 
    91103 
    92104      DO jl  = 1, jpl 
     105!$OMP DO schedule(static) private(jj, ji) 
    93106         DO jj = 1, jpj 
    94107            DO ji = 1, jpi 
    … …  
    100113         END DO 
    101114      END DO 
     115!$OMP END PARALLEL 
    102116 
    103117      !--------------------- 
    … …  
    106120      IF (  nn_icesal == 2  ) THEN  
    107121         DO jl = 1, jpl 
     122!$OMP PARALLEL DO schedule(static) private(jj,ji,zsal,rswitch) 
    108123            DO jj = 1, jpj  
    109124               DO ji = 1, jpi 
    … …  
    134149      ! Ice drift 
    135150      !------------ 
     151!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    136152      DO jj = 2, jpjm1 
    137153         DO ji = 2, jpim1 
    … …  
    148164      CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
    149165      !mask velocities 
    150       u_ice(:,:) = u_ice(:,:) * umask(:,:,1) 
    151       v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 
     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 
    152174  
    153175      ! ------------------------------------------------- 
    … …  
    155177      ! ------------------------------------------------- 
    156178      DO jl  = 1, jpl 
    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 
     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 
    159186      END DO 
    160187      afx_tot = afx_thd + afx_dyn 
    161188 
     189!$OMP DO schedule(static) private(jj, ji) 
    162190      DO jj = 1, jpj 
    163191         DO ji = 1, jpi             
    … …  
    173201         END DO 
    174202      END DO 
     203!$OMP END PARALLEL 
    175204 
    176205      ! conservation test 

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

    r7646 r7698  
    8080      !!------------------------------------------------------------------ 
    8181      INTEGER, INTENT( in ) ::   kn     ! =1 at_i & vt only ; = what is needed 
     82      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_s, ze_i 
    8283      ! 
    8384      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    8485      !!------------------------------------------------------------------ 
    8586 
     87      CALL wrk_alloc( jpi, jpj, nlay_s, ze_s ) 
     88      CALL wrk_alloc( jpi, jpj, nlay_i, ze_i ) 
    8689      ! integrated values 
    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 ) 
     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 
    92163 
    93164      ! open water fraction 
     165!$OMP DO schedule(static) private(jj, ji) 
    94166      DO jj = 1, jpj 
    95167         DO ji = 1, jpi 
    … …  
    97169         END DO 
    98170      END DO 
     171!$OMP END PARALLEL 
    99172 
    100173      IF( kn > 1 ) THEN 
    101174 
     175!$OMP PARALLEL 
    102176         ! mean ice/snow thickness 
     177!$OMP DO schedule(static) private(jj,ji,rswitch) 
    103178         DO jj = 1, jpj 
    104179            DO ji = 1, jpi 
    … …  
    110185 
    111186         ! mean temperature (K), salinity and age 
    112          smt_i(:,:) = 0._wp 
    113          tm_i(:,:)  = 0._wp 
    114          tm_su(:,:) = 0._wp 
    115          om_i (:,:) = 0._wp 
     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 
    116196         DO jl = 1, jpl 
    117197             
     198!$OMP DO schedule(static) private(jj,ji,rswitch) 
    118199            DO jj = 1, jpj 
    119200               DO ji = 1, jpi 
    … …  
    125206             
    126207            DO jk = 1, nlay_i 
     208!$OMP DO schedule(static) private(jj,ji,rswitch) 
    127209               DO jj = 1, jpj 
    128210                  DO ji = 1, jpi 
    … …  
    136218            END DO 
    137219         END DO 
     220!$OMP END PARALLEL 
    138221         tm_i  = tm_i  + rt0 
    139222         tm_su = tm_su + rt0 
    140223         ! 
    141224      ENDIF 
     225      CALL wrk_dealloc( jpi, jpj, nlay_s, ze_s ) 
     226      CALL wrk_dealloc( jpi, jpj, nlay_i, ze_i ) 
    142227      ! 
    143228   END SUBROUTINE lim_var_agg 
    … …  
    159244      ! Ice thickness, snow thickness, ice salinity, ice age 
    160245      !------------------------------------------------------- 
    161       DO jl = 1, jpl 
     246!$OMP PARALLEL 
     247      DO jl = 1, jpl 
     248!$OMP DO schedule(static) private(jj,ji,rswitch) 
    162249         DO jj = 1, jpj 
    163250            DO ji = 1, jpi 
    … …  
    168255      END DO 
    169256      ! Force the upper limit of ht_i to always be < hi_max (99 m). 
     257!$OMP DO schedule(static) private(jj,ji,rswitch) 
    170258      DO jj = 1, jpj 
    171259         DO ji = 1, jpi 
    … …  
    177265 
    178266      DO jl = 1, jpl 
     267!$OMP DO schedule(static) private(jj,ji,rswitch) 
    179268         DO jj = 1, jpj 
    180269            DO ji = 1, jpi 
    … …  
    188277      IF(  nn_icesal == 2  )THEN 
    189278         DO jl = 1, jpl 
     279!$OMP DO schedule(static) private(jj,ji,rswitch) 
    190280            DO jj = 1, jpj 
    191281               DO ji = 1, jpi 
    … …  
    198288         END DO 
    199289      ENDIF 
     290!$OMP END PARALLEL 
    200291 
    201292      CALL lim_var_salprof      ! salinity profile 
    … …  
    204295      ! Ice temperatures 
    205296      !------------------- 
     297!$OMP PARALLEL 
    206298      DO jl = 1, jpl 
    207299         DO jk = 1, nlay_i 
     300!$OMP DO schedule(static) private(jj,ji,rswitch,zq_i,ztmelts,zaaa,zbbb,zccc,zdiscrim) 
    208301            DO jj = 1, jpj 
    209302               DO ji = 1, jpi 
    … …  
    231324      DO jl = 1, jpl 
    232325         DO jk = 1, nlay_s 
     326!$OMP DO schedule(static) private(jj,ji,rswitch,zq_s) 
    233327            DO jj = 1, jpj 
    234328               DO ji = 1, jpi 
    … …  
    245339 
    246340      ! integrated values 
    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  
     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 
    251360      ! 
    252361   END SUBROUTINE lim_var_glo2eqv 
    … …  
    300409      !--------------------------------------- 
    301410      IF(  nn_icesal == 1  )  THEN 
    302          s_i (:,:,:,:) = rn_icesal 
    303          sm_i(:,:,:)   = rn_icesal 
     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 
    304431      ENDIF 
    305432 
    … …  
    309436      IF(  nn_icesal == 2  ) THEN 
    310437         ! 
    311          DO jk = 1, nlay_i 
    312             s_i(:,:,jk,:)  = sm_i(:,:,:) 
     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 
    313449         END DO 
    314450         ! 
    315451         DO jl = 1, jpl                               ! Slope of the linear profile  
     452!$OMP DO schedule(static) private(jj,ji,rswitch) 
    316453            DO jj = 1, jpj 
    317454               DO ji = 1, jpi 
    … …  
    320457               END DO 
    321458            END DO 
     459!$OMP END DO NOWAIT 
    322460         END DO 
    323461         ! 
    … …  
    325463         zfac1 = zsi1  / ( zsi1 - zsi0 ) 
    326464         ! 
    327          zalpha(:,:,:) = 0._wp 
    328465         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) 
    329475            DO jj = 1, jpj 
    330476               DO ji = 1, jpi 
    … …  
    345491         DO jl = 1, jpl 
    346492            DO jk = 1, nlay_i 
     493!$OMP DO schedule(static) private(jj,ji,zs_zero) 
    347494               DO jj = 1, jpj 
    348495                  DO ji = 1, jpi 
    … …  
    357504            END DO 
    358505         END DO 
     506!$OMP END PARALLEL 
    359507         ! 
    360508      ENDIF ! nn_icesal 
    … …  
    366514      IF(  nn_icesal == 3  ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30) 
    367515         ! 
    368          sm_i(:,:,:) = 2.30_wp 
     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 
    369526         ! 
    370527         DO jl = 1, jpl 
    … …  
    372529               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    373530               zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
    374                s_i(:,:,jk,jl) =  zsal 
    375             END DO 
    376          END DO 
     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 
    377540         ! 
    378541      ENDIF ! nn_icesal 
    … …  
    396559      !!------------------------------------------------------------------ 
    397560      ! 
    398       bvm_i(:,:)   = 0._wp 
    399       bv_i (:,:,:) = 0._wp 
     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 
    400576      DO jl = 1, jpl 
    401577         DO jk = 1, nlay_i 
     578!$OMP DO schedule(static) private(jj,ji,rswitch) 
    402579            DO jj = 1, jpj 
    403580               DO ji = 1, jpi 
    … …  
    409586         END DO 
    410587          
     588!$OMP DO schedule(static) private(jj,ji,rswitch) 
    411589         DO jj = 1, jpj 
    412590            DO ji = 1, jpi 
    … …  
    416594         END DO 
    417595      END DO 
     596!$OMP END PARALLEL 
    418597      ! 
    419598   END SUBROUTINE lim_var_bv 
    … …  
    518697      REAL(wp) ::   zsal, zvi, zvs, zei, zes 
    519698      !!------------------------------------------------------------------- 
    520       at_i (:,:) = 0._wp 
    521       DO jl = 1, jpl 
    522          at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     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 
    523713      END DO 
    524714 
    … …  
    529719         !----------------------------------------------------------------- 
    530720         DO jk = 1, nlay_i 
     721!$OMP DO schedule(static) private(jj,ji,rswitch,zei) 
    531722            DO jj = 1 , jpj 
    532723               DO ji = 1 , jpi 
    … …  
    545736         END DO 
    546737 
     738!$OMP DO schedule(static) private(jj,ji,rswitch,zsal,zvi,zvs,zes) 
    547739         DO jj = 1 , jpj 
    548740            DO ji = 1 , jpi 
    … …  
    583775 
    584776      ! to be sure that at_i is the sum of a_i(jl) 
    585       at_i (:,:) = 0._wp 
    586       DO jl = 1, jpl 
    587          at_i(:,:) = at_i(:,:) + 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 
    588790      END DO 
    589791 
    590792      ! open water = 1 if at_i=0 
     793!$OMP DO schedule(static) private(jj,ji,rswitch) 
    591794      DO jj = 1, jpj 
    592795         DO ji = 1, jpi 
    … …  
    595798         END DO 
    596799      END DO 
     800!$OMP END PARALLEL 
    597801 
    598802      ! 

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

    r7646 r7698  
    7474 
    7575      ! tresholds for outputs 
     76!$OMP PARALLEL 
     77!$OMP DO schedule(static) private(jj,ji) 
    7678      DO jj = 1, jpj 
    7779         DO ji = 1, jpi 
    … …  
    8082      END DO 
    8183      DO jl = 1, jpl 
     84!$OMP DO schedule(static) private(jj,ji) 
    8285         DO jj = 1, jpj 
    8386            DO ji = 1, jpi 
    … …  
    8689         END DO 
    8790      END DO 
     91!$OMP END PARALLEL 
    8892      ! 
    8993      ! fluxes 
    … …  
    104108      ! velocity 
    105109      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) 
    106111         DO jj = 2 , jpjm1 
    107112            DO ji = 2 , jpim1 
    … …  
    173178 
    174179      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations   
    175          WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog 
    176          ELSEWHERE                                       ; z2d = 0._wp 
    177          END WHERE 
     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 
    178190         CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp ) 
    179191      ENDIF 

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

    r7646 r7698  
    156156      USE lib_mpp, ONLY: ctl_warn, mpp_sum 
    157157      ! 
     158      INTEGER :: ji, jj         ! dummy loop indices 
    158159      INTEGER :: bdy_oce_alloc 
    159160      !!---------------------------------------------------------------------- 
    … …  
    163164      ! 
    164165      ! Initialize masks  
    165       bdytmask(:,:) = 1._wp 
    166       bdyumask(:,:) = 1._wp 
    167       bdyvmask(:,:) = 1._wp 
     166!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     167      DO jj = 1, jpj 
     168         DO ji = 1, jpi 
     169            bdytmask(ji,jj) = 1._wp 
     170            bdyumask(ji,jj) = 1._wp 
     171            bdyvmask(ji,jj) = 1._wp 
     172         END DO 
     173      END DO 
    168174      !  
    169175      IF( lk_mpp             )   CALL mpp_sum ( bdy_oce_alloc ) 

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

    r6140 r7698  
    6262      INTEGER ::   ios                 ! Local integer output status for namelist read 
    6363      INTEGER ::   ierror              ! Local integer for memory allocation 
     64      INTEGER ::   ji, jj, jk 
    6465      ! 
    6566      NAMELIST/nam_dia25h/ ln_dia25h 
    … …  
    134135      ! ------------------------- ! 
    135136      cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible)  
    136       tn_25h(:,:,:) = tsb(:,:,:,jp_tem) 
    137       sn_25h(:,:,:) = tsb(:,:,:,jp_sal) 
    138       sshn_25h(:,:) = sshb(:,:) 
    139       un_25h(:,:,:) = ub(:,:,:) 
    140       vn_25h(:,:,:) = vb(:,:,:) 
    141       wn_25h(:,:,:) = wn(:,:,:) 
    142       avt_25h(:,:,:) = avt(:,:,:) 
    143       avm_25h(:,:,:) = avm(:,:,:) 
     137!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     138         DO jk = 1, jpk 
     139            DO jj = 1, jpj 
     140               DO ji = 1, jpi 
     141                  tn_25h(ji,jj,jk) = tsb(ji,jj,jk,jp_tem) 
     142                  sn_25h(ji,jj,jk) = tsb(ji,jj,jk,jp_sal) 
     143                  sshn_25h(ji,jj) = sshb(ji,jj) 
     144                  un_25h(ji,jj,jk) = ub(ji,jj,jk) 
     145                  vn_25h(ji,jj,jk) = vb(ji,jj,jk) 
     146                  wn_25h(ji,jj,jk) = wn(ji,jj,jk) 
     147                  avt_25h(ji,jj,jk) = avt(ji,jj,jk) 
     148                  avm_25h(ji,jj,jk) = avm(ji,jj,jk) 
    144149# if defined key_zdfgls || defined key_zdftke 
    145          en_25h(:,:,:) = en(:,:,:) 
     150                  en_25h(ji,jj,jk) = en(ji,jj,jk) 
    146151#endif 
    147152# if defined key_zdfgls 
    148          rmxln_25h(:,:,:) = mxln(:,:,:) 
    149 #endif 
     153                  rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 
     154#endif 
     155               END DO 
     156            END DO 
     157         END DO 
    150158#if defined key_lim3 || defined key_lim2 
    151159         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
    … …  
    223231         ENDIF 
    224232 
    225          tn_25h(:,:,:)        = tn_25h(:,:,:) + tsn(:,:,:,jp_tem) 
    226          sn_25h(:,:,:)        = sn_25h(:,:,:) + tsn(:,:,:,jp_sal) 
    227          sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:) 
    228          un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:) 
    229          vn_25h(:,:,:)        = vn_25h(:,:,:) + vn(:,:,:) 
    230          wn_25h(:,:,:)        = wn_25h(:,:,:) + wn(:,:,:) 
    231          avt_25h(:,:,:)       = avt_25h(:,:,:) + avt(:,:,:) 
    232          avm_25h(:,:,:)       = avm_25h(:,:,:) + avm(:,:,:) 
     233!$OMP PARALLEL 
     234!$OMP DO schedule(static) private(jj, ji) 
     235         DO jj = 1, jpj 
     236            DO ji = 1, jpi 
     237               sshn_25h(ji,jj)     = sshn_25h(ji,jj) + sshn (ji,jj) 
     238            END DO 
     239         END DO 
     240!$OMP END DO NOWAIT 
     241!$OMP DO schedule(static) private(jk, jj, ji) 
     242         DO jk = 1, jpk 
     243            DO jj = 1, jpj 
     244               DO ji = 1, jpi 
     245                  tn_25h(ji,jj,jk)        = tn_25h(ji,jj,jk) + tsn(ji,jj,jk,jp_tem) 
     246                  sn_25h(ji,jj,jk)        = sn_25h(ji,jj,jk) + tsn(ji,jj,jk,jp_sal) 
     247                  un_25h(ji,jj,jk)        = un_25h(ji,jj,jk) + un(ji,jj,jk) 
     248                  vn_25h(ji,jj,jk)        = vn_25h(ji,jj,jk) + vn(ji,jj,jk) 
     249                  wn_25h(ji,jj,jk)        = wn_25h(ji,jj,jk) + wn(ji,jj,jk) 
     250                  avt_25h(ji,jj,jk)       = avt_25h(ji,jj,jk) + avt(ji,jj,jk) 
     251                  avm_25h(ji,jj,jk)       = avm_25h(ji,jj,jk) + avm(ji,jj,jk) 
    233252# if defined key_zdfgls || defined key_zdftke 
    234          en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:) 
     253                  en_25h(ji,jj,jk)        = en_25h(ji,jj,jk) + en(ji,jj,jk) 
    235254#endif 
    236255# if defined key_zdfgls 
    237          rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:) 
    238 #endif 
     256                  rmxln_25h(ji,jj,jk)      = rmxln_25h(ji,jj,jk) + mxln(ji,jj,jk) 
     257#endif 
     258               END DO 
     259            END DO 
     260         END DO 
     261!$OMP END PARALLEL 
    239262         cnt_25h = cnt_25h + 1 
    240263 
    … …  
    253276            ENDIF 
    254277 
    255             tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp 
    256             sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp 
    257             sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp 
    258             un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp 
    259             vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp 
    260             wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp 
    261             avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp 
    262             avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp 
     278!$OMP PARALLEL 
     279!$OMP DO schedule(static) private(jj, ji) 
     280         DO jj = 1, jpj 
     281            DO ji = 1, jpi 
     282               sshn_25h(ji,jj)     = sshn_25h(ji,jj) / 25.0_wp 
     283            END DO 
     284         END DO 
     285!$OMP END DO NOWAIT 
     286!$OMP DO schedule(static) private(jk, jj, ji) 
     287         DO jk = 1, jpk 
     288            DO jj = 1, jpj 
     289               DO ji = 1, jpi 
     290                  tn_25h(ji,jj,jk)        = tn_25h(ji,jj,jk) / 25.0_wp 
     291                  sn_25h(ji,jj,jk)        = sn_25h(ji,jj,jk) / 25.0_wp 
     292                  un_25h(ji,jj,jk)        = un_25h(ji,jj,jk) / 25.0_wp 
     293                  vn_25h(ji,jj,jk)        = vn_25h(ji,jj,jk) / 25.0_wp 
     294                  wn_25h(ji,jj,jk)        = wn_25h(ji,jj,jk) / 25.0_wp 
     295                  avt_25h(ji,jj,jk)       = avt_25h(ji,jj,jk) / 25.0_wp 
     296                  avm_25h(ji,jj,jk)       = avm_25h(ji,jj,jk) / 25.0_wp 
    263297# if defined key_zdfgls || defined key_zdftke 
    264             en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp 
     298                  en_25h(ji,jj,jk)        = en_25h(ji,jj,jk) / 25.0_wp 
    265299#endif 
    266300# if defined key_zdfgls 
    267             rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp 
    268 #endif 
     301                  rmxln_25h(ji,jj,jk)       = rmxln_25h(ji,jj,jk) / 25.0_wp 
     302#endif 
     303               END DO 
     304            END DO 
     305         END DO 
     306!$OMP END PARALLEL 
    269307 
    270308            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output' 
    271309            zmdi=1.e+20 !missing data indicator for masking 
    272310            ! write tracers (instantaneous) 
    273             zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     311!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     312         DO jk = 1, jpk 
     313            DO jj = 1, jpj 
     314               DO ji = 1, jpi 
     315                  zw3d(ji,jj,jk) = tn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
     316               END DO 
     317            END DO 
     318         END DO 
    274319            CALL iom_put("temper25h", zw3d)   ! potential temperature 
    275             zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     320!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     321         DO jk = 1, jpk 
     322            DO jj = 1, jpj 
     323               DO ji = 1, jpi 
     324                  zw3d(ji,jj,jk) = sn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
     325               END DO 
     326            END DO 
     327         END DO 
    276328            CALL iom_put( "salin25h", zw3d  )   ! salinity 
    277             zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 
     329!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     330         DO jj = 1, jpj 
     331            DO ji = 1, jpi 
     332               zw2d(ji,jj) = sshn_25h(ji,jj)*tmask(ji,jj,1) + zmdi*(1.0-tmask(ji,jj,1)) 
     333            END DO 
     334         END DO 
    278335            CALL iom_put( "ssh25h", zw2d )   ! sea surface  
    279336 
    280337 
    281338            ! Write velocities (instantaneous) 
    282             zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:)) 
     339!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     340         DO jk = 1, jpk 
     341            DO jj = 1, jpj 
     342               DO ji = 1, jpi 
     343                  zw3d(ji,jj,jk) = un_25h(ji,jj,jk)*umask(ji,jj,jk) + zmdi*(1.0-umask(ji,jj,jk)) 
     344               END DO 
     345            END DO 
     346         END DO 
    283347            CALL iom_put("vozocrtx25h", zw3d)    ! i-current 
    284             zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:)) 
     348!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     349         DO jk = 1, jpk 
     350            DO jj = 1, jpj 
     351               DO ji = 1, jpi 
     352                  zw3d(ji,jj,jk) = vn_25h(ji,jj,jk)*vmask(ji,jj,jk) + zmdi*(1.0-vmask(ji,jj,jk)) 
     353               END DO 
     354            END DO 
     355         END DO 
    285356            CALL iom_put("vomecrty25h", zw3d  )   ! j-current 
    286  
    287             zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     357!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     358         DO jk = 1, jpk 
     359            DO jj = 1, jpj 
     360               DO ji = 1, jpi 
     361                  zw3d(ji,jj,jk) = wn_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
     362               END DO 
     363            END DO 
     364         END DO 
    288365            CALL iom_put("vomecrtz25h", zw3d )   ! k-current 
    289             zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     366!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     367         DO jk = 1, jpk 
     368            DO jj = 1, jpj 
     369               DO ji = 1, jpi 
     370                  zw3d(ji,jj,jk) = avt_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
     371               END DO 
     372            END DO 
     373         END DO 
    290374            CALL iom_put("avt25h", zw3d )   ! diffusivity 
    291             zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     375!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     376         DO jk = 1, jpk 
     377            DO jj = 1, jpj 
     378               DO ji = 1, jpi 
     379                  zw3d(ji,jj,jk) = avm_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
     380               END DO 
     381            END DO 
     382         END DO 
    292383            CALL iom_put("avm25h", zw3d)   ! viscosity 
    293384#if defined key_zdftke || defined key_zdfgls  
    294             zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     385!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     386         DO jk = 1, jpk 
     387            DO jj = 1, jpj 
     388               DO ji = 1, jpi 
     389                  zw3d(ji,jj,jk) = en_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
     390               END DO 
     391            END DO 
     392         END DO 
    295393            CALL iom_put("tke25h", zw3d)   ! tke 
    296394#endif 
    297395#if defined key_zdfgls  
    298             zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 
     396!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     397         DO jk = 1, jpk 
     398            DO jj = 1, jpj 
     399               DO ji = 1, jpi 
     400                  zw3d(ji,jj,jk) = rmxln_25h(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 
     401               END DO 
     402            END DO 
     403         END DO 
    299404            CALL iom_put( "mxln25h",zw3d) 
    300405#endif 
    301406 
    302407            ! After the write reset the values to cnt=1 and sum values equal current value  
    303             tn_25h(:,:,:) = tsn(:,:,:,jp_tem) 
    304             sn_25h(:,:,:) = tsn(:,:,:,jp_sal) 
    305             sshn_25h(:,:) = sshn (:,:) 
    306             un_25h(:,:,:) = un(:,:,:) 
    307             vn_25h(:,:,:) = vn(:,:,:) 
    308             wn_25h(:,:,:) = wn(:,:,:) 
    309             avt_25h(:,:,:) = avt(:,:,:) 
    310             avm_25h(:,:,:) = avm(:,:,:) 
     408!$OMP PARALLEL 
     409!$OMP DO schedule(static) private(jj, ji) 
     410         DO jj = 1, jpj 
     411            DO ji = 1, jpi 
     412               sshn_25h(ji,jj) = sshn (ji,jj) 
     413            END DO 
     414         END DO 
     415!$OMP END DO NOWAIT 
     416!$OMP DO schedule(static) private(jk, jj, ji) 
     417         DO jk = 1, jpk 
     418            DO jj = 1, jpj 
     419               DO ji = 1, jpi 
     420                  tn_25h(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) 
     421                  sn_25h(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 
     422                  un_25h(ji,jj,jk) = un(ji,jj,jk) 
     423                  vn_25h(ji,jj,jk) = vn(ji,jj,jk) 
     424                  wn_25h(ji,jj,jk) = wn(ji,jj,jk) 
     425                  avt_25h(ji,jj,jk) = avt(ji,jj,jk) 
     426                  avm_25h(ji,jj,jk) = avm(ji,jj,jk) 
    311427# if defined key_zdfgls || defined key_zdftke 
    312             en_25h(:,:,:) = en(:,:,:) 
     428                  en_25h(ji,jj,jk) = en(ji,jj,jk) 
    313429#endif 
    314430# if defined key_zdfgls 
    315             rmxln_25h(:,:,:) = mxln(:,:,:) 
    316 #endif 
     431                  rmxln_25h(ji,jj,jk) = mxln(ji,jj,jk) 
     432#endif 
     433               END DO 
     434            END DO 
     435         END DO 
     436!$OMP END PARALLEL 
    317437            cnt_25h = 1 
    318438            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h 

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

    r7646 r7698  
    8989         CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    ) 
    9090         CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 ) 
    91          zarea_ssh(:,:) = area(:,:) * sshn(:,:) 
     91!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     92         DO jj = 1, jpj 
     93            DO ji = 1, jpi 
     94               zarea_ssh(ji,jj) = area(ji,jj) * sshn(ji,jj) 
     95            END DO 
     96         END DO 
    9297      ENDIF 
    9398      ! 
    … …  
    106111      IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' )  .OR. iom_use( 'sshsteric' )  ) THEN     
    107112         !                      
    108          ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
    109          ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
     113!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     114         DO jk = 1, jpk 
     115            DO jj = 1, jpj 
     116               DO ji = 1, jpi 
     117                  ztsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem)                    ! thermosteric ssh 
     118                  ztsn(ji,jj,jk,jp_sal) = sn0(ji,jj,jk) 
     119               END DO 
     120            END DO 
     121         END DO 
    110122         CALL eos( ztsn, zrhd, gdept_n(:,:,:) )                       ! now in situ density using initial salinity 
    111123         ! 
    112          zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     124!$OMP PARALLEL 
     125!$OMP DO schedule(static) private(jj, ji) 
     126         DO jj = 1, jpj 
     127            DO ji = 1, jpi 
     128               zbotpres(ji,jj) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     129            END DO 
     130         END DO 
    113131         DO jk = 1, jpkm1 
    114             zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
    115          END DO 
     132!$OMP DO schedule(static) private(jj, ji) 
     133            DO jj = 1, jpj 
     134               DO ji = 1, jpi 
     135                  zbotpres(ji,jj) = zbotpres(ji,jj) + e3t_n(ji,jj,jk) * zrhd(ji,jj,jk) 
     136               END DO 
     137            END DO 
     138         END DO 
     139!$OMP END PARALLEL 
    116140         IF( ln_linssh ) THEN 
    117141            IF( ln_isfcav ) THEN 
     142!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    118143               DO ji = 1, jpi 
    119144                  DO jj = 1, jpj 
    … …  
    122147               END DO 
    123148            ELSE 
    124                zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     149!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     150               DO ji = 1, jpi 
     151                  DO jj = 1, jpj 
     152                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,1) 
     153                  END DO 
     154               END DO 
    125155            END IF 
    126156!!gm 
    … …  
    128158!!gm 
    129159         END IF 
     160         ! 
     161         zarho = SUM( area(:,:) * zbotpres(:,:) ) 
    130162         !                                          
    131          zarho = SUM( area(:,:) * zbotpres(:,:) )  
    132163         IF( lk_mpp )   CALL mpp_sum( zarho ) 
    133164         zssh_steric = - zarho / area_tot 
    … …  
    136167         !                                         ! steric sea surface height 
    137168         CALL eos( tsn, zrhd, zrhop, gdept_n(:,:,:) )                 ! now in situ and potential density 
    138          zrhop(:,:,jpk) = 0._wp 
     169!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     170         DO jj = 1, jpj 
     171            DO ji = 1, jpi 
     172               zrhop(ji,jj,jpk) = 0._wp 
     173            END DO 
     174         END DO 
    139175         CALL iom_put( 'rhop', zrhop ) 
    140176         ! 
    141          zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     177!$OMP PARALLEL 
     178!$OMP DO schedule(static) private(jj, ji) 
     179         DO jj = 1, jpj 
     180            DO ji = 1, jpi 
     181               zbotpres(ji,jj) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice 
     182            END DO 
     183         END DO 
    142184         DO jk = 1, jpkm1 
    143             zbotpres(:,:) = zbotpres(:,:) + e3t_n(:,:,jk) * zrhd(:,:,jk) 
     185!$OMP DO schedule(static) private(jj, ji) 
     186            DO jj = 1, jpj 
     187               DO ji = 1, jpi 
     188                  zbotpres(ji,jj) = zbotpres(ji,jj) + e3t_n(ji,jj,jk) * zrhd(ji,jj,jk) 
     189               END DO 
     190            END DO 
    144191         END DO 
    145192         IF( ln_linssh ) THEN 
    146193            IF ( ln_isfcav ) THEN 
     194!$OMP DO schedule(static) private(jj, ji) 
    147195               DO ji = 1,jpi 
    148196                  DO jj = 1,jpj 
    … …  
    151199               END DO 
    152200            ELSE 
    153                zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 
     201!$OMP DO schedule(static) private(jj, ji) 
     202               DO jj = 1, jpj 
     203                  DO ji = 1, jpi 
     204                     zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,1) 
     205                  END DO 
     206               END DO 
    154207            END IF 
    155208         END IF 
     209!$OMP END PARALLEL 
    156210         !     
    157          zarho = SUM( area(:,:) * zbotpres(:,:) )  
     211         zarho = SUM( area(:,:) * zbotpres(:,:) ) 
    158212         IF( lk_mpp )   CALL mpp_sum( zarho ) 
    159213         zssh_steric = - zarho / area_tot 
    … …  
    162216         !                                         ! ocean bottom pressure 
    163217         zztmp = rau0 * grav * 1.e-4_wp               ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 
    164          zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 
     218!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     219         DO jj = 1, jpj 
     220            DO ji = 1, jpi 
     221               zbotpres(ji,jj) = zztmp * ( zbotpres(ji,jj) + sshn(ji,jj) + thick0(ji,jj) ) 
     222            END DO 
     223         END DO 
    165224         CALL iom_put( 'botpres', zbotpres ) 
    166225         ! 
    … …  
    213272      ! work is not being done against stratification 
    214273          CALL wrk_alloc( jpi, jpj, zpe ) 
    215           zpe(:,:) = 0._wp 
     274!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     275          DO jj = 1, jpj 
     276             DO ji = 1, jpi 
     277                zpe(ji,jj) = 0._wp 
     278             END DO 
     279          END DO 
    216280          IF( lk_zdfddm ) THEN 
     281!$OMP PARALLEL DO schedule(static) private(ji,jj,jk,zrw,zaw,zbw) 
    217282             DO ji=1,jpi 
    218283                DO jj=1,jpj 
    … …  
    232297             ENDDO 
    233298          ELSE 
     299!$OMP PARALLEL DO schedule(static) private(ji,jj,jk) 
    234300             DO ji = 1, jpi 
    235301                DO jj = 1, jpj 
    … …  
    323389      INTEGER  ::   ik 
    324390      INTEGER  ::   ji, jj, jk  ! dummy loop indices 
    325       REAL(wp) ::   zztmp   
     391      REAL(wp) ::   zztmp, zsum  
    326392      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zsaldta   ! Jan/Dec levitus salinity 
    327393      ! 
    … …  
    341407         IF( dia_ar5_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 
    342408 
    343          area(:,:) = e1e2t(:,:) * tmask_i(:,:) 
     409!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     410         DO jj = 1, jpj 
     411            DO ji = 1, jpi 
     412               area(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj) 
     413            END DO 
     414         END DO 
    344415 
    345416         area_tot = SUM( area(:,:) )   ;   IF( lk_mpp )   CALL mpp_sum( area_tot ) 
    346417 
    347418         vol0        = 0._wp 
    348          thick0(:,:) = 0._wp 
     419!$OMP PARALLEL 
     420!$OMP DO schedule(static) private(jj, ji) 
     421         DO jj = 1, jpj 
     422            DO ji = 1, jpi 
     423               thick0(ji,jj) = 0._wp 
     424            END DO 
     425         END DO 
    349426         DO jk = 1, jpkm1 
    350             vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 
    351             thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 
    352          END DO 
     427!$OMP DO schedule(static) private(jj, ji, zsum) 
     428            DO jj = 1, jpj 
     429               DO ji = 1, jpi 
     430                  zsum = area (ji,jj) * tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
     431               END DO 
     432            END DO 
     433            vol0        = vol0        + zsum 
     434!$OMP DO schedule(static) private(jj, ji) 
     435            DO jj = 1, jpj 
     436               DO ji = 1, jpi 
     437                  thick0(ji,jj) = thick0(ji,jj) + tmask_i(ji,jj) * tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 
     438               END DO 
     439            END DO 
     440         END DO 
     441!$OMP END PARALLEL 
    353442         IF( lk_mpp )   CALL mpp_sum( vol0 ) 
    354443 
    … …  
    358447         CALL iom_close( inum ) 
    359448 
    360          sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) )         
    361          sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 
     449!$OMP PARALLEL 
     450!$OMP DO schedule(static) private(jk, jj, ji) 
     451         DO jk = 1, jpk 
     452            DO jj = 1, jpj 
     453               DO ji = 1, jpi 
     454                  sn0(ji,jj,jk) = 0.5_wp * ( zsaldta(ji,jj,jk,1) + zsaldta(ji,jj,jk,2) )         
     455                  sn0(ji,jj,jk) = sn0(ji,jj,jk) * tmask(ji,jj,jk) 
     456               END DO 
     457            END DO 
     458         END DO 
    362459         IF( ln_zps ) THEN               ! z-coord. partial steps 
     460!$OMP DO schedule(static) private(jj, ji, ik, zztmp) 
    363461            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    364462               DO ji = 1, jpi 
    … …  
    371469            END DO 
    372470         ENDIF 
     471!$OMP END PARALLEL 
    373472         ! 
    374473         CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 

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

    r6140 r7698  
    7171 
    7272             ! calculate Courant numbers 
     73!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    7374         DO jk = 1, jpk 
    7475            DO jj = 1, jpj 
    … …  
    172173      !!---------------------------------------------------------------------- 
    173174 
     175      INTEGER  :: ji, jj, jk                                ! dummy loop indices 
    174176 
    175177      IF( nn_diacfl == 1 ) THEN 
    … …  
    181183 
    182184         ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 
    183  
    184          zcu_cfl(:,:,:)=0.0 
    185          zcv_cfl(:,:,:)=0.0 
    186          zcw_cfl(:,:,:)=0.0 
    187  
     185!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     186         DO jk = 1, jpk 
     187            DO jj = 1, jpj 
     188               DO ji = 1, jpi 
     189                  zcu_cfl(ji,jj,jk)=0.0 
     190                  zcv_cfl(ji,jj,jk)=0.0 
     191                  zcw_cfl(ji,jj,jk)=0.0 
     192               END DO 
     193            END DO 
     194         END DO 
    188195         IF( lwp ) THEN 
    189196            WRITE(numout,*) 

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

    r7646 r7698  
    8888      CALL wrk_alloc( jpi,jpj,   z2d0, z2d1 ) 
    8989      ! 
    90       tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; 
    91       tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ; 
     90!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     91      DO jk = 1, jpk 
     92         DO jj = 1, jpj 
     93            DO ji = 1, jpi 
     94               tsn(ji,jj,jk,1) = tsn(ji,jj,jk,1) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,1) = tsb(ji,jj,jk,1) * tmask(ji,jj,jk)  
     95               tsn(ji,jj,jk,2) = tsn(ji,jj,jk,2) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,2) = tsb(ji,jj,jk,2) * tmask(ji,jj,jk) 
     96            END DO 
     97         END DO 
     98      END DO 
    9299      ! ------------------------- ! 
    93100      ! 1 - Trends due to forcing ! 
    … …  
    108115      IF( ln_linssh ) THEN 
    109116         IF( ln_isfcav ) THEN 
     117!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    110118            DO ji=1,jpi 
    111119               DO jj=1,jpj 
    … …  
    115123            END DO 
    116124         ELSE 
    117             z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) 
    118             z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) 
     125!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     126            DO ji=1,jpi 
     127               DO jj=1,jpj 
     128                  z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_tem) 
     129                  z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_sal) 
     130               END DO 
     131            END DO 
    119132         END IF 
    120133         z_wn_trd_t = - glob_sum( z2d0 )  
    … …  
    145158      IF( ln_linssh ) THEN 
    146159         IF( ln_isfcav ) THEN 
     160!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    147161            DO ji = 1, jpi 
    148162               DO jj = 1, jpj 
    … …  
    152166            END DO 
    153167         ELSE 
    154             z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) )  
    155             z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) )  
     168!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     169            DO jj = 1, jpj 
     170               DO ji = 1, jpi 
     171                  z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) )  
     172                  z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) )  
     173               END DO 
     174            END DO 
    156175         END IF 
    157176         z_ssh_hc = glob_sum_full( z2d0 )  
    … …  
    275294          IF(lwp) WRITE(numout,*) ' dia_hsb at initial state ' 
    276295          IF(lwp) WRITE(numout,*) '~~~~~~~' 
    277           surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface 
    278           ssh_ini(:,:) = sshn(:,:)                          ! initial ssh 
     296!$OMP PARALLEL 
     297!$OMP DO schedule(static) private(jj,ji) 
     298          DO jj = 1, jpj 
     299             DO ji = 1, jpi 
     300                surf_ini(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj)         ! initial ocean surface 
     301                ssh_ini(ji,jj) = sshn(ji,jj)                          ! initial ssh 
     302             END DO 
     303          END DO 
     304!$OMP DO schedule(static) private(jk,jj,ji) 
    279305          DO jk = 1, jpk 
    280              ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
    281              e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors 
    282              hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content 
    283              sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content 
     306             DO jj = 1, jpj 
     307                DO ji = 1, jpi 
     308                   ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 
     309                   e3t_ini   (ji,jj,jk) = e3t_n(ji,jj,jk)                      * tmask(ji,jj,jk)  ! initial vertical scale factors 
     310                   hc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! initial heat content 
     311                   sc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! initial salt content 
     312                END DO 
     313             END DO 
    284314          END DO 
     315!$OMP END PARALLEL 
    285316          frc_v = 0._wp                                           ! volume       trend due to forcing 
    286317          frc_t = 0._wp                                           ! heat content   -    -   -    -    
    … …  
    288319          IF( ln_linssh ) THEN 
    289320             IF ( ln_isfcav ) THEN 
     321!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    290322                DO ji=1,jpi 
    291323                   DO jj=1,jpj 
    … …  
    295327                ENDDO 
    296328             ELSE 
    297                 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh 
    298                 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh 
     329!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     330                DO jj = 1, jpj 
     331                   DO ji = 1, jpi 
     332                      ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_tem) * sshn(ji,jj)   ! initial heat content in ssh 
     333                      ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_sal) * sshn(ji,jj)   ! initial salt content in ssh 
     334                   ENDDO 
     335                ENDDO 
    299336             END IF 
    300337             frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface 
    … …  
    345382      INTEGER ::   ierror   ! local integer 
    346383      INTEGER ::   ios 
     384      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    347385      !! 
    348386      NAMELIST/namhsb/ ln_diahsb 
    … …  
    384422      ! 2 - Time independant variables and file opening ! 
    385423      ! ----------------------------------------------- ! 
    386       surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)      ! masked surface grid cell area 
     424!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     425      DO jj = 1, jpj 
     426         DO ji = 1, jpi 
     427            surf(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! masked surface grid cell area 
     428         END DO 
     429      END DO 
    387430      surf_tot  = glob_sum( surf(:,:) )                   ! total ocean surface area 
    388431 

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

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

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

    r7646 r7698  
    161161      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
    162162      IF ( iom_use("sbt") ) THEN 
     163!$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    163164         DO jj = 1, jpj 
    164165            DO ji = 1, jpi 
    … …  
    173174      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
    174175      IF ( iom_use("sbs") ) THEN 
     176!$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    175177         DO jj = 1, jpj 
    176178            DO ji = 1, jpi 
    … …  
    183185 
    184186      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    185          z2d(:,:) = 0._wp 
     187!$OMP PARALLEL 
     188!$OMP DO schedule(static) private(jj, ji) 
     189         DO jj = 1, jpj 
     190            DO ji = 1, jpi 
     191               z2d(ji,jj) = 0._wp 
     192            END DO 
     193         END DO 
     194!$OMP DO schedule(static) private(jj, ji, zztmpx,zztmpy) 
    186195         DO jj = 2, jpjm1 
    187196            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    194203            ENDDO 
    195204         ENDDO 
     205!$OMP END PARALLEL 
    196206         CALL lbc_lnk( z2d, 'T', 1. ) 
    197207         CALL iom_put( "taubot", z2d )            
    … …  
    201211      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current 
    202212      IF ( iom_use("sbu") ) THEN 
     213!$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    203214         DO jj = 1, jpj 
    204215            DO ji = 1, jpi 
    … …  
    213224      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current 
    214225      IF ( iom_use("sbv") ) THEN 
     226!$OMP PARALLEL DO schedule(static) private(jj, ji,jkbot) 
    215227         DO jj = 1, jpj 
    216228            DO ji = 1, jpi 
    … …  
    225237      IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN   ! vertical mass transport & its square value 
    226238         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    227          z2d(:,:) = rau0 * e1e2t(:,:) 
     239!$OMP PARALLEL 
     240!$OMP DO schedule(static) private(jj, ji) 
     241         DO jj = 1, jpj 
     242            DO ji = 1, jpi 
     243               z2d(ji,jj) = rau0 * e1e2t(ji,jj) 
     244            END DO 
     245         END DO 
     246!$OMP DO schedule(static) private(jk,jj,ji) 
    228247         DO jk = 1, jpk 
    229             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
    230          END DO 
     248            DO jj = 1, jpj 
     249               DO ji = 1, jpi 
     250                  z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj) 
     251               END DO 
     252            END DO 
     253         END DO 
     254!$OMP END PARALLEL 
    231255         CALL iom_put( "w_masstr" , z3d )   
    232256         IF( iom_use('w_masstr2') )   CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 
    … …  
    241265 
    242266      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
     267!$OMP PARALLEL DO schedule(static) private(jj, ji, zztmp, zztmpx, zztmpy) 
    243268         DO jj = 2, jpjm1                                    ! sst gradient 
    244269            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    252277         CALL lbc_lnk( z2d, 'T', 1. ) 
    253278         CALL iom_put( "sstgrad2",  z2d               )    ! square of module of sst gradient 
    254          z2d(:,:) = SQRT( z2d(:,:) ) 
     279!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     280         DO jj = 1, jpj 
     281            DO ji = 1, jpi 
     282               z2d(ji,jj) = SQRT( z2d(ji,jj) ) 
     283            END DO 
     284         END DO 
    255285         CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient 
    256286      ENDIF 
    … …  
    258288      ! clem: heat and salt content 
    259289      IF( iom_use("heatc") ) THEN 
    260          z2d(:,:)  = 0._wp  
     290!$OMP PARALLEL 
     291!$OMP DO schedule(static) private(jj, ji) 
     292         DO jj = 1, jpj 
     293            DO ji = 1, jpi 
     294               z2d(ji,jj) = 0._wp 
     295            END DO 
     296         END DO 
    261297         DO jk = 1, jpkm1 
     298!$OMP DO schedule(static) private(jj, ji) 
    262299            DO jj = 1, jpj 
    263300               DO ji = 1, jpi 
    … …  
    266303            END DO 
    267304         END DO 
     305!$OMP END PARALLEL 
    268306         CALL iom_put( "heatc", (rau0 * rcp) * z2d )    ! vertically integrated heat content (J/m2) 
    269307      ENDIF 
    270308 
    271309      IF( iom_use("saltc") ) THEN 
    272          z2d(:,:)  = 0._wp  
     310!$OMP PARALLEL 
     311!$OMP DO schedule(static) private(jj, ji) 
     312         DO jj = 1, jpj 
     313            DO ji = 1, jpi 
     314               z2d(ji,jj) = 0._wp 
     315            END DO 
     316         END DO 
    273317         DO jk = 1, jpkm1 
     318!$OMP DO schedule(static) private(jj, ji) 
    274319            DO jj = 1, jpj 
    275320               DO ji = 1, jpi 
    … …  
    278323            END DO 
    279324         END DO 
     325!$OMP END PARALLEL 
    280326         CALL iom_put( "saltc", rau0 * z2d )   ! vertically integrated salt content (PSU*kg/m2) 
    281327      ENDIF 
    282328      ! 
    283329      IF ( iom_use("eken") ) THEN 
    284          rke(:,:,jk) = 0._wp                               !      kinetic energy  
     330!$OMP PARALLEL 
     331!$OMP DO schedule(static) private(jj, ji) 
     332         DO jj = 1, jpj 
     333            DO ji = 1, jpi 
     334               rke(ji,jj,jk) = 0._wp                               !      kinetic energy  
     335            END DO 
     336         END DO 
     337!$OMP DO schedule(static) private(jk, jj, ji, zztmp, zztmpx, zztmpy) 
    285338         DO jk = 1, jpkm1 
    286339            DO jj = 2, jpjm1 
    … …  
    300353            ENDDO 
    301354         ENDDO 
     355!$OMP END PARALLEL 
    302356         CALL lbc_lnk( rke, 'T', 1. ) 
    303357         CALL iom_put( "eken", rke )            
    … …  
    307361      ! 
    308362      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    309          z3d(:,:,jpk) = 0.e0 
    310          z2d(:,:) = 0.e0 
     363!$OMP PARALLEL 
     364!$OMP DO schedule(static) private(jj, ji) 
     365         DO jj = 1, jpj 
     366            DO ji = 1, jpi 
     367               z3d(ji,jj,jpk) = 0.e0 
     368               z2d(ji,jj) = 0.e0 
     369            END DO 
     370         END DO 
    311371         DO jk = 1, jpkm1 
    312             z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
    313             z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    314          END DO 
     372!$OMP DO schedule(static) private(jj, ji) 
     373            DO jj = 1, jpj 
     374               DO ji = 1, jpi 
     375                  z3d(ji,jj,jk) = rau0 * un(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
     376                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) 
     377               END DO 
     378            END DO 
     379         END DO 
     380!$OMP END PARALLEL 
    315381         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
    316382         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum 
    … …  
    318384       
    319385      IF( iom_use("u_heattr") ) THEN 
    320          z2d(:,:) = 0.e0  
     386!$OMP PARALLEL 
     387!$OMP DO schedule(static) private(jj, ji) 
     388         DO jj = 1, jpj 
     389            DO ji = 1, jpi 
     390               z2d(ji,jj) = 0.e0 
     391            END DO 
     392         END DO 
    321393         DO jk = 1, jpkm1 
     394!$OMP DO schedule(static) private(jj, ji) 
    322395            DO jj = 2, jpjm1 
    323396               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    326399            END DO 
    327400         END DO 
     401!$OMP END PARALLEL 
    328402         CALL lbc_lnk( z2d, 'U', -1. ) 
    329403         CALL iom_put( "u_heattr", (0.5 * rcp) * z2d )    ! heat transport in i-direction 
    … …  
    331405 
    332406      IF( iom_use("u_salttr") ) THEN 
    333          z2d(:,:) = 0.e0  
     407!$OMP PARALLEL 
     408!$OMP DO schedule(static) private(jj, ji) 
     409         DO jj = 1, jpj 
     410            DO ji = 1, jpi 
     411               z2d(ji,jj) = 0.e0 
     412            END DO 
     413         END DO 
    334414         DO jk = 1, jpkm1 
     415!$OMP DO schedule(static) private(jj, ji) 
    335416            DO jj = 2, jpjm1 
    336417               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    339420            END DO 
    340421         END DO 
     422!$OMP END PARALLEL 
    341423         CALL lbc_lnk( z2d, 'U', -1. ) 
    342424         CALL iom_put( "u_salttr", 0.5 * z2d )            ! heat transport in i-direction 
    … …  
    345427       
    346428      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
    347          z3d(:,:,jpk) = 0.e0 
     429!$OMP PARALLEL 
     430!$OMP DO schedule(static) private(jj, ji) 
     431         DO jj = 1, jpj 
     432            DO ji = 1, jpi 
     433               z3d(ji,jj,jpk) = 0.e0 
     434            END DO 
     435         END DO 
     436!$OMP DO schedule(static) private(jk,jj,ji) 
    348437         DO jk = 1, jpkm1 
    349             z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
    350          END DO 
     438            DO jj = 1, jpj 
     439               DO ji = 1, jpi 
     440                  z3d(ji,jj,jk) = rau0 * vn(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
     441               END DO 
     442            END DO 
     443         END DO 
     444!$OMP END PARALLEL 
    351445         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction 
    352446      ENDIF 
    353447       
    354448      IF( iom_use("v_heattr") ) THEN 
    355          z2d(:,:) = 0.e0  
     449!$OMP PARALLEL 
     450!$OMP DO schedule(static) private(jj, ji) 
     451         DO jj = 1, jpj 
     452            DO ji = 1, jpi 
     453               z2d(ji,jj) = 0.e0 
     454            END DO 
     455         END DO 
    356456         DO jk = 1, jpkm1 
     457!$OMP DO schedule(static) private(jj, ji) 
    357458            DO jj = 2, jpjm1 
    358459               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    361462            END DO 
    362463         END DO 
     464!$OMP END PARALLEL 
    363465         CALL lbc_lnk( z2d, 'V', -1. ) 
    364466         CALL iom_put( "v_heattr", (0.5 * rcp) * z2d )    !  heat transport in j-direction 
    … …  
    366468 
    367469      IF( iom_use("v_salttr") ) THEN 
    368          z2d(:,:) = 0.e0  
     470!$OMP PARALLEL 
     471!$OMP DO schedule(static) private(jj, ji) 
     472         DO jj = 1, jpj 
     473            DO ji = 1, jpi 
     474               z2d(ji,jj) = 0.e0 
     475            END DO 
     476         END DO 
    369477         DO jk = 1, jpkm1 
     478!$OMP DO schedule(static) private(jj, ji) 
    370479            DO jj = 2, jpjm1 
    371480               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    374483            END DO 
    375484         END DO 
     485!$OMP END PARALLEL 
    376486         CALL lbc_lnk( z2d, 'V', -1. ) 
    377487         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
    … …  
    380490      ! Vertical integral of temperature 
    381491      IF( iom_use("tosmint") ) THEN 
    382          z2d(:,:)=0._wp 
     492!$OMP PARALLEL 
     493!$OMP DO schedule(static) private(jj, ji) 
     494         DO jj = 1, jpj 
     495            DO ji = 1, jpi 
     496               z2d(ji,jj) = 0.e0 
     497            END DO 
     498         END DO 
    383499         DO jk = 1, jpkm1 
     500!$OMP DO schedule(static) private(jj, ji) 
    384501            DO jj = 2, jpjm1 
    385502               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    388505            END DO 
    389506         END DO 
     507