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

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

update trunk with OpenMP parallelization

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

Legend:

Unmodified
Added
Removed

  • 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!$OMP END PARALLEL 
    390508         CALL lbc_lnk( z2d, 'T', -1. ) 
    391509         CALL iom_put( "tosmint", z2d )  
    … …  
    394512      ! Vertical integral of salinity 
    395513      IF( iom_use("somint") ) THEN 
    396          z2d(:,:)=0._wp 
     514!$OMP PARALLEL 
     515!$OMP DO schedule(static) private(jj, ji) 
     516         DO jj = 1, jpj 
     517            DO ji = 1, jpi 
     518               z2d(ji,jj) = 0.e0 
     519            END DO 
     520         END DO 
    397521         DO jk = 1, jpkm1 
     522!$OMP DO schedule(static) private(jj, ji) 
    398523            DO jj = 2, jpjm1 
    399524               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    402527            END DO 
    403528         END DO 
     529!$OMP END PARALLEL 
    404530         CALL lbc_lnk( z2d, 'T', -1. ) 
    405531         CALL iom_put( "somint", z2d )  
    … …  
    792918      ENDIF 
    793919      IF( .NOT.ln_linssh ) THEN 
    794          zw3d(:,:,:) = ( ( e3t_n(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 
     920!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     921         DO jk = 1, jpk 
     922            DO jj = 1, jpj 
     923               DO ji = 1, jpi 
     924                  zw3d(ji,jj,jk) = ( ( e3t_n(ji,jj,jk) - e3t_0(ji,jj,jk) ) / e3t_0(ji,jj,jk) * 100 * tmask(ji,jj,jk) ) ** 2 
     925               END DO 
     926            END DO 
     927         END DO 
    795928         CALL histwrite( nid_T, "vovvle3t", it, e3t_n (:,:,:) , ndim_T , ndex_T  )   ! level thickness 
    796929         CALL histwrite( nid_T, "vovvldep", it, gdept_n(:,:,:) , ndim_T , ndex_T  )   ! t-point depth 
    … …  
    804937                                                                                  ! in linear free surface case) 
    805938      IF( ln_linssh ) THEN 
    806          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_tem) 
     939!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     940         DO jj = 1, jpj 
     941            DO ji = 1, jpi 
     942               zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_tem) 
     943            END DO 
     944         END DO 
    807945         CALL histwrite( nid_T, "sosst_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sst 
    808          zw2d(:,:) = emp (:,:) * tsn(:,:,1,jp_sal) 
     946!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     947         DO jj = 1, jpj 
     948            DO ji = 1, jpi 
     949               zw2d(ji,jj) = emp (ji,jj) * tsn(ji,jj,1,jp_sal) 
     950            END DO 
     951         END DO 
    809952         CALL histwrite( nid_T, "sosss_cd", it, zw2d, ndim_hT, ndex_hT )          ! c/d term on sss 
    810953      ENDIF 
    … …  
    842985         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    843986         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    844          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     987         IF( ln_ssr ) THEN 
     988!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     989            DO jj = 1, jpj 
     990               DO ji = 1, jpi 
     991                  zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 
     992               END DO 
     993            END DO 
     994         END IF 
    845995         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    846996      ENDIF 
    … …  
    848998         CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    849999         CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    850          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
     1000         IF( ln_ssr ) THEN 
     1001!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     1002            DO jj = 1, jpj 
     1003               DO ji = 1, jpi 
     1004                  zw2d(ji,jj) = erp(ji,jj) * tsn(ji,jj,1,jp_sal) * tmask(ji,jj,1) 
     1005               END DO 
     1006            END DO 
     1007         END IF 
    8511008         CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    8521009      ENDIF 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90

    r7646 r7698  
    150150      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pdept_3d, pdepw_3d   ! depth = SUM( e3 )     [m] 
    151151      ! 
    152       INTEGER  ::   jk           ! dummy loop indices 
     152      INTEGER  ::   jk, jj, ji           ! dummy loop indices 
    153153      !!----------------------------------------------------------------------       
    154154      ! 
    155       pdepw_3d(:,:,1) = 0.0_wp 
    156       pdept_3d(:,:,1) = 0.5_wp * pe3w_3d(:,:,1) 
     155!$OMP PARALLEL 
     156!$OMP DO schedule(static) private(jj,ji) 
     157      DO jj = 1, jpj 
     158         DO ji = 1, jpi 
     159            pdepw_3d(ji,jj,1) = 0.0_wp 
     160            pdept_3d(ji,jj,1) = 0.5_wp * pe3w_3d(ji,jj,1) 
     161         END DO 
     162      END DO 
    157163      DO jk = 2, jpk 
    158          pdepw_3d(:,:,jk) = pdepw_3d(:,:,jk-1) + pe3t_3d(:,:,jk-1)  
    159          pdept_3d(:,:,jk) = pdept_3d(:,:,jk-1) + pe3w_3d(:,:,jk  )  
     164!$OMP DO schedule(static) private(jj,ji) 
     165         DO jj = 1, jpj 
     166            DO ji = 1, jpi 
     167               pdepw_3d(ji,jj,jk) = pdepw_3d(ji,jj,jk-1) + pe3t_3d(ji,jj,jk-1)  
     168               pdept_3d(ji,jj,jk) = pdept_3d(ji,jj,jk-1) + pe3w_3d(ji,jj,jk  )  
     169            END DO 
     170         END DO 
    160171      END DO 
     172!$OMP END PARALLEL 
    161173      ! 
    162174   END SUBROUTINE e3_to_depth_3d 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r7646 r7698  
    133133      CALL dom_msk( ik_top, ik_bot )   ! Masks 
    134134      ! 
     135!$OMP PARALLEL 
     136!$OMP DO schedule(static) private(jj,ji,ik) 
    135137      DO jj = 1, jpj                   ! depth of the iceshelves 
    136138         DO ji = 1, jpi 
    … …  
    140142      END DO 
    141143      ! 
    142       ht_0(:,:) = 0._wp  ! Reference ocean thickness 
    143       hu_0(:,:) = 0._wp 
    144       hv_0(:,:) = 0._wp 
     144!$OMP END DO NOWAIT 
     145!$OMP DO schedule(static) private(jj,ji) 
     146      DO jj = 1, jpj 
     147         DO ji = 1, jpi 
     148            ht_0(ji,jj) = 0._wp  ! Reference ocean thickness 
     149            hu_0(ji,jj) = 0._wp 
     150            hv_0(ji,jj) = 0._wp 
     151         END DO 
     152      END DO 
    145153      DO jk = 1, jpk 
    146          ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    147          hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 
    148          hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 
     154!$OMP DO schedule(static) private(jj,ji,ik) 
     155         DO jj = 1, jpj 
     156            DO ji = 1, jpi 
     157               ht_0(ji,jj) = ht_0(ji,jj) + e3t_0(ji,jj,jk) * tmask(ji,jj,jk) 
     158               hu_0(ji,jj) = hu_0(ji,jj) + e3u_0(ji,jj,jk) * umask(ji,jj,jk) 
     159               hv_0(ji,jj) = hv_0(ji,jj) + e3v_0(ji,jj,jk) * vmask(ji,jj,jk) 
     160            END DO 
     161         END DO 
    149162      END DO 
     163!$OMP END PARALLEL 
    150164      ! 
    151165      !           !==  time varying part of coordinate system  ==! 
    … …  
    166180             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          ! 
    167181         ! 
    168          z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF 
    169          z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 
     182!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     183         DO jj =1, jpj 
     184            DO ji=1, jpi 
     185               z1_hu_0(ji,jj) = ssumask(ji,jj) / ( hu_0(ji,jj) + 1._wp - ssumask(ji,jj) )     ! _i mask due to ISF 
     186               z1_hv_0(ji,jj) = ssvmask(ji,jj) / ( hv_0(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     187            END DO 
     188         END DO 
    170189         ! 
    171190         !        before       !          now          !       after         ! 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

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

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r7646 r7698  
    4747   !!---------------------------------------------------------------------- 
    4848   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    49    !! $Id$  
     49   !! $Id$ 
    5050   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5151   !!---------------------------------------------------------------------- 
    … …  
    137137      ! ---------------------------- 
    138138      ! 
    139       tmask(:,:,:) = 0._wp 
     139!$OMP PARALLEL 
     140!$OMP DO schedule(static) private(jk, jj, ji) 
     141      DO jk = 1, jpk 
     142         DO jj = 1, jpj 
     143            DO ji = 1, jpi 
     144               tmask(ji,jj,jk) = 0._wp 
     145            END DO 
     146         END DO 
     147      END DO 
     148!$OMP DO schedule(static) private(jj, ji, iktop, ikbot) 
    140149      DO jj = 1, jpj 
    141150         DO ji = 1, jpi 
    … …  
    147156         END DO   
    148157      END DO   
     158!$OMP END PARALLEL 
    149159!SF  add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 
    150160!!gm I don't understand why...   
    … …  
    161171      ! ------------------------ 
    162172      IF ( ln_bdy .AND. ln_mask_file ) THEN 
     173!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    163174         DO jk = 1, jpkm1 
    164175            DO jj = 1, jpj 
    … …  
    173184      ! ---------------------------------------- 
    174185      ! NB: at this point, fmask is designed for free slip lateral boundary condition 
     186!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    175187      DO jk = 1, jpk 
    176188         DO jj = 1, jpjm1 
    … …  
    192204      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 
    193205      !----------------------------------------- 
    194       wmask (:,:,1) = tmask(:,:,1)     ! surface 
    195       wumask(:,:,1) = umask(:,:,1) 
    196       wvmask(:,:,1) = vmask(:,:,1) 
     206!$OMP PARALLEL 
     207!$OMP DO schedule(static) private(jj, ji) 
     208      DO jj = 1, jpj 
     209         DO ji = 1, jpi 
     210            wmask (ji,jj,1) = tmask(ji,jj,1)     ! surface 
     211            wumask(ji,jj,1) = umask(ji,jj,1) 
     212            wvmask(ji,jj,1) = vmask(ji,jj,1) 
     213         END DO 
     214      END DO 
     215!$OMP DO schedule(static) private(jk,jj,ji) 
    197216      DO jk = 2, jpk                   ! interior values 
    198          wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
    199          wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
    200          wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
    201       END DO 
     217         DO jj = 1, jpj 
     218            DO ji = 1, jpi 
     219               wmask (ji,jj,jk) = tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 
     220               wumask(ji,jj,jk) = umask(ji,jj,jk) * umask(ji,jj,jk-1)    
     221               wvmask(ji,jj,jk) = vmask(ji,jj,jk) * vmask(ji,jj,jk-1) 
     222            END DO 
     223         END DO 
     224      END DO 
     225!$OMP END PARALLEL 
    202226 
    203227 
    … …  
    216240      ! 
    217241      !                          ! halo mask : 0 on the halo and 1 elsewhere 
    218       tmask_h(:,:) = 1._wp                   
     242!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     243      DO jj = 1, jpj 
     244         DO ji = 1, jpi 
     245            tmask_h(ji,jj) = 1._wp                   
     246         END DO 
     247      END DO 
    219248      tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
    220249      tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
    … …  
    241270      ! 
    242271      !                          ! interior mask : 2D ocean mask x halo mask  
    243       tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
     272!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     273      DO jj = 1, jpj 
     274         DO ji = 1, jpi 
     275            tmask_i(ji,jj) = ssmask(ji,jj) * tmask_h(ji,jj) 
     276         END DO 
     277      END DO 
    244278 
    245279 
    … …  
    250284         CALL wrk_alloc( jpi,jpj,   zwf ) 
    251285         ! 
     286!$OMP PARALLEL 
    252287         DO jk = 1, jpk 
    253             zwf(:,:) = fmask(:,:,jk)          
     288!$OMP DO schedule(static) private(jj, ji) 
     289            DO jj = 1, jpj 
     290               DO ji = 1, jpi 
     291                  zwf(ji,jj) = fmask(ji,jj,jk)          
     292               END DO 
     293            END DO 
     294!$OMP DO schedule(static) private(jj, ji) 
    254295            DO jj = 2, jpjm1 
    255296               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    260301               END DO 
    261302            END DO 
     303!$OMP DO schedule(static) private(jj) 
    262304            DO jj = 2, jpjm1 
    263305               IF( fmask(1,jj,jk) == 0._wp ) THEN 
    … …  
    268310               ENDIF 
    269311            END DO          
     312!$OMP DO schedule(static) private(ji) 
    270313            DO ji = 2, jpim1 
    271314               IF( fmask(ji,1,jk) == 0._wp ) THEN 
    … …  
    277320            END DO 
    278321         END DO 
     322!$OMP END PARALLEL 
    279323         ! 
    280324         CALL wrk_dealloc( jpi,jpj,   zwf ) 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r7646 r7698  
    135135      !                    ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 
    136136      CALL dom_vvl_rst( nit000, 'READ' ) 
    137       e3t_a(:,:,jpk) = e3t_0(:,:,jpk)  ! last level always inside the sea floor set one for all 
     137!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     138      DO jj = 1, jpj 
     139         DO ji = 1, jpi 
     140            e3t_a(ji,jj,jpk) = e3t_0(ji,jj,jpk)  ! last level always inside the sea floor set one for all 
     141         END DO 
     142      END DO 
    138143      ! 
    139144      !                    !== Set of all other vertical scale factors  ==!  (now and before) 
    … …  
    153158      ! 
    154159      !                    !==  depth of t and w-point  ==!   (set the isf depth as it is in the initial timestep) 
    155       gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1)       ! reference to the ocean surface (used for MLD and light penetration) 
    156       gdepw_n(:,:,1) = 0.0_wp 
    157       gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:)  ! reference to a common level z=0 for hpg 
    158       gdept_b(:,:,1) = 0.5_wp * e3w_b(:,:,1) 
    159       gdepw_b(:,:,1) = 0.0_wp 
     160!$OMP PARALLEL 
     161!$OMP DO schedule(static) private(jj,ji) 
     162      DO jj = 1, jpj 
     163         DO ji = 1, jpi 
     164            gdept_n(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1)       ! reference to the ocean surface (used for MLD and light penetration) 
     165            gdepw_n(ji,jj,1) = 0.0_wp 
     166            gde3w_n(ji,jj,1) = gdept_n(ji,jj,1) - sshn(ji,jj)  ! reference to a common level z=0 for hpg 
     167            gdept_b(ji,jj,1) = 0.5_wp * e3w_b(ji,jj,1) 
     168            gdepw_b(ji,jj,1) = 0.0_wp 
     169         END DO 
     170      END DO 
    160171      DO jk = 2, jpk                               ! vertical sum 
     172!$OMP DO schedule(static) private(jj,ji,zcoef) 
    161173         DO jj = 1,jpj 
    162174            DO ji = 1,jpi 
    … …  
    178190      ! 
    179191      !                    !==  thickness of the water column  !!   (ocean portion only) 
    180       ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
    181       hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 
    182       hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1) 
    183       hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 
    184       hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 
     192!$OMP DO schedule(static) private(jj,ji) 
     193      DO jj = 1, jpj 
     194         DO ji = 1, jpi 
     195            ht_n(ji,jj) = e3t_n(ji,jj,1) * tmask(ji,jj,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
     196            hu_b(ji,jj) = e3u_b(ji,jj,1) * umask(ji,jj,1) 
     197            hu_n(ji,jj) = e3u_n(ji,jj,1) * umask(ji,jj,1) 
     198            hv_b(ji,jj) = e3v_b(ji,jj,1) * vmask(ji,jj,1) 
     199            hv_n(ji,jj) = e3v_n(ji,jj,1) * vmask(ji,jj,1) 
     200         END DO 
     201      END DO 
    185202      DO jk = 2, jpkm1 
    186          ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
    187          hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
    188          hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 
    189          hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
    190          hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 
     203!$OMP DO schedule(static) private(jj,ji) 
     204         DO jj = 1, jpj 
     205            DO ji = 1, jpi 
     206               ht_n(ji,jj) = ht_n(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     207               hu_b(ji,jj) = hu_b(ji,jj) + e3u_b(ji,jj,jk) * umask(ji,jj,jk) 
     208               hu_n(ji,jj) = hu_n(ji,jj) + e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
     209               hv_b(ji,jj) = hv_b(ji,jj) + e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 
     210               hv_n(ji,jj) = hv_n(ji,jj) + e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
     211            END DO 
     212         END DO 
    191213      END DO 
    192214      ! 
    193215      !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
    194       r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
    195       r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) 
    196       r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
    197       r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) 
    198  
     216!$OMP DO schedule(static) private(jj,ji) 
     217      DO jj = 1, jpj 
     218         DO ji = 1, jpi 
     219            r1_hu_b(ji,jj) = ssumask(ji,jj) / ( hu_b(ji,jj) + 1._wp - ssumask(ji,jj) )    ! _i mask due to ISF 
     220            r1_hu_n(ji,jj) = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     221            r1_hv_b(ji,jj) = ssvmask(ji,jj) / ( hv_b(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     222            r1_hv_n(ji,jj) = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     223         END DO 
     224      END DO 
     225!$OMP END PARALLEL 
    199226      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies) 
    200227      IF( ln_vvl_ztilde ) THEN 
    … …  
    202229         !                                   ! Values in days provided via the namelist 
    203230         !                                   ! use rsmall to avoid possible division by zero errors with faulty settings 
    204          frq_rst_e3t(:,:) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp ) 
    205          frq_rst_hdv(:,:) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 
     231!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     232         DO jj = 1, jpj 
     233            DO ji = 1, jpi 
     234               frq_rst_e3t(ji,jj) = 2._wp * rpi / ( MAX( rn_rst_e3t  , rsmall ) * 86400.0_wp ) 
     235               frq_rst_hdv(ji,jj) = 2._wp * rpi / ( MAX( rn_lf_cutoff, rsmall ) * 86400.0_wp ) 
     236            END DO 
     237         END DO 
    206238         ! 
    207239         IF( ln_vvl_ztilde_as_zstar ) THEN   ! z-star emulation using z-tile 
    208             frq_rst_e3t(:,:) = 0._wp               !Ignore namelist settings 
    209             frq_rst_hdv(:,:) = 1._wp / rdt 
     240!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     241            DO jj = 1, jpj 
     242               DO ji = 1, jpi 
     243                  frq_rst_e3t(ji,jj) = 0._wp               !Ignore namelist settings 
     244                  frq_rst_hdv(ji,jj) = 1._wp / rdt 
     245               END DO 
     246            END DO 
    210247         ENDIF 
    211248         IF ( ln_vvl_zstar_at_eqtor ) THEN   ! use z-star in vicinity of the Equator 
     249!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    212250            DO jj = 1, jpj 
    213251               DO ji = 1, jpi 
    … …  
    305343      !                                                ! --------------------------------------------- ! 
    306344      ! 
    307       z_scale(:,:) = ( ssha(:,:) - sshb(:,:) ) * ssmask(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
     345!$OMP PARALLEL 
     346!$OMP DO schedule(static) private(jj,ji) 
     347      DO jj = 1, jpj 
     348         DO ji = 1, jpi 
     349            z_scale(ji,jj) = ( ssha(ji,jj) - sshb(ji,jj) ) * ssmask(ji,jj) / ( ht_0(ji,jj) + sshn(ji,jj) + 1. - ssmask(ji,jj) ) 
     350         END DO 
     351      END DO 
     352!$OMP DO schedule(static) private(jk,jj,ji) 
    308353      DO jk = 1, jpkm1 
    309          ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0) 
    310          e3t_a(:,:,jk) = e3t_b(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
    311       END DO 
     354         DO jj = 1, jpj 
     355            DO ji = 1, jpi 
     356               ! formally this is the same as e3t_a = e3t_0*(1+ssha/ht_0) 
     357               e3t_a(ji,jj,jk) = e3t_b(ji,jj,jk) + e3t_n(ji,jj,jk) * z_scale(ji,jj) * tmask(ji,jj,jk) 
     358            END DO 
     359         END DO 
     360      END DO 
     361!$OMP END PARALLEL 
    312362      ! 
    313363      IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN   ! z_tilde or layer coordinate ! 
    … …  
    318368         ! 1 - barotropic divergence 
    319369         ! ------------------------- 
    320          zhdiv(:,:) = 0._wp 
    321          zht(:,:)   = 0._wp 
     370!$OMP PARALLEL 
     371!$OMP DO schedule(static) private(jj,ji) 
     372         DO jj = 1, jpj 
     373            DO ji = 1, jpi 
     374               zhdiv(ji,jj) = 0._wp 
     375               zht(ji,jj)   = 0._wp 
     376            END DO 
     377         END DO 
    322378         DO jk = 1, jpkm1 
    323             zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
    324             zht  (:,:) = zht  (:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
    325          END DO 
    326          zhdiv(:,:) = zhdiv(:,:) / ( zht(:,:) + 1. - tmask_i(:,:) ) 
     379!$OMP DO schedule(static) private(jj,ji) 
     380            DO jj = 1, jpj 
     381               DO ji = 1, jpi 
     382                  zhdiv(ji,jj) = zhdiv(ji,jj) + e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) 
     383                  zht  (ji,jj) = zht  (ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     384               END DO 
     385            END DO 
     386         END DO 
     387!$OMP DO schedule(static) private(jj,ji) 
     388         DO jj = 1, jpj 
     389            DO ji = 1, jpi 
     390               zhdiv(ji,jj) = zhdiv(ji,jj) / ( zht(ji,jj) + 1. - tmask_i(ji,jj) ) 
     391            END DO 
     392         END DO 
     393!$OMP END PARALLEL 
    327394 
    328395         ! 2 - Low frequency baroclinic horizontal divergence  (z-tilde case only) 
    … …  
    330397         IF( ln_vvl_ztilde ) THEN 
    331398            IF( kt > nit000 ) THEN 
     399!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    332400               DO jk = 1, jpkm1 
    333                   hdiv_lf(:,:,jk) = hdiv_lf(:,:,jk) - rdt * frq_rst_hdv(:,:)   & 
    334                      &          * ( hdiv_lf(:,:,jk) - e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) ) 
     401                  DO jj = 1, jpj 
     402                     DO ji = 1, jpi 
     403                        hdiv_lf(ji,jj,jk) = hdiv_lf(ji,jj,jk) - rdt * frq_rst_hdv(ji,jj)   & 
     404                           &          * ( hdiv_lf(ji,jj,jk) - e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) ) 
     405                     END DO 
     406                  END DO 
    335407               END DO 
    336408            ENDIF 
    … …  
    339411         ! II - after z_tilde increments of vertical scale factors 
    340412         ! ======================================================= 
    341          tilde_e3t_a(:,:,:) = 0._wp  ! tilde_e3t_a used to store tendency terms 
     413!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     414         DO jk = 1, jpk 
     415            DO jj = 1, jpj 
     416               DO ji = 1, jpi 
     417                  tilde_e3t_a(ji,jj,jk) = 0._wp  ! tilde_e3t_a used to store tendency terms 
     418               END DO 
     419            END DO 
     420         END DO 
    342421 
    343422         ! 1 - High frequency divergence term 
    344423         ! ---------------------------------- 
    345424         IF( ln_vvl_ztilde ) THEN     ! z_tilde case 
     425!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    346426            DO jk = 1, jpkm1 
    347                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - ( e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) - hdiv_lf(:,:,jk) ) 
     427               DO jj = 1, jpj 
     428                  DO ji = 1, jpi 
     429                     tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - ( e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) - hdiv_lf(ji,jj,jk) ) 
     430                  END DO 
     431               END DO 
    348432            END DO 
    349433         ELSE                         ! layer case 
     434!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    350435            DO jk = 1, jpkm1 
    351                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) -   e3t_n(:,:,jk) * ( hdivn(:,:,jk) - zhdiv(:,:) ) * tmask(:,:,jk) 
     436               DO jj = 1, jpj 
     437                  DO ji = 1, jpi 
     438                     tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) -   e3t_n(ji,jj,jk) * ( hdivn(ji,jj,jk) - zhdiv(ji,jj) ) * tmask(ji,jj,jk) 
     439                  END DO 
     440               END DO 
    352441            END DO 
    353442         ENDIF 
    … …  
    356445         ! ------------------ 
    357446         IF( ln_vvl_ztilde ) THEN 
     447!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    358448            DO jk = 1, jpk 
    359                tilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - frq_rst_e3t(:,:) * tilde_e3t_b(:,:,jk) 
     449               DO jj = 1, jpj 
     450                  DO ji = 1, jpi 
     451                     tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - frq_rst_e3t(ji,jj) * tilde_e3t_b(ji,jj,jk) 
     452                  END DO 
     453               END DO 
    360454            END DO 
    361455         ENDIF 
    … …  
    363457         ! 3 - Thickness diffusion term 
    364458         ! ---------------------------- 
    365          zwu(:,:) = 0._wp 
    366          zwv(:,:) = 0._wp 
     459!$OMP PARALLEL 
     460!$OMP DO schedule(static) private(jj,ji) 
     461         DO jj = 1, jpj 
     462            DO ji = 1, jpi 
     463               zwu(ji,jj) = 0._wp 
     464               zwv(ji,jj) = 0._wp 
     465            END DO 
     466         END DO 
    367467         DO jk = 1, jpkm1        ! a - first derivative: diffusive fluxes 
     468!$OMP DO schedule(static) private(jj,ji) 
    368469            DO jj = 1, jpjm1 
    369470               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    377478            END DO 
    378479         END DO 
     480!$OMP DO schedule(static) private(jj,ji) 
    379481         DO jj = 1, jpj          ! b - correction for last oceanic u-v points 
    380482            DO ji = 1, jpi 
    … …  
    383485            END DO 
    384486         END DO 
     487!$OMP DO schedule(static) private(jk,jj,ji) 
    385488         DO jk = 1, jpkm1        ! c - second derivative: divergence of diffusive fluxes 
    386489            DO jj = 2, jpjm1 
    … …  
    392495            END DO 
    393496         END DO 
     497!$OMP END PARALLEL 
    394498         !                       ! d - thickness diffusion transport: boundary conditions 
    395499         !                             (stored for tracer advction and continuity equation) 
    … …  
    407511         ENDIF 
    408512         CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp ) 
    409          tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 
     513!$OMP PARALLEL  
     514!$OMP DO schedule(static) private(jk,jj,ji) 
     515         DO jk = 1, jpk 
     516            DO jj = 1, jpj 
     517               DO ji = 1, jpi 
     518                  tilde_e3t_a(ji,jj,jk) = tilde_e3t_b(ji,jj,jk) + z2dt * tmask(ji,jj,jk) * tilde_e3t_a(ji,jj,jk) 
     519               END DO 
     520            END DO 
     521         END DO 
    410522 
    411523         ! Maximum deformation control 
    412524         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
    413          ze3t(:,:,jpk) = 0._wp 
     525!$OMP DO schedule(static) private(jj,ji) 
     526         DO jj = 1, jpj 
     527            DO ji = 1, jpi 
     528               ze3t(ji,jj,jpk) = 0._wp 
     529            END DO 
     530         END DO 
     531!$OMP DO schedule(static) private(jk,jj,ji) 
    414532         DO jk = 1, jpkm1 
    415             ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    416          END DO 
     533            DO jj = 1, jpj 
     534               DO ji = 1, jpi 
     535                  ze3t(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) / e3t_0(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
     536               END DO 
     537            END DO 
     538         END DO 
     539!$OMP END PARALLEL 
    417540         z_tmax = MAXVAL( ze3t(:,:,:) ) 
    418541         IF( lk_mpp )   CALL mpp_max( z_tmax )                 ! max over the global domain 
    … …  
    442565         ! - ML - end test 
    443566         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
    444          tilde_e3t_a(:,:,:) = MIN( tilde_e3t_a(:,:,:),   rn_zdef_max * e3t_0(:,:,:) ) 
    445          tilde_e3t_a(:,:,:) = MAX( tilde_e3t_a(:,:,:), - rn_zdef_max * e3t_0(:,:,:) ) 
     567!$OMP PARALLEL 
     568!$OMP DO schedule(static) private(jk,jj,ji) 
     569         DO jk = 1, jpk 
     570            DO jj = 1, jpj 
     571               DO ji = 1, jpi 
     572                  tilde_e3t_a(ji,jj,jk) = MIN( tilde_e3t_a(ji,jj,jk),   rn_zdef_max * e3t_0(ji,jj,jk) ) 
     573                  tilde_e3t_a(ji,jj,jk) = MAX( tilde_e3t_a(ji,jj,jk), - rn_zdef_max * e3t_0(ji,jj,jk) ) 
     574               END DO 
     575            END DO 
     576         END DO 
    446577 
    447578         ! 
    448579         ! "tilda" change in the after scale factor 
    449580         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     581!$OMP DO schedule(static) private(jk,jj,ji) 
    450582         DO jk = 1, jpkm1 
    451             dtilde_e3t_a(:,:,jk) = tilde_e3t_a(:,:,jk) - tilde_e3t_b(:,:,jk) 
     583            DO jj = 1, jpj 
     584               DO ji = 1, jpi 
     585                  dtilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) - tilde_e3t_b(ji,jj,jk) 
     586               END DO 
     587            END DO 
    452588         END DO 
    453589         ! III - Barotropic repartition of the sea surface height over the baroclinic profile 
    … …  
    457593         !        i.e. locally and not spread over the water column. 
    458594         !        (keep in mind that the idea is to reduce Eulerian velocity as much as possible) 
    459          zht(:,:) = 0. 
     595!$OMP DO schedule(static) private(jj,ji) 
     596         DO jj = 1, jpj 
     597            DO ji = 1, jpi 
     598               zht(ji,jj) = 0. 
     599            END DO 
     600         END DO 
    460601         DO jk = 1, jpkm1 
    461             zht(:,:)  = zht(:,:) + tilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
    462          END DO 
    463          z_scale(:,:) =  - zht(:,:) / ( ht_0(:,:) + sshn(:,:) + 1. - ssmask(:,:) ) 
     602!$OMP DO schedule(static) private(jj,ji) 
     603            DO jj = 1, jpj 
     604               DO ji = 1, jpi 
     605                  zht(ji,jj)  = zht(ji,jj) + tilde_e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
     606               END DO 
     607            END DO 
     608         END DO 
     609!$OMP DO schedule(static) private(jj,ji) 
     610         DO jj = 1, jpj 
     611            DO ji = 1, jpi 
     612               z_scale(ji,jj) =  - zht(ji,jj) / ( ht_0(ji,jj) + sshn(ji,jj) + 1. - ssmask(ji,jj) ) 
     613            END DO 
     614         END DO 
     615!$OMP DO schedule(static) private(jk,jj,ji) 
    464616         DO jk = 1, jpkm1 
    465             dtilde_e3t_a(:,:,jk) = dtilde_e3t_a(:,:,jk) + e3t_n(:,:,jk) * z_scale(:,:) * tmask(:,:,jk) 
    466          END DO 
    467  
     617            DO jj = 1, jpj 
     618               DO ji = 1, jpi 
     619                  dtilde_e3t_a(ji,jj,jk) = dtilde_e3t_a(ji,jj,jk) + e3t_n(ji,jj,jk) * z_scale(ji,jj) * tmask(ji,jj,jk) 
     620               END DO 
     621            END DO 
     622         END DO 
     623!$OMP END PARALLEL 
    468624      ENDIF 
    469625 
    470626      IF( ln_vvl_ztilde .OR. ln_vvl_layer )  THEN   ! z_tilde or layer coordinate ! 
    471627      !                                           ! ---baroclinic part--------- ! 
     628!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    472629         DO jk = 1, jpkm1 
    473             e3t_a(:,:,jk) = e3t_a(:,:,jk) + dtilde_e3t_a(:,:,jk) * tmask(:,:,jk) 
     630            DO jj = 1, jpj 
     631               DO ji = 1, jpi 
     632                  e3t_a(ji,jj,jk) = e3t_a(ji,jj,jk) + dtilde_e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
     633               END DO 
     634            END DO 
    474635         END DO 
    475636      ENDIF 
    … …  
    484645         END IF 
    485646         ! 
    486          zht(:,:) = 0.0_wp 
     647!$OMP PARALLEL 
     648!$OMP DO schedule(static) private(jj,ji) 
     649         DO jj = 1, jpj 
     650            DO ji = 1, jpi 
     651               zht(ji,jj) = 0.0_wp 
     652            END DO 
     653         END DO 
    487654         DO jk = 1, jpkm1 
    488             zht(:,:) = zht(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
    489          END DO 
     655!$OMP DO schedule(static) private(jj,ji) 
     656            DO jj = 1, jpj 
     657               DO ji = 1, jpi 
     658                  zht(ji,jj) = zht(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     659               END DO 
     660            END DO 
     661         END DO 
     662!$OMP END PARALLEL 
    490663         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 
    491664         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
    492665         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 
    493666         ! 
    494          zht(:,:) = 0.0_wp 
     667!$OMP PARALLEL 
     668!$OMP DO schedule(static) private(jj,ji) 
     669         DO jj = 1, jpj 
     670            DO ji = 1, jpi 
     671               zht(ji,jj) = 0.0_wp 
     672            END DO 
     673         END DO 
    495674         DO jk = 1, jpkm1 
    496             zht(:,:) = zht(:,:) + e3t_a(:,:,jk) * tmask(:,:,jk) 
    497          END DO 
     675!$OMP DO schedule(static) private(jj,ji) 
     676            DO jj = 1, jpj 
     677               DO ji = 1, jpi 
     678                  zht(ji,jj) = zht(ji,jj) + e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
     679               END DO 
     680            END DO 
     681         END DO 
     682!$OMP END PARALLEL 
    498683         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 
    499684         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
    500685         IF( lwp    ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 
    501686         ! 
    502          zht(:,:) = 0.0_wp 
     687!$OMP PARALLEL 
     688!$OMP DO schedule(static) private(jj,ji) 
     689         DO jj = 1, jpj 
     690            DO ji = 1, jpi 
     691               zht(ji,jj) = 0.0_wp 
     692            END DO 
     693         END DO 
    503694         DO jk = 1, jpkm1 
    504             zht(:,:) = zht(:,:) + e3t_b(:,:,jk) * tmask(:,:,jk) 
    505          END DO 
     695!$OMP DO schedule(static) private(jj,ji) 
     696            DO jj = 1, jpj 
     697               DO ji = 1, jpi 
     698                  zht(ji,jj) = zht(ji,jj) + e3t_b(ji,jj,jk) * tmask(ji,jj,jk) 
     699               END DO 
     700            END DO 
     701         END DO 
     702!$OMP END PARALLEL 
    506703         z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 
    507704         IF( lk_mpp ) CALL mpp_max( z_tmax )                                ! max over the global domain 
    … …  
    532729      ! *********************************** ! 
    533730 
    534       hu_a(:,:) = e3u_a(:,:,1) * umask(:,:,1) 
    535       hv_a(:,:) = e3v_a(:,:,1) * vmask(:,:,1) 
     731!$OMP PARALLEL 
     732!$OMP DO schedule(static) private(jj,ji) 
     733      DO jj = 1, jpj 
     734         DO ji = 1, jpi 
     735            hu_a(ji,jj) = e3u_a(ji,jj,1) * umask(ji,jj,1) 
     736            hv_a(ji,jj) = e3v_a(ji,jj,1) * vmask(ji,jj,1) 
     737         END DO 
     738      END DO 
    536739      DO jk = 2, jpkm1 
    537          hu_a(:,:) = hu_a(:,:) + e3u_a(:,:,jk) * umask(:,:,jk) 
    538          hv_a(:,:) = hv_a(:,:) + e3v_a(:,:,jk) * vmask(:,:,jk) 
     740!$OMP DO schedule(static) private(jj,ji) 
     741         DO jj = 1, jpj 
     742            DO ji = 1, jpi 
     743               hu_a(ji,jj) = hu_a(ji,jj) + e3u_a(ji,jj,jk) * umask(ji,jj,jk) 
     744               hv_a(ji,jj) = hv_a(ji,jj) + e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 
     745            END DO 
     746         END DO 
    539747      END DO 
    540748      !                                        ! Inverse of the local depth 
    541749!!gm BUG ?  don't understand the use of umask_i here ..... 
    542       r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) ) 
    543       r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 
     750!$OMP DO schedule(static) private(jj,ji) 
     751      DO jj = 1, jpj 
     752         DO ji = 1, jpi 
     753            r1_hu_a(ji,jj) = ssumask(ji,jj) / ( hu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     754            r1_hv_a(ji,jj) = ssvmask(ji,jj) / ( hv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     755         END DO 
     756      END DO 
     757!$OMP END PARALLEL 
    544758      ! 
    545759      CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv ) 
    … …  
    596810      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 
    597811         IF( neuler == 0 .AND. kt == nit000 ) THEN 
    598             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 
     812!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     813            DO jk = 1, jpk 
     814               DO jj = 1, jpj 
     815                  DO ji = 1, jpi 
     816                     tilde_e3t_b(ji,jj,jk) = tilde_e3t_n(ji,jj,jk) 
     817                  END DO 
     818               END DO 
     819            END DO 
    599820         ELSE 
    600             tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) &  
    601             &         + atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 
     821!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     822            DO jk = 1, jpk 
     823               DO jj = 1, jpj 
     824                  DO ji = 1, jpi 
     825                     tilde_e3t_b(ji,jj,jk) = tilde_e3t_n(ji,jj,jk) &  
     826                     &         + atfp * ( tilde_e3t_b(ji,jj,jk) - 2.0_wp * tilde_e3t_n(ji,jj,jk) + tilde_e3t_a(ji,jj,jk) ) 
     827                  END DO 
     828               END DO 
     829            END DO 
    602830         ENDIF 
    603          tilde_e3t_n(:,:,:) = tilde_e3t_a(:,:,:) 
     831!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     832         DO jk = 1, jpk 
     833            DO jj = 1, jpj 
     834               DO ji = 1, jpi 
     835                  tilde_e3t_n(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) 
     836               END DO 
     837            END DO 
     838         END DO 
    604839      ENDIF 
    605       gdept_b(:,:,:) = gdept_n(:,:,:) 
    606       gdepw_b(:,:,:) = gdepw_n(:,:,:) 
    607  
    608       e3t_n(:,:,:) = e3t_a(:,:,:) 
    609       e3u_n(:,:,:) = e3u_a(:,:,:) 
    610       e3v_n(:,:,:) = e3v_a(:,:,:) 
     840!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     841      DO jk = 1, jpk 
     842         DO jj = 1, jpj 
     843            DO ji = 1, jpi 
     844               gdept_b(ji,jj,jk) = gdept_n(ji,jj,jk) 
     845               gdepw_b(ji,jj,jk) = gdepw_n(ji,jj,jk) 
     846         
     847               e3t_n(ji,jj,jk) = e3t_a(ji,jj,jk) 
     848               e3u_n(ji,jj,jk) = e3u_a(ji,jj,jk) 
     849               e3v_n(ji,jj,jk) = e3v_a(ji,jj,jk) 
     850            END DO 
     851         END DO 
     852      END DO 
    611853 
    612854      ! Compute all missing vertical scale factor and depths 
    … …  
    628870 
    629871      ! t- and w- points depth (set the isf depth as it is in the initial step) 
    630       gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
    631       gdepw_n(:,:,1) = 0.0_wp 
    632       gde3w_n(:,:,1) = gdept_n(:,:,1) - sshn(:,:) 
     872! !$OMP PARALLEL 
     873! !$OMP DO schedule(static) private(jj,ji) 
     874      DO jj = 1, jpj 
     875         DO ji = 1, jpi 
     876            gdept_n(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) 
     877            gdepw_n(ji,jj,1) = 0.0_wp 
     878            gde3w_n(ji,jj,1) = gdept_n(ji,jj,1) - sshn(ji,jj) 
     879         END DO 
     880      END DO 
    633881      DO jk = 2, jpk 
     882! !$OMP DO schedule(static) private(jj,ji,zcoef) 
    634883         DO jj = 1,jpj 
    635884            DO ji = 1,jpi 
    … …  
    647896      ! Local depth and Inverse of the local depth of the water 
    648897      ! ------------------------------------------------------- 
    649       hu_n(:,:) = hu_a(:,:)   ;   r1_hu_n(:,:) = r1_hu_a(:,:) 
    650       hv_n(:,:) = hv_a(:,:)   ;   r1_hv_n(:,:) = r1_hv_a(:,:) 
    651       ! 
    652       ht_n(:,:) = e3t_n(:,:,1) * tmask(:,:,1) 
     898!$OMP PARALLEL 
     899!$OMP DO schedule(static) private(jj,ji) 
     900      DO jj = 1, jpj 
     901         DO ji = 1, jpi 
     902            hu_n(ji,jj) = hu_a(ji,jj)   ;   r1_hu_n(ji,jj) = r1_hu_a(ji,jj) 
     903            hv_n(ji,jj) = hv_a(ji,jj)   ;   r1_hv_n(ji,jj) = r1_hv_a(ji,jj) 
     904            ! 
     905            ht_n(ji,jj) = e3t_n(ji,jj,1) * tmask(ji,jj,1) 
     906         END DO 
     907      END DO 
    653908      DO jk = 2, jpkm1 
    654          ht_n(:,:) = ht_n(:,:) + e3t_n(:,:,jk) * tmask(:,:,jk) 
    655       END DO 
    656  
     909!$OMP DO schedule(static) private(jj,ji) 
     910         DO jj = 1, jpj 
     911            DO ji = 1, jpi 
     912               ht_n(ji,jj) = ht_n(ji,jj) + e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     913            END DO 
     914         END DO 
     915      END DO 
     916!$OMP END PARALLEL 
    657917      ! write restart file 
    658918      ! ================== 
    … …  
    694954         ! 
    695955      CASE( 'U' )                   !* from T- to U-point : hor. surface weighted mean 
     956!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    696957         DO jk = 1, jpk 
    697958            DO jj = 1, jpjm1 
    … …  
    704965         END DO 
    705966         CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) 
    706          pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
     967!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     968         DO jk = 1, jpk 
     969            DO jj = 1, jpj 
     970               DO ji = 1, jpi 
     971                  pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3u_0(ji,jj,jk) 
     972               END DO 
     973            END DO 
     974         END DO 
    707975         ! 
    708976      CASE( 'V' )                   !* from T- to V-point : hor. surface weighted mean 
     977!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    709978         DO jk = 1, jpk 
    710979            DO jj = 1, jpjm1 
    … …  
    717986         END DO 
    718987         CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) 
    719          pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
     988!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     989         DO jk = 1, jpk 
     990            DO jj = 1, jpj 
     991               DO ji = 1, jpi 
     992                  pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3v_0(ji,jj,jk) 
     993               END DO 
     994            END DO 
     995         END DO 
    720996         ! 
    721997      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
     998!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    722999         DO jk = 1, jpk 
    7231000            DO jj = 1, jpjm1 
    … …  
    7311008         END DO 
    7321009         CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) 
    733          pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
     1010!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     1011         DO jk = 1, jpk 
     1012            DO jj = 1, jpj 
     1013               DO ji = 1, jpi 
     1014                  pe3_out(ji,jj,jk) = pe3_out(ji,jj,jk) + e3f_0(ji,jj,jk) 
     1015               END DO 
     1016            END DO 
     1017         END DO 
    7341018         ! 
    7351019      CASE( 'W' )                   !* from T- to W-point : vertical simple mean 
    7361020         ! 
    737          pe3_out(:,:,1) = e3w_0(:,:,1) + pe3_in(:,:,1) - e3t_0(:,:,1) 
     1021!$OMP PARALLEL 
     1022!$OMP DO schedule(static) private(jj,ji) 
     1023         DO jj = 1, jpj 
     1024            DO ji = 1, jpi 
     1025               pe3_out(ji,jj,1) = e3w_0(ji,jj,1) + pe3_in(ji,jj,1) - e3t_0(ji,jj,1) 
     1026            END DO 
     1027         END DO 
    7381028         ! - ML - The use of mask in this formulea enables the special treatment of the last w-point without indirect adressing 
    7391029!!gm BUG? use here wmask in case of ISF ?  to be checked 
     1030!$OMP DO schedule(static) private(jk,jj,ji) 
    7401031         DO jk = 2, jpk 
    741             pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )   & 
    742                &                            * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) )                               & 
    743                &                            +            0.5_wp * ( tmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )     & 
    744                &                            * ( pe3_in(:,:,jk  ) - e3t_0(:,:,jk  ) ) 
    745          END DO 
     1032            DO jj = 1, jpj 
     1033               DO ji = 1, jpi 
     1034                  pe3_out(ji,jj,jk) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( tmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) )   & 
     1035                     &                            * ( pe3_in(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )                               & 
     1036                     &                            +            0.5_wp * ( tmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd )     & 
     1037                     &                            * ( pe3_in(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) ) 
     1038               END DO 
     1039            END DO 
     1040         END DO 
     1041!$OMP END PARALLEL 
    7461042         ! 
    7471043      CASE( 'UW' )                  !* from U- to UW-point : vertical simple mean 
    7481044         ! 
    749          pe3_out(:,:,1) = e3uw_0(:,:,1) + pe3_in(:,:,1) - e3u_0(:,:,1) 
     1045!$OMP PARALLEL 
     1046!$OMP DO schedule(static) private(jj,ji) 
     1047         DO jj = 1, jpj 
     1048            DO ji = 1, jpi 
     1049               pe3_out(ji,jj,1) = e3uw_0(ji,jj,1) + pe3_in(ji,jj,1) - e3u_0(ji,jj,1) 
     1050            END DO 
     1051         END DO 
    7501052         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
    7511053!!gm BUG? use here wumask in case of ISF ?  to be checked 
     1054!$OMP DO schedule(static) private(jk,jj,ji) 
    7521055         DO jk = 2, jpk 
    753             pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
    754                &                             * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) )                              & 
    755                &                             +            0.5_wp * ( umask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
    756                &                             * ( pe3_in(:,:,jk  ) - e3u_0(:,:,jk  ) ) 
    757          END DO 
     1056            DO jj = 1, jpj 
     1057               DO ji = 1, jpi 
     1058                  pe3_out(ji,jj,jk) = e3uw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
     1059                     &                             * ( pe3_in(ji,jj,jk-1) - e3u_0(ji,jj,jk-1) )                              & 
     1060                     &                             +            0.5_wp * ( umask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
     1061                     &                             * ( pe3_in(ji,jj,jk  ) - e3u_0(ji,jj,jk  ) ) 
     1062               END DO 
     1063            END DO 
     1064         END DO 
     1065!$OMP END PARALLEL 
    7581066         ! 
    7591067      CASE( 'VW' )                  !* from V- to VW-point : vertical simple mean 
    7601068         ! 
    761          pe3_out(:,:,1) = e3vw_0(:,:,1) + pe3_in(:,:,1) - e3v_0(:,:,1) 
     1069!$OMP PARALLEL 
     1070!$OMP DO schedule(static) private(jj,ji) 
     1071         DO jj = 1, jpj 
     1072            DO ji = 1, jpi 
     1073               pe3_out(ji,jj,1) = e3vw_0(ji,jj,1) + pe3_in(ji,jj,1) - e3v_0(ji,jj,1) 
     1074            END DO 
     1075         END DO 
    7621076         ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 
    7631077!!gm BUG? use here wvmask in case of ISF ?  to be checked 
     1078!$OMP DO schedule(static) private(jk,jj,ji) 
    7641079         DO jk = 2, jpk 
    765             pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
    766                &                             * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) )                              & 
    767                &                             +            0.5_wp * ( vmask(:,:,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
    768                &                             * ( pe3_in(:,:,jk  ) - e3v_0(:,:,jk  ) ) 
    769          END DO 
     1080            DO jj = 1, jpj 
     1081               DO ji = 1, jpi 
     1082                  pe3_out(ji,jj,jk) = e3vw_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd ) )  & 
     1083                     &                             * ( pe3_in(ji,jj,jk-1) - e3v_0(ji,jj,jk-1) )                              & 
     1084                     &                             +            0.5_wp * ( vmask(ji,jj,jk) * (1.0_wp - zlnwd) + zlnwd )    & 
     1085                     &                             * ( pe3_in(ji,jj,jk  ) - e3v_0(ji,jj,jk  ) ) 
     1086               END DO 
     1087            END DO 
     1088         END DO 
     1089!$OMP END PARALLEL 
    7701090      END SELECT 
    7711091      ! 
    … …  
    9051225                     sshb(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)           !!gm I don't understand that ! 
    9061226                     sshn(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
    907                      ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj) 
     1227                     ssha(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)                      
    9081228                  ENDIF 
    9091229                ENDDO 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

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

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r7646 r7698  
    161161         ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea 
    162162         ii0 = 141   ;   ii1 = 155 
     163!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    163164         DO jj = mj0(ij0), mj1(ij1) 
    164165            DO ji = mi0(ii0), mi1(ii1) 
    … …  
    181182!!gm end 
    182183      ! 
    183       ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask 
    184       ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:)  
     184!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     185      DO jk = 1, jpk 
     186         DO jj = 1, jpj 
     187            DO ji = 1, jpi 
     188               ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk)    ! NO mask 
     189               ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk) 
     190            END DO 
     191         END DO 
     192      END DO 
    185193      ! 
    186194      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    … …  
    193201         ENDIF 
    194202         ! 
     203!$OMP PARALLEL DO schedule(static) private(jj, ji, jk, zl, jkk, zi) 
    195204         DO jj = 1, jpj                         ! vertical interpolation of T & S 
    196205            DO ji = 1, jpi 
    … …  
    226235      ELSE                                !==   z- or zps- coordinate   ==! 
    227236         !                              
    228          ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask 
    229          ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 
     237!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     238         DO jk = 1, jpk 
     239            DO jj = 1, jpj 
     240               DO ji = 1, jpi 
     241                  ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk)    ! Mask 
     242                  ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     243               END DO 
     244            END DO 
     245         END DO 
    230246         ! 
    231247         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
     248!$OMP PARALLEL DO schedule(static) private(jj, ji, ik, zl) 
    232249            DO jj = 1, jpj 
    233250               DO ji = 1, jpi 

  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

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

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

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

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

    r6140 r7698  
    4747      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    4848      !!  
    49       INTEGER  ::   ji, jj       ! dummy loop indexes 
     49      INTEGER  ::   jk, ji, jj       ! dummy loop indexes 
    5050      INTEGER  ::   ikbu, ikbv   ! local integers 
    5151      REAL(wp) ::   zm1_2dt      ! local scalar 
    … …  
    6565        IF( l_trddyn ) THEN      ! trends: store the input trends 
    6666           CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    67            ztrdu(:,:,:) = ua(:,:,:) 
    68            ztrdv(:,:,:) = va(:,:,:) 
     67!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     68           DO jk = 1, jpk 
     69              DO jj = 1, jpj 
     70                 DO ji = 1, jpi 
     71                    ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     72                    ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     73                 END DO 
     74              END DO 
     75           END DO 
    6976        ENDIF 
    7077 
    7178 
     79!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    7280        DO jj = 2, jpjm1 
    7381           DO ji = 2, jpim1 
    … …  
    8290        ! 
    8391        IF( ln_isfcav ) THEN        ! ocean cavities 
     92!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    8493           DO jj = 2, jpjm1 
    8594              DO ji = 2, jpim1 
    … …  
    99108        ! 
    100109        IF( l_trddyn ) THEN      ! trends: send trends to trddyn for further diagnostics 
    101            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    102            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     110!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     111           DO jk = 1, jpk 
     112              DO jj = 1, jpj 
     113                 DO ji = 1, jpi 
     114                    ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     115                    ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     116                 END DO 
     117              END DO 
     118           END DO 
    103119           CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 
    104120           CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 

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

    r7646 r7698  
    8484      !!---------------------------------------------------------------------- 
    8585      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     86      INTEGER ::  jk, jj, ji 
    8687      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    8788      !!---------------------------------------------------------------------- 
    … …  
    9192      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
    9293         CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    93          ztrdu(:,:,:) = ua(:,:,:) 
    94          ztrdv(:,:,:) = va(:,:,:) 
     94!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     95         DO jk = 1, jpk 
     96            DO jj = 1, jpj 
     97               DO ji = 1, jpi 
     98                  ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     99                  ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     100               END DO 
     101            END DO 
     102         END DO 
    95103      ENDIF 
    96104      ! 
    … …  
    105113      ! 
    106114      IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 
    107          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    108          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     115!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     116         DO jk = 1, jpk 
     117            DO jj = 1, jpj 
     118               DO ji = 1, jpi 
     119                  ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     120                  ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     121               END DO 
     122            END DO 
     123         END DO 
    109124         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 
    110125         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
    … …  
    198213      !  
    199214      ! initialisation of ice shelf load 
    200       IF ( .NOT. ln_isfcav ) riceload(:,:)=0.0 
     215      IF ( .NOT. ln_isfcav ) THEN 
     216!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     217         DO jj = 1, jpj 
     218            DO ji = 1, jpi 
     219               riceload(ji,jj)=0.0 
     220            END DO 
     221         END DO 
     222      END IF 
    201223      IF (       ln_isfcav ) THEN 
    202224         CALL wrk_alloc( jpi,jpj, 2,  ztstop)  
    … …  
    212234          
    213235         ! assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
    214          ztstop(:,:,1)=-1.9_wp ; ztstop(:,:,2)=34.4_wp 
     236!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     237         DO jj = 1, jpj 
     238            DO ji = 1, jpi 
     239               ztstop(ji,jj,1)=-1.9_wp 
     240               ztstop(ji,jj,2)=34.4_wp 
     241            END DO 
     242         END DO 
    215243 
    216244         ! compute density of the water displaced by the ice shelf  
    … …  
    226254         ! divided by 2 later 
    227255         ziceload = 0._wp 
     256!$OMP PARALLEL 
     257!$OMP DO schedule(static) private(jj,ji,ikt,jk) 
    228258         DO jj = 1, jpj 
    229259            DO ji = 1, jpi 
    … …  
    238268            END DO 
    239269         END DO 
    240          riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5 
     270!$OMP DO schedule(static) private(jj, ji) 
     271         DO jj = 1, jpj 
     272            DO ji = 1, jpi 
     273               riceload(ji,jj)=ziceload(ji,jj)  ! need to be saved for diaar5 
     274            END DO 
     275         END DO 
     276!$OMP END PARALLEL 
    241277 
    242278         CALL wrk_dealloc( jpi,jpj, 2,  ztstop)  
    … …  
    282318 
    283319      ! Surface value 
     320!$OMP PARALLEL 
     321!$OMP DO schedule(static) private(ji,jj, zcoef1) 
    284322      DO jj = 2, jpjm1 
    285323         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    297335      ! interior value (2=<jk=<jpkm1) 
    298336      DO jk = 2, jpkm1 
     337!$OMP DO schedule(static) private(ji,jj, zcoef1) 
    299338         DO jj = 2, jpjm1 
    300339            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    313352            END DO 
    314353         END DO 
    315       END DO 
     354!$OMP END DO NOWAIT 
     355      END DO 
     356!$OMP END PARALLEL 
    316357      ! 
    317358      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 
    … …  
    351392 
    352393      !  Surface value (also valid in partial step case) 
     394!$OMP PARALLEL 
     395!$OMP DO schedule(static) private(ji,jj,zcoef1) 
    353396      DO jj = 2, jpjm1 
    354397         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    365408      ! interior value (2=<jk=<jpkm1) 
    366409      DO jk = 2, jpkm1 
     410!$OMP DO schedule(static) private(ji,jj, zcoef1) 
    367411         DO jj = 2, jpjm1 
    368412            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    384428 
    385429      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90) 
     430!$OMP DO schedule(static) private(ji,jj,iku,ikv,zcoef2,zcoef3) 
    386431      DO jj = 2, jpjm1 
    387432         DO ji = 2, jpim1 
    … …  
    404449         END DO 
    405450      END DO 
     451!$OMP END PARALLEL 
    406452      ! 
    407453      CALL wrk_dealloc( jpi,jpj,jpk,   zhpi, zhpj ) 

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

    r7646 r7698  
    9696      IF( l_trddyn ) THEN           ! Save ua and va trends 
    9797         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    98          ztrdu(:,:,:) = ua(:,:,:)  
    99          ztrdv(:,:,:) = va(:,:,:)  
    100       ENDIF 
    101        
    102       zhke(:,:,jpk) = 0._wp 
     98!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     99         DO jk = 1, jpk 
     100            DO jj = 1, jpj 
     101               DO ji = 1, jpi 
     102                  ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     103                  ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     104               END DO 
     105            END DO 
     106         END DO 
     107      ENDIF 
     108!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     109      DO jj = 1, jpj 
     110         DO ji = 1, jpi 
     111            zhke(ji,jj,jpk) = 0._wp 
     112         END DO 
     113      END DO 
    103114       
    104115      IF (ln_bdy) THEN 
    … …  
    133144      ! 
    134145      CASE ( nkeg_C2 )                          !--  Standard scheme  --! 
     146!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 
    135147         DO jk = 1, jpkm1 
    136148            DO jj = 2, jpj 
    … …  
    146158         ! 
    147159      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
     160!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 
    148161         DO jk = 1, jpkm1 
    149162            DO jj = 2, jpjm1        
    … …  
    168181      IF (ln_bdy) THEN 
    169182         ! restore velocity masks at points outside boundary 
    170          un(:,:,:) = un(:,:,:) * umask(:,:,:) 
    171          vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 
    172       ENDIF       
    173  
    174  
    175       ! 
     183!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     184         DO jk = 1, jpk 
     185            DO jj = 1, jpj 
     186               DO ji = 1, jpi 
     187                  un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk) 
     188                  vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk) 
     189               END DO  
     190            END DO 
     191         END DO 
     192      ENDIF 
     193 
     194      ! 
     195!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    176196      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
    177197         DO jj = 2, jpjm1 
    … …  
    184204      ! 
    185205      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
    186          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    187          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     206!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     207           DO jk = 1, jpk 
     208              DO jj = 1, jpj 
     209                 DO ji = 1, jpi 
     210                    ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     211                    ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     212                 END DO 
     213              END DO 
     214           END DO 
    188215         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    189216         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 

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

    r7646 r7698  
    6161      !!---------------------------------------------------------------------- 
    6262      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     63      INTEGER ::   jk, jj, ji 
    6364      ! 
    6465      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    … …  
    6970      IF( l_trddyn )   THEN                      ! temporary save of momentum trends 
    7071         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
    71          ztrdu(:,:,:) = ua(:,:,:)  
    72          ztrdv(:,:,:) = va(:,:,:)  
     72!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     73         DO jk = 1, jpk 
     74            DO jj = 1, jpj 
     75               DO ji = 1, jpi 
     76                  ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     77                  ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     78               END DO 
     79            END DO 
     80         END DO 
    7381      ENDIF 
    7482 
    … …  
    8290 
    8391      IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics 
    84          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    85          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     92!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     93           DO jk = 1, jpk 
     94              DO jj = 1, jpj 
     95                 DO ji = 1, jpi 
     96                    ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     97                    ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     98                 END DO 
     99              END DO 
     100           END DO 
    86101         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 
    87102         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 

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

    r6140 r7698  
    7575      ! 
    7676      !                                                ! =============== 
     77!$OMP PARALLEL 
    7778      DO jk = 1, jpkm1                                 ! Horizontal slab 
    7879         !                                             ! =============== 
     80!$OMP DO schedule(static) private(jj, ji) 
    7981         DO jj = 2, jpj 
    8082            DO ji = fs_2, jpi   ! vector opt. 
    … …  
    9395         END DO   
    9496         ! 
     97!$OMP DO schedule(static) private(jj, ji) 
    9598         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div ) 
    9699            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    106109         !                                             ! =============== 
    107110      END DO                                           !   End of slab 
     111!$OMP END PARALLEL 
    108112      !                                                ! =============== 
    109113      CALL wrk_dealloc( jpi, jpj, zcur, zdiv )  
    … …  
    128132      !!---------------------------------------------------------------------- 
    129133      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
     134      INTEGER                                         ::   jk, jj, ji 
    130135      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields 
    131136      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend 
    … …  
    144149      ENDIF 
    145150      ! 
    146       zulap(:,:,:) = 0._wp 
    147       zvlap(:,:,:) = 0._wp 
     151!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     152      DO jk = 1, jpk 
     153         DO jj = 1, jpj 
     154            DO ji = 1, jpi 
     155               zulap(ji,jj,jk) = 0._wp 
     156               zvlap(ji,jj,jk) = 0._wp 
     157            END DO 
     158         END DO 
     159      END DO 
    148160      ! 
    149161      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap) 

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

    r7646 r7698  
    115115         ! Ensure below that barotropic velocities match time splitting estimate 
    116116         ! Compute actual transport and replace it with ts estimate at "after" time step 
    117          zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
    118          zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
     117!$OMP PARALLEL 
     118!$OMP DO schedule(static) private(jj, ji) 
     119         DO jj = 1, jpj 
     120            DO ji = 1, jpi 
     121               zue(ji,jj) = e3u_a(ji,jj,1) * ua(ji,jj,1) * umask(ji,jj,1) 
     122               zve(ji,jj) = e3v_a(ji,jj,1) * va(ji,jj,1) * vmask(ji,jj,1) 
     123            END DO 
     124         END DO 
    119125         DO jk = 2, jpkm1 
    120             zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    121             zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
    122          END DO 
     126!$OMP DO schedule(static) private(jj,ji) 
     127            DO jj = 1, jpj 
     128               DO ji = 1, jpi 
     129                  zue(ji,jj) = zue(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
     130                  zve(ji,jj) = zve(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
     131               END DO 
     132            END DO 
     133         END DO 
     134!$OMP DO schedule(static) private(jk,jj,ji) 
    123135         DO jk = 1, jpkm1 
    124             ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
    125             va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
    126          END DO 
     136            DO jj = 1, jpj 
     137               DO ji = 1, jpi 
     138                  ua(ji,jj,jk) = ( ua(ji,jj,jk) - zue(ji,jj) * r1_hu_a(ji,jj) + ua_b(ji,jj) ) * umask(ji,jj,jk) 
     139                  va(ji,jj,jk) = ( va(ji,jj,jk) - zve(ji,jj) * r1_hv_a(ji,jj) + va_b(ji,jj) ) * vmask(ji,jj,jk) 
     140               END DO 
     141            END DO 
     142         END DO 
     143!$OMP END PARALLEL 
    127144         ! 
    128145         IF( .NOT.ln_bt_fw ) THEN 
    … …  
    131148            ! In the forward case, this is done below after asselin filtering    
    132149            ! so that asselin contribution is removed at the same time  
     150!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    133151            DO jk = 1, jpkm1 
    134                un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 
    135                vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
    136             END DO   
     152               DO jj = 1, jpj 
     153                  DO ji = 1, jpi 
     154                     un(ji,jj,jk) = ( un(ji,jj,jk) - un_adv(ji,jj) + un_b(ji,jj) )*umask(ji,jj,jk) 
     155                     vn(ji,jj,jk) = ( vn(ji,jj,jk) - vn_adv(ji,jj) + vn_b(ji,jj) )*vmask(ji,jj,jk) 
     156                  END DO 
     157               END DO 
     158            END DO 
     159 
    137160         ENDIF 
    138161      ENDIF 
    … …  
    161184         ! 
    162185         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends 
    163             zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 
    164             zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 
     186!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     187            DO jk = 1, jpk 
     188               DO jj = 1, jpj 
     189                  DO ji = 1, jpi 
     190                     zua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_2dt 
     191                     zva(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_2dt 
     192                  END DO 
     193               END DO 
     194            END DO 
    165195            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter 
    166196            CALL iom_put( "vtrd_tot", zva ) 
    167197         ENDIF 
    168198         ! 
    169          zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter 
    170          zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the 
    171          !                                  !  computation of the asselin filter trends) 
     199!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     200         DO jk = 1, jpk 
     201            DO jj = 1, jpj 
     202               DO ji = 1, jpi 
     203                  zua(ji,jj,jk) = un(ji,jj,jk)             ! save the now velocity before the asselin filter 
     204                  zva(ji,jj,jk) = vn(ji,jj,jk)             ! (caution: there will be a shift by 1 timestep in the 
     205                        !                                  !  computation of the asselin filter trends) 
     206               END DO 
     207            END DO 
     208         END DO 
    172209      ENDIF 
    173210 
    … …  
    175212      ! ------------------------------------------ 
    176213      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap 
     214!$OMP PARALLEL 
     215!$OMP DO schedule(static) private(jk,jj,ji) 
    177216         DO jk = 1, jpkm1 
    178             un(:,:,jk) = ua(:,:,jk)                          ! un <-- ua 
    179             vn(:,:,jk) = va(:,:,jk) 
    180          END DO 
     217            DO jj = 1, jpj 
     218               DO ji = 1, jpi 
     219                  un(ji,jj,jk) = ua(ji,jj,jk)                          ! un <-- ua 
     220                  vn(ji,jj,jk) = va(ji,jj,jk) 
     221               END DO 
     222            END DO 
     223         END DO 
     224!$OMP END DO NOWAIT 
    181225         IF(.NOT.ln_linssh ) THEN 
     226!$OMP DO schedule(static) private(jk,jj,ji) 
    182227            DO jk = 1, jpkm1 
    183                e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    184                e3u_b(:,:,jk) = e3u_n(:,:,jk) 
    185                e3v_b(:,:,jk) = e3v_n(:,:,jk) 
     228               DO jj = 1, jpj 
     229                  DO ji = 1, jpi 
     230                     e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) 
     231                     e3u_b(ji,jj,jk) = e3u_n(ji,jj,jk) 
     232                     e3v_b(ji,jj,jk) = e3v_n(ji,jj,jk) 
     233                  END DO 
     234               END DO 
    186235            END DO 
    187236         ENDIF 
     237!$OMP END PARALLEL 
    188238      ELSE                                             !* Leap-Frog : Asselin filter and swap 
    189239         !                                ! =============! 
    190240         IF( ln_linssh ) THEN             ! Fixed volume ! 
    191241            !                             ! =============! 
     242!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 
    192243            DO jk = 1, jpkm1                               
    193244               DO jj = 1, jpj 
    … …  
    210261            ! ---------------------------------------------------- 
    211262            IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN    ! No asselin filtering on thicknesses if forward time splitting 
    212                e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 
     263!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     264               DO jj = 1, jpj 
     265                  DO ji = 1, jpi 
     266                     e3t_b(ji,jj,1:jpkm1) = e3t_n(ji,jj,1:jpkm1) 
     267                  END DO 
     268               END DO 
    213269            ELSE 
     270!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    214271               DO jk = 1, jpkm1 
    215                   e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
     272                  DO jj = 1, jpj 
     273                     DO ji = 1, jpi 
     274                        e3t_b(ji,jj,jk) = e3t_n(ji,jj,jk) + atfp * ( e3t_b(ji,jj,jk) - 2._wp * e3t_n(ji,jj,jk) + e3t_a(ji,jj,jk) ) 
     275                     END DO 
     276                  END DO 
    216277               END DO 
    217278               ! Add volume filter correction: compatibility with tracer advection scheme 
    … …  
    219280               zcoef = atfp * rdt * r1_rau0 
    220281               IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting 
    221                   e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) & 
    222                                  &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1) 
     282!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     283                  DO jj = 1, jpj 
     284                     DO ji = 1, jpi 
     285                        e3t_b(ji,jj,1) = e3t_b(ji,jj,1) - zcoef * ( emp_b(ji,jj) - emp(ji,jj) & 
     286                                 &                      - rnf_b(ji,jj) + rnf(ji,jj) ) * tmask(ji,jj,1) 
     287                     END DO 
     288                  END DO 
    223289               ELSE                     ! if ice shelf melting 
     290!$OMP PARALLEL DO schedule(static) private(jj,ji,ikt) 
    224291                  DO jj = 1, jpj 
    225292                     DO ji = 1, jpi 
    … …  
    237304               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
    238305               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
     306!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 
    239307               DO jk = 1, jpkm1 
    240308                  DO jj = 1, jpj 
    … …  
    257325               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
    258326               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 
     327!$OMP PARALLEL  
     328!$OMP DO schedule(static) private(jk, jj, ji, zue3a, zve3a, zue3n, zve3n, zue3b, zve3b, zuf, zvf) 
    259329               DO jk = 1, jpkm1 
    260330                  DO jj = 1, jpj 
    … …  
    277347                  END DO 
    278348               END DO 
    279                e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor 
    280                e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
     349!$OMP DO schedule(static) private(jj, ji) 
     350                  DO jj = 1, jpj 
     351                     DO ji = 1, jpi 
     352                        e3u_b(ji,jj,1:jpkm1) = ze3u_f(ji,jj,1:jpkm1)        ! e3u_b <-- filtered scale factor 
     353                        e3v_b(ji,jj,1:jpkm1) = ze3v_f(ji,jj,1:jpkm1) 
     354                     END DO 
     355                  END DO 
     356!$OMP END PARALLEL 
    281357               ! 
    282358               CALL wrk_dealloc( jpi,jpj,jpk,   ze3u_f, ze3v_f ) 
    … …  
    288364            ! Revert "before" velocities to time split estimate 
    289365            ! Doing it here also means that asselin filter contribution is removed   
    290             zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
    291             zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)     
     366!$OMP PARALLEL  
     367!$OMP DO schedule(static) private(jj, ji) 
     368            DO jj = 1, jpj 
     369               DO ji = 1, jpi 
     370                  zue(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 
     371                  zve(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 
     372               END DO 
     373            END DO 
    292374            DO jk = 2, jpkm1 
    293                zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
    294                zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
    295             END DO 
     375!$OMP DO schedule(static) private(jj, ji) 
     376               DO jj = 1, jpj 
     377                  DO ji = 1, jpi 
     378                     zue(ji,jj) = zue(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
     379                     zve(ji,jj) = zve(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
     380                  END DO 
     381               END DO 
     382            END DO 
     383!$OMP DO schedule(static) private(jk,jj,ji) 
    296384            DO jk = 1, jpkm1 
    297                ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 
    298                vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk) 
    299             END DO 
     385               DO jj = 1, jpj 
     386                  DO ji = 1, jpi 
     387                     ub(ji,jj,jk) = ub(ji,jj,jk) - (zue(ji,jj) * r1_hu_n(ji,jj) - un_b(ji,jj)) * umask(ji,jj,jk) 
     388                     vb(ji,jj,jk) = vb(ji,jj,jk) - (zve(ji,jj) * r1_hv_n(ji,jj) - vn_b(ji,jj)) * vmask(ji,jj,jk) 
     389                  END DO 
     390               END DO 
     391            END DO 
     392!$OMP END PARALLEL 
    300393         ENDIF 
    301394         ! 
    … …  
    308401      ! 
    309402      IF(.NOT.ln_linssh ) THEN 
    310          hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 
    311          hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 
     403!$OMP PARALLEL  
     404!$OMP DO schedule(static) private(jj, ji) 
     405         DO jj = 1, jpj 
     406            DO ji = 1, jpi 
     407               hu_b(ji,jj) = e3u_b(ji,jj,1) * umask(ji,jj,1) 
     408               hv_b(ji,jj) = e3v_b(ji,jj,1) * vmask(ji,jj,1) 
     409            END DO 
     410         END DO 
    312411         DO jk = 2, jpkm1 
    313             hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
    314             hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
    315          END DO 
    316          r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 
    317          r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
    318       ENDIF 
    319       ! 
    320       un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1) 
    321       ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
    322       vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1) 
    323       vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 
     412!$OMP DO schedule(static) private(jj, ji) 
     413            DO jj = 1, jpj 
     414               DO ji = 1, jpi 
     415                  hu_b(ji,jj) = hu_b(ji,jj) + e3u_b(ji,jj,jk) * umask(ji,jj,jk) 
     416                  hv_b(ji,jj) = hv_b(ji,jj) + e3v_b(ji,jj,jk) * vmask(ji,jj,jk) 
     417               END DO 
     418            END DO 
     419         END DO 
     420!$OMP DO schedule(static) private(jj, ji) 
     421         DO jj = 1, jpj 
     422            DO ji = 1, jpi 
     423               r1_hu_b(ji,jj) = ssumask(ji,jj) / ( hu_b(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     424               r1_hv_b(ji,jj) = ssvmask(ji,jj) / ( hv_b(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     425            END DO 
     426         END DO 
     427!$OMP END PARALLEL 
     428      ENDIF 
     429      ! 
     430!$OMP PARALLEL 
     431!$OMP DO schedule(static) private(jj, ji) 
     432      DO jj = 1, jpj 
     433         DO ji = 1, jpi 
     434            un_b(ji,jj) = e3u_a(ji,jj,1) * un(ji,jj,1) * umask(ji,jj,1) 
     435            ub_b(ji,jj) = e3u_b(ji,jj,1) * ub(ji,jj,1) * umask(ji,jj,1) 
     436            vn_b(ji,jj) = e3v_a(ji,jj,1) * vn(ji,jj,1) * vmask(ji,jj,1) 
     437            vb_b(ji,jj) = e3v_b(ji,jj,1) * vb(ji,jj,1) * vmask(ji,jj,1) 
     438         END DO 
     439      END DO 
    324440      DO jk = 2, jpkm1 
    325          un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 
    326          ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
    327          vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk) 
    328          vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 
     441!$OMP DO schedule(static) private(jj, ji) 
     442         DO jj = 1, jpj 
     443            DO ji = 1, jpi 
     444               un_b(ji,jj) = un_b(ji,jj) + e3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 
     445               ub_b(ji,jj) = ub_b(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 
     446               vn_b(ji,jj) = vn_b(ji,jj) + e3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 
     447               vb_b(ji,jj) = vb_b(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 
     448            END DO 
     449         END DO 
    329450      END DO 
    330       un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 
    331       vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 
    332       ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    333       vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     451!$OMP DO schedule(static) private(jj, ji) 
     452      DO jj = 1, jpj 
     453         DO ji = 1, jpi 
     454            un_b(ji,jj) = un_b(ji,jj) * r1_hu_a(ji,jj) 
     455            vn_b(ji,jj) = vn_b(ji,jj) * r1_hv_a(ji,jj) 
     456            ub_b(ji,jj) = ub_b(ji,jj) * r1_hu_b(ji,jj) 
     457            vb_b(ji,jj) = vb_b(ji,jj) * r1_hv_b(ji,jj) 
     458         END DO 
     459      END DO 
     460!$OMP END PARALLEL 
    334461      ! 
    335462      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents 
    … …  
    338465      ENDIF 
    339466      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
    340          zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
    341          zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 
     467!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     468         DO jk = 1, jpkm1 
     469            DO jj = 1, jpj 
     470               DO ji = 1, jpi 
     471                  zua(ji,jj,jk) = ( ub(ji,jj,jk) - zua(ji,jj,jk) ) * z1_2dt 
     472                  zva(ji,jj,jk) = ( vb(ji,jj,jk) - zva(ji,jj,jk) ) * z1_2dt 
     473               END DO 
     474            END DO 
     475         END DO 
    342476         CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 
    343477      ENDIF 

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

    r7646 r7698  
    8383      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    8484         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
    85          ztrdu(:,:,:) = ua(:,:,:) 
    86          ztrdv(:,:,:) = va(:,:,:) 
     85!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     86        DO jk = 1, jpk 
     87           DO jj = 1, jpj 
     88              DO ji = 1, jpi 
     89                 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     90                 ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     91              END DO 
     92           END DO 
     93        END DO 
    8794      ENDIF 
    8895      ! 
    … …  
    9198         .OR.  nn_ice_embd == 2  ) THEN                                      ! embedded sea-ice 
    9299         ! 
     100!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    93101         DO jj = 2, jpjm1 
    94102            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    100108         IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==! 
    101109            zg_2 = grav * 0.5 
     110!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    102111            DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh 
    103112               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    115124            CALL upd_tide( kt )                      ! update tide potential 
    116125            ! 
     126!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    117127            DO jj = 2, jpjm1                         ! add tide potential forcing 
    118128               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    128138            zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
    129139            zgrau0r     = - grav * r1_rau0 
    130             zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
     140!$OMP PARALLEL 
     141!$OMP DO schedule(static) private(jj, ji) 
     142            DO jj = 1, jpj 
     143               DO ji = 1, jpi 
     144                  zpice(ji,jj) = (  zintp * snwice_mass(ji,jj) + ( 1.- zintp ) * snwice_mass_b(ji,jj)  ) * zgrau0r 
     145               END DO 
     146            END DO 
     147!$OMP DO schedule(static) private(jj, ji) 
    131148            DO jj = 2, jpjm1 
    132149               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    135152               END DO 
    136153            END DO 
     154!$OMP END PARALLEL 
    137155            ! 
    138156            CALL wrk_dealloc( jpi,jpj,   zpice )          
    139157         ENDIF 
    140158         ! 
     159!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    141160         DO jk = 1, jpkm1                    !== Add all terms to the general trend 
    142161            DO jj = 2, jpjm1 
    … …  
    158177      !                     
    159178      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics 
    160          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    161          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     179!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     180           DO jk = 1, jpk 
     181              DO jj = 1, jpj 
     182                 DO ji = 1, jpi 
     183                    ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     184                    ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     185                 END DO 
     186              END DO 
     187           END DO 
    162188         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
    163189         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )  

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

    r7646 r7698  
    223223            SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
    224224            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     225!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    225226               DO jj = 1, jpjm1 
    226227                  DO ji = 1, jpim1 
    … …  
    231232               END DO 
    232233            CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     234!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    233235               DO jj = 1, jpjm1 
    234236                  DO ji = 1, jpim1 
    … …  
    243245            CALL lbc_lnk( zwz, 'F', 1._wp ) 
    244246            ! 
    245             ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
     247!$OMP PARALLEL 
     248!$OMP DO schedule(static) private(jj) 
     249            DO jj = 1, jpj 
     250               ftne(1,jj) = 0._wp ; ftnw(1,jj) = 0._wp ; ftse(1,jj) = 0._wp ; ftsw(1,jj) = 0._wp 
     251            END DO 
     252!$OMP DO schedule(static) private(jj, ji) 
    246253            DO jj = 2, jpj 
    247254               DO ji = 2, jpi 
    … …  
    252259               END DO 
    253260            END DO 
     261!$OMP END PARALLEL 
    254262            ! 
    255263         ELSE                                !== all other schemes (ENE, ENS, MIX) 
    256             zwz(:,:) = 0._wp 
    257             zhf(:,:) = 0._wp 
     264!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     265            DO jj = 1, jpj 
     266               DO ji = 1, jpi 
     267                  zwz(ji,jj) = 0._wp 
     268                  zhf(ji,jj) = 0._wp 
     269               END DO 
     270            END DO 
    258271             
    259272!!gm  assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed  
    … …  
    275288               ELSE 
    276289                 !zhf(:,:) = hbatf(:,:) 
     290!$OMP PARALLEL DO schedule(static) private(ji,jj) 
    277291                 DO jj = 1, jpjm1 
    278292                   DO ji = 1, jpim1 
    … …  
    289303              END IF 
    290304   
     305!$OMP PARALLEL  
     306!$OMP DO schedule(static) private(ji,jj) 
    291307              DO jj = 1, jpjm1 
    292                  zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 
     308                 DO ji = 1, jpim1 
     309                    zhf(ji,jj) = zhf(ji,jj) * (1._wp- umask(ji,jj,1) * umask(ji,jj+1,1)) 
     310                 END DO 
    293311              END DO 
    294312!!gm end 
    295313 
    296314            DO jk = 1, jpkm1 
     315!$OMP DO schedule(static) private(ji,jj) 
    297316               DO jj = 1, jpjm1 
    298                   zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
    299                END DO 
    300             END DO 
     317                  DO ji = 1, jpi 
     318                     zhf(ji,jj) = zhf(ji,jj) + e3f_n(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj+1,jk) 
     319                  END DO 
     320               END DO 
     321            END DO 
     322!$OMP END PARALLEL  
    301323            CALL lbc_lnk( zhf, 'F', 1._wp ) 
    302324            ! JC: TBC. hf should be greater than 0  
     325!$OMP PARALLEL  
     326!$OMP DO schedule(static) private(jj, ji) 
    303327            DO jj = 1, jpj 
    304328               DO ji = 1, jpi 
    … …  
    306330               END DO 
    307331            END DO 
    308             zwz(:,:) = ff_f(:,:) * zwz(:,:) 
     332!$OMP DO schedule(static) private(jj, ji) 
     333            DO jj = 1, jpj 
     334               DO ji = 1, jpi 
     335                  zwz(ji,jj) = ff_f(ji,jj) * zwz(ji,jj) 
     336               END DO 
     337            END DO 
     338!$OMP END PARALLEL 
    309339         ENDIF 
    310340      ENDIF 
    … …  
    324354      !                                   !* e3*d/dt(Ua) (Vertically integrated) 
    325355      !                                   ! -------------------------------------------------- 
    326       zu_frc(:,:) = 0._wp 
    327       zv_frc(:,:) = 0._wp 
     356!$OMP PARALLEL 
     357!$OMP DO schedule(static) private(jj, ji) 
     358      DO jj = 1, jpj 
     359         DO ji = 1, jpi 
     360            zu_frc(ji,jj) = 0._wp 
     361            zv_frc(ji,jj) = 0._wp 
     362         END DO 
     363      END DO 
    328364      ! 
    329365      DO jk = 1, jpkm1 
    330          zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    331          zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)          
     366!$OMP DO schedule(static) private(jj,ji) 
     367         DO jj=1,jpj 
     368            DO ji=1,jpi 
     369               zu_frc(ji,jj) = zu_frc(ji,jj) + e3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
     370               zv_frc(ji,jj) = zv_frc(ji,jj) + e3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
     371            END DO 
     372         END DO 
    332373      END DO 
    333374      ! 
    334       zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 
    335       zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 
    336       ! 
     375!$OMP DO schedule(static) private(jj, ji) 
     376      DO jj = 1, jpj 
     377         DO ji = 1, jpi 
     378            zu_frc(ji,jj) = zu_frc(ji,jj) * r1_hu_n(ji,jj) 
     379            zv_frc(ji,jj) = zv_frc(ji,jj) * r1_hv_n(ji,jj) 
     380         END DO 
     381      END DO 
    337382      ! 
    338383      !                                   !* baroclinic momentum trend (remove the vertical mean trend) 
     384!$OMP DO schedule(static) private(jk,jj,ji) 
    339385      DO jk = 1, jpkm1                    ! ----------------------------------------------------------- 
    340386         DO jj = 2, jpjm1 
    … …  
    345391         END DO 
    346392      END DO 
     393!$OMP END DO NOWAIT 
    347394       
    348395!!gm  Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum.... 
    … …  
    352399      !                                   !* barotropic Coriolis trends (vorticity scheme dependent) 
    353400      !                                   ! -------------------------------------------------------- 
    354       zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
    355       zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 
     401!$OMP DO schedule(static) private(jj, ji) 
     402      DO jj = 1, jpj 
     403         DO ji = 1, jpi 
     404            zwx(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj)        ! now fluxes  
     405            zwy(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 
     406         END DO 
     407      END DO 
     408!$OMP END PARALLEL 
    356409      ! 
    357410      IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      ! energy conserving or mixed scheme 
     411!$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 
    358412         DO jj = 2, jpjm1 
    359413            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    369423         ! 
    370424      ELSEIF ( ln_dynvor_ens ) THEN                    ! enstrophy conserving scheme 
     425!$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zx1) 
    371426         DO jj = 2, jpjm1 
    372427            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    381436         ! 
    382437      ELSEIF ( ln_dynvor_een ) THEN  ! enstrophy and energy conserving scheme 
     438!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    383439         DO jj = 2, jpjm1 
    384440            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    400456      IF( .NOT.ln_linssh ) THEN                 ! Variable volume : remove surface pressure gradient 
    401457        IF( ln_wd ) THEN                        ! Calculating and applying W/D gravity filters 
     458!$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 
    402459           DO jj = 2, jpjm1 
    403460              DO ji = 2, jpim1  
    … …  
    440497           END DO 
    441498  
     499!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    442500           DO jj = 2, jpjm1 
    443501              DO ji = 2, jpim1 
    … …  
    451509         ELSE 
    452510 
     511!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    453512           DO jj = 2, jpjm1 
    454513              DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    461520      ENDIF 
    462521 
     522!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    463523      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend 
    464524         DO ji = fs_2, fs_jpim1 
    … …  
    470530      !                 ! Add bottom stress contribution from baroclinic velocities:       
    471531      IF (ln_bt_fw) THEN 
     532!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 
    472533         DO jj = 2, jpjm1                           
    473534            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    479540         END DO 
    480541      ELSE 
     542!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 
    481543         DO jj = 2, jpjm1 
    482544            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    491553      ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 
    492554      IF( ln_wd ) THEN 
    493         zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) 
    494         zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) 
     555!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     556         DO jj = 1, jpj 
     557            DO ji = 1, jpi   ! vector opt. 
     558               zu_frc(ji,jj) = zu_frc(ji,jj) + MAX(r1_hu_n(ji,jj) * bfrua(ji,jj),-1._wp / rdtbt) * zwx(ji,jj) 
     559               zv_frc(ji,jj) = zv_frc(ji,jj) + MAX(r1_hv_n(ji,jj) * bfrva(ji,jj),-1._wp / rdtbt) * zwy(ji,jj) 
     560            END DO 
     561         END DO 
    495562      ELSE 
    496         zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 
    497         zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 
     563!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     564         DO jj = 1, jpj 
     565            DO ji = 1, jpi 
     566               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * bfrua(ji,jj) * zwx(ji,jj) 
     567               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * bfrva(ji,jj) * zwy(ji,jj) 
     568            END DO 
     569         END DO 
    498570      END IF 
    499571      ! 
    500572      !                                         ! Add top stress contribution from baroclinic velocities:       
    501573      IF( ln_bt_fw ) THEN 
     574!$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv) 
    502575         DO jj = 2, jpjm1 
    503576            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    509582         END DO 
    510583      ELSE 
     584!$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv) 
    511585         DO jj = 2, jpjm1 
    512586            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    520594      ! 
    521595      ! Note that the "unclipped" top friction parameter is used even with explicit drag 
    522       zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 
    523       zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 
     596!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     597      DO jj = 1, jpj 
     598         DO ji = 1, jpi 
     599            zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * tfrua(ji,jj) * zwx(ji,jj) 
     600            zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * tfrva(ji,jj) * zwy(ji,jj) 
     601         END DO 
     602      END DO 
    524603      !        
    525604      IF (ln_bt_fw) THEN                        ! Add wind forcing 
    526          zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 
    527          zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 
     605!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     606         DO jj = 1, jpj 
     607            DO ji = 1, jpi 
     608               zu_frc(ji,jj) =  zu_frc(ji,jj) + zraur * utau(ji,jj) * r1_hu_n(ji,jj) 
     609               zv_frc(ji,jj) =  zv_frc(ji,jj) + zraur * vtau(ji,jj) * r1_hv_n(ji,jj) 
     610            END DO 
     611         END DO 
    528612      ELSE 
    529          zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 
    530          zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 
     613!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     614         DO jj = 1, jpj 
     615            DO ji = 1, jpi 
     616               zu_frc(ji,jj) =  zu_frc(ji,jj) + zraur * z1_2 * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 
     617               zv_frc(ji,jj) =  zv_frc(ji,jj) + zraur * z1_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 
     618            END DO 
     619         END DO 
    531620      ENDIF   
    532621      ! 
    533622      IF ( ln_apr_dyn ) THEN                    ! Add atm pressure forcing 
    534623         IF (ln_bt_fw) THEN 
     624!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    535625            DO jj = 2, jpjm1               
    536626               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    542632            END DO 
    543633         ELSE 
     634!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    544635            DO jj = 2, jpjm1               
    545636               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    558649      !                                         ! Surface net water flux and rivers 
    559650      IF (ln_bt_fw) THEN 
    560          zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 
     651!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     652         DO jj = 1, jpj 
     653            DO ji = 1, jpi 
     654               zssh_frc(ji,jj) = zraur * ( emp(ji,jj) - rnf(ji,jj) + fwfisf(ji,jj) ) 
     655            END DO 
     656         END DO 
    561657      ELSE 
    562          zssh_frc(:,:) = zraur * z1_2 * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:)   & 
    563                 &                        + fwfisf(:,:) + fwfisf_b(:,:)                     ) 
     658!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     659         DO jj = 1, jpj 
     660            DO ji = 1, jpi 
     661               zssh_frc(ji,jj) = zraur * z1_2 * (  emp(ji,jj) + emp_b(ji,jj) - rnf(ji,jj) - rnf_b(ji,jj)   & 
     662                &                        + fwfisf(ji,jj) + fwfisf_b(ji,jj) ) 
     663            END DO 
     664         END DO 
    564665      ENDIF 
    565666      ! 
    566667      IF( ln_sdw ) THEN                         ! Stokes drift divergence added if necessary 
    567          zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 
     668!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     669         DO jj = 1, jpj 
     670            DO ji = 1, jpi 
     671               zssh_frc(ji,jj) = zssh_frc(ji,jj) + div_sd(ji,jj) 
     672            END DO 
     673         END DO 
    568674      ENDIF 
    569675      ! 
    … …  
    571677      !                                         ! Include the IAU weighted SSH increment 
    572678      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    573          zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 
     679!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     680         DO jj = 1, jpj 
     681            DO ji = 1, jpi 
     682               zssh_frc(ji,jj) = zssh_frc(ji,jj) - ssh_iau(ji,jj) 
     683            END DO 
     684         END DO 
    574685      ENDIF 
    575686#endif 
    … …  
    589700      ! Initialize barotropic variables:       
    590701      IF( ll_init )THEN 
    591          sshbb_e(:,:) = 0._wp 
    592          ubb_e  (:,:) = 0._wp 
    593          vbb_e  (:,:) = 0._wp 
    594          sshb_e (:,:) = 0._wp 
    595          ub_e   (:,:) = 0._wp 
    596          vb_e   (:,:) = 0._wp 
     702!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     703         DO jj = 1, jpj 
     704            DO ji = 1, jpi 
     705               sshbb_e(ji,jj) = 0._wp 
     706               ubb_e  (ji,jj) = 0._wp 
     707               vbb_e  (ji,jj) = 0._wp 
     708               sshb_e (ji,jj) = 0._wp 
     709               ub_e   (ji,jj) = 0._wp 
     710               vb_e   (ji,jj) = 0._wp 
     711            END DO 
     712         END DO 
    597713      ENDIF 
    598714 
    599715      ! 
    600716      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    601          sshn_e(:,:) =    sshn(:,:)             
    602          un_e  (:,:) =    un_b(:,:)             
    603          vn_e  (:,:) =    vn_b(:,:) 
    604          ! 
    605          hu_e  (:,:) =    hu_n(:,:)        
    606          hv_e  (:,:) =    hv_n(:,:)  
    607          hur_e (:,:) = r1_hu_n(:,:)     
    608          hvr_e (:,:) = r1_hv_n(:,:) 
     717!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     718         DO jj = 1, jpj 
     719            DO ji = 1, jpi 
     720               sshn_e(ji,jj) =    sshn(ji,jj) 
     721               un_e  (ji,jj) =    un_b(ji,jj) 
     722               vn_e  (ji,jj) =    vn_b(ji,jj) 
     723                ! 
     724               hu_e  (ji,jj) =    hu_n(ji,jj) 
     725               hv_e  (ji,jj) =    hv_n(ji,jj) 
     726               hur_e (ji,jj) = r1_hu_n(ji,jj) 
     727               hvr_e (ji,jj) = r1_hv_n(ji,jj) 
     728            END DO 
     729         END DO 
    609730      ELSE                                ! CENTRED integration: start from BEFORE fields 
    610          sshn_e(:,:) =    sshb(:,:) 
    611          un_e  (:,:) =    ub_b(:,:)          
    612          vn_e  (:,:) =    vb_b(:,:) 
    613          ! 
    614          hu_e  (:,:) =    hu_b(:,:)        
    615          hv_e  (:,:) =    hv_b(:,:)  
    616          hur_e (:,:) = r1_hu_b(:,:)     
    617          hvr_e (:,:) = r1_hv_b(:,:) 
     731!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     732         DO jj = 1, jpj 
     733            DO ji = 1, jpi 
     734               sshn_e(ji,jj) =    sshb(ji,jj) 
     735               un_e  (ji,jj) =    ub_b(ji,jj) 
     736               vn_e  (ji,jj) =    vb_b(ji,jj) 
     737                 ! 
     738               hu_e  (ji,jj) =    hu_b(ji,jj) 
     739               hv_e  (ji,jj) =    hv_b(ji,jj) 
     740               hur_e (ji,jj) = r1_hu_b(ji,jj) 
     741               hvr_e (ji,jj) = r1_hv_b(ji,jj) 
     742            END DO 
     743         END DO 
    618744      ENDIF 
    619745      ! 
    … …  
    621747      ! 
    622748      ! Initialize sums: 
    623       ua_b  (:,:) = 0._wp       ! After barotropic velocities (or transport if flux form)           
    624       va_b  (:,:) = 0._wp 
    625       ssha  (:,:) = 0._wp       ! Sum for after averaged sea level 
    626       un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop 
    627       vn_adv(:,:) = 0._wp 
     749!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     750      DO jj = 1, jpj 
     751         DO ji = 1, jpi 
     752            ua_b  (ji,jj) = 0._wp       ! After barotropic velocities (or transport if flux form)           
     753            va_b  (ji,jj) = 0._wp 
     754            ssha  (ji,jj) = 0._wp       ! Sum for after averaged sea level 
     755            un_adv(ji,jj) = 0._wp       ! Sum for now transport issued from ts loop 
     756            vn_adv(ji,jj) = 0._wp 
     757         END DO 
     758      END DO 
    628759      !                                             ! ==================== ! 
    629760      DO jn = 1, icycle                             !  sub-time-step loop  ! 
    … …  
    649780 
    650781         ! Extrapolate barotropic velocities at step jit+0.5: 
    651          ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 
    652          va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 
     782!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     783         DO jj = 1, jpj 
     784            DO ji = 1, jpi 
     785               ua_e(ji,jj) = za1 * un_e(ji,jj) + za2 * ub_e(ji,jj) + za3 * ubb_e(ji,jj) 
     786               va_e(ji,jj) = za1 * vn_e(ji,jj) + za2 * vb_e(ji,jj) + za3 * vbb_e(ji,jj) 
     787            END DO 
     788         END DO 
    653789 
    654790         IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only) 
    655791            !                                             !  ------------------ 
    656792            ! Extrapolate Sea Level at step jit+0.5: 
    657             zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 
     793!$OMP PARALLEL  
     794!$OMP DO schedule(static) private(jj,ji) 
     795            DO jj = 1, jpj 
     796               DO ji = 1, jpi 
     797                  zsshp2_e(ji,jj) = za1 * sshn_e(ji,jj)  + za2 * sshb_e(ji,jj) + za3 * sshbb_e(ji,jj) 
     798               END DO 
     799            END DO 
    658800            ! 
     801!$OMP DO schedule(static) private(jj,ji) 
    659802            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points 
    660803               DO ji = 2, fs_jpim1   ! Vector opt. 
    … …  
    667810               END DO 
    668811            END DO 
     812!$OMP END PARALLEL 
    669813            CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 
    670814            ! 
    671             zhup2_e (:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points 
    672             zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 
     815!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     816            DO jj = 1, jpj 
     817               DO ji = 1, jpi 
     818                  zhup2_e (ji,jj) = hu_0(ji,jj) + zwx(ji,jj)                ! Ocean depth at U- and V-points 
     819                  zhvp2_e (ji,jj) = hv_0(ji,jj) + zwy(ji,jj) 
     820               END DO 
     821            END DO 
    673822         ELSE 
    674             zhup2_e (:,:) = hu_n(:,:) 
    675             zhvp2_e (:,:) = hv_n(:,:) 
     823!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     824            DO jj = 1, jpj 
     825               DO ji = 1, jpi 
     826                  zhup2_e (ji,jj) = hu_n(ji,jj) 
     827                  zhvp2_e (ji,jj) = hv_n(ji,jj) 
     828               END DO 
     829            END DO 
    676830         ENDIF 
    677831         !                                                !* after ssh 
    … …  
    680834         ! considering fluxes below: 
    681835         ! 
    682          zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5 
    683          zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 
     836!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     837         DO jj = 1, jpj 
     838            DO ji = 1, jpi 
     839               zwx(ji,jj) = e2u(ji,jj) * ua_e(ji,jj) * zhup2_e(ji,jj)         ! fluxes at jn+0.5 
     840               zwy(ji,jj) = e1v(ji,jj) * va_e(ji,jj) * zhvp2_e(ji,jj) 
     841            END DO 
     842         END DO 
     843 
    684844         ! 
    685845#if defined key_agrif 
    … …  
    712872         ! Sum over sub-time-steps to compute advective velocities 
    713873         za2 = wgtbtp2(jn) 
    714          un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 
    715          vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 
     874!$OMP PARALLEL 
     875!$OMP DO schedule(static) private(jj,ji) 
     876         DO jj = 1, jpj 
     877            DO ji = 1, jpi 
     878               un_adv(ji,jj) = un_adv(ji,jj) + za2 * zwx(ji,jj) * r1_e2u(ji,jj) 
     879               vn_adv(ji,jj) = vn_adv(ji,jj) + za2 * zwy(ji,jj) * r1_e1v(ji,jj) 
     880            END DO 
     881         END DO 
     882!$OMP END DO NOWAIT 
    716883         ! 
    717884         ! Set next sea level: 
     885!$OMP DO schedule(static) private(jj,ji) 
    718886         DO jj = 2, jpjm1                                  
    719887            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    722890            END DO 
    723891         END DO 
    724          ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:) 
    725           
     892!$OMP DO schedule(static) private(jj,ji) 
     893         DO jj = 1, jpj 
     894            DO ji = 1, jpi 
     895               ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv(ji,jj) )  ) * ssmask(ji,jj) 
     896            END DO 
     897         END DO 
     898!$OMP END PARALLEL 
    726899         CALL lbc_lnk( ssha_e, 'T',  1._wp ) 
    727900 
    … …  
    734907         ! Sea Surface Height at u-,v-points (vvl case only) 
    735908         IF( .NOT.ln_linssh ) THEN                                 
     909!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    736910            DO jj = 2, jpjm1 
    737911               DO ji = 2, jpim1      ! NO Vector Opt. 
    … …  
    766940         ENDIF 
    767941         ! 
    768          zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:) & 
    769           &            + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:) 
     942!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     943         DO jj = 1, jpj 
     944            DO ji = 1, jpi 
     945               zsshp2_e(ji,jj) = za0 *  ssha_e(ji,jj) + za1 *  sshn_e (ji,jj) & 
     946                &              + za2 *  sshb_e(ji,jj) + za3 *  sshbb_e(ji,jj) 
     947            END DO 
     948         END DO 
    770949         IF( ln_wd ) THEN                   ! Calculating and applying W/D gravity filters 
     950!$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 
    771951           DO jj = 2, jpjm1 
    772952              DO ji = 2, jpim1  
    … …  
    813993         IF( .NOT.ln_linssh  .AND. .NOT.ln_dynadv_vec ) THEN   !* Vector form 
    814994            !                                         
     995!$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 
    815996            DO jj = 2, jpjm1                             
    816997               DO ji = 2, jpim1 
    … …  
    8261007            END DO 
    8271008 
     1009            IF( ln_wd ) THEN 
     1010!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1011               DO jj = 1, jpj 
     1012                  DO ji = 1, jpi   ! vector opt. 
     1013                     zhust_e(ji,jj) = MAX(zhust_e (ji,jj), rn_wdmin1 ) 
     1014                     zhvst_e(ji,jj) = MAX(zhvst_e (ji,jj), rn_wdmin1 ) 
     1015                  END DO 
     1016               END DO 
     1017            END IF 
    8281018         ENDIF 
    8291019         ! 
    … …  
    8361026         ! 
    8371027         IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN     !==  energy conserving or mixed scheme  ==! 
     1028!$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 
    8381029            DO jj = 2, jpjm1 
    8391030               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    8481039            ! 
    8491040         ELSEIF ( ln_dynvor_ens ) THEN                   !==  enstrophy conserving scheme  ==! 
     1041!$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 
    8501042            DO jj = 2, jpjm1 
    8511043               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    8601052            ! 
    8611053         ELSEIF ( ln_dynvor_een ) THEN                   !==  energy and enstrophy conserving scheme  ==! 
     1054!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    8621055            DO jj = 2, jpjm1 
    8631056               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    8771070         ! Add tidal astronomical forcing if defined 
    8781071         IF ( ln_tide .AND. ln_tide_pot ) THEN 
     1072!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    8791073            DO jj = 2, jpjm1 
    8801074               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    8881082         ! 
    8891083         ! Add bottom stresses: 
    890          zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 
    891          zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
    892          ! 
    893          ! Add top stresses: 
    894          zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 
    895          zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
     1084!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1085         DO jj = 1, jpj 
     1086            DO ji = 1, jpi 
     1087               zu_trd(ji,jj) = zu_trd(ji,jj) + bfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
     1088               zv_trd(ji,jj) = zv_trd(ji,jj) + bfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
     1089               ! 
     1090               ! Add top stresses: 
     1091               zu_trd(ji,jj) = zu_trd(ji,jj) + tfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
     1092               zv_trd(ji,jj) = zv_trd(ji,jj) + tfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
     1093            END DO 
     1094         END DO 
     1095 
    8961096         ! 
    8971097         ! Surface pressure trend: 
    8981098 
    8991099         IF( ln_wd ) THEN 
     1100!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    9001101           DO jj = 2, jpjm1 
    9011102              DO ji = 2, jpim1  
    … …  
    9081109           END DO 
    9091110         ELSE 
     1111!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    9101112           DO jj = 2, jpjm1 
    9111113              DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    9221124         ! Set next velocities: 
    9231125         IF( ln_dynadv_vec .OR. ln_linssh ) THEN   !* Vector form 
     1126!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    9241127            DO jj = 2, jpjm1 
    9251128               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    9391142            ! 
    9401143         ELSE                                      !* Flux form 
     1144!$OMP PARALLEL DO schedule(static) private(jj,ji,zhura,zhvra) 
    9411145            DO jj = 2, jpjm1 
    9421146               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    9691173         IF( .NOT.ln_linssh ) THEN                     !* Update ocean depth (variable volume case only) 
    9701174            IF( ln_wd ) THEN 
    971               hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1) 
    972               hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1) 
     1175!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1176               DO jj = 1, jpj 
     1177                  DO ji = 1, jpi   ! vector opt. 
     1178                     hu_e (ji,jj) = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1) 
     1179                     hv_e (ji,jj) = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1) 
     1180                  END DO 
     1181               END DO 
    9731182            ELSE 
    974               hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 
    975               hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 
     1183!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1184               DO jj = 1, jpj 
     1185                  DO ji = 1, jpi 
     1186                     hu_e (ji,jj) = hu_0(ji,jj) + zsshu_a(ji,jj) 
     1187                     hv_e (ji,jj) = hv_0(ji,jj) + zsshv_a(ji,jj) 
     1188                  END DO 
     1189               END DO 
    9761190            END IF 
    977             hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 
    978             hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 
     1191!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1192            DO jj = 1, jpj 
     1193               DO ji = 1, jpi 
     1194                  hur_e(ji,jj) = ssumask(ji,jj) / ( hu_e(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     1195                  hvr_e(ji,jj) = ssvmask(ji,jj) / ( hv_e(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     1196               END DO 
     1197            END DO 
    9791198            ! 
    9801199         ENDIF 
    … …  
    9891208         !                                             !* Swap 
    9901209         !                                             !  ---- 
    991          ubb_e  (:,:) = ub_e  (:,:) 
    992          ub_e   (:,:) = un_e  (:,:) 
    993          un_e   (:,:) = ua_e  (:,:) 
    994          ! 
    995          vbb_e  (:,:) = vb_e  (:,:) 
    996          vb_e   (:,:) = vn_e  (:,:) 
    997          vn_e   (:,:) = va_e  (:,:) 
    998          ! 
    999          sshbb_e(:,:) = sshb_e(:,:) 
    1000          sshb_e (:,:) = sshn_e(:,:) 
    1001          sshn_e (:,:) = ssha_e(:,:) 
     1210!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1211         DO jj = 1, jpj 
     1212            DO ji = 1, jpi 
     1213               ubb_e  (ji,jj) = ub_e  (ji,jj) 
     1214               ub_e   (ji,jj) = un_e  (ji,jj) 
     1215               un_e   (ji,jj) = ua_e  (ji,jj) 
     1216               ! 
     1217               vbb_e  (ji,jj) = vb_e  (ji,jj) 
     1218               vb_e   (ji,jj) = vn_e  (ji,jj) 
     1219               vn_e   (ji,jj) = va_e  (ji,jj) 
     1220               ! 
     1221               sshbb_e(ji,jj) = sshb_e(ji,jj) 
     1222               sshb_e (ji,jj) = sshn_e(ji,jj) 
     1223               sshn_e (ji,jj) = ssha_e(ji,jj) 
     1224            END DO 
     1225         END DO 
    10021226 
    10031227         !                                             !* Sum over whole bt loop 
    … …  
    10051229         za1 = wgtbtp1(jn)                                     
    10061230         IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities 
    1007             ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:)  
    1008             va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:)  
     1231!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1232            DO jj = 1, jpj 
     1233               DO ji = 1, jpi 
     1234                  ua_b  (ji,jj) = ua_b  (ji,jj) + za1 * ua_e  (ji,jj) 
     1235                  va_b  (ji,jj) = va_b  (ji,jj) + za1 * va_e  (ji,jj) 
     1236               END DO 
     1237            END DO 
    10091238         ELSE                                              ! Sum transports 
    1010             ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) 
    1011             va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) 
     1239!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1240            DO jj = 1, jpj 
     1241               DO ji = 1, jpi 
     1242                  ua_b  (ji,jj) = ua_b  (ji,jj) + za1 * ua_e  (ji,jj) * hu_e (ji,jj) 
     1243                  va_b  (ji,jj) = va_b  (ji,jj) + za1 * va_e  (ji,jj) * hv_e (ji,jj) 
     1244               END DO 
     1245            END DO 
    10121246         ENDIF 
    10131247         !                                   ! Sum sea level 
    1014          ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 
     1248!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1249         DO jj = 1, jpj 
     1250            DO ji = 1, jpi 
     1251               ssha(ji,jj) = ssha(ji,jj) + za1 * ssha_e(ji,jj) 
     1252            END DO 
     1253         END DO 
    10151254         !                                                 ! ==================== ! 
    10161255      END DO                                               !        end loop      ! 
    … …  
    10211260      ! 
    10221261      ! Set advection velocity correction: 
    1023       zwx(:,:) = un_adv(:,:) 
    1024       zwy(:,:) = vn_adv(:,:) 
     1262!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1263      DO jj = 1, jpj 
     1264         DO ji = 1, jpi 
     1265            zwx(ji,jj) = un_adv(ji,jj) 
     1266            zwy(ji,jj) = vn_adv(ji,jj) 
     1267         END DO 
     1268      END DO 
    10251269      IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN      
    1026          un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 
    1027          vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 
     1270!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1271         DO jj = 1, jpj 
     1272            DO ji = 1, jpi 
     1273               un_adv(ji,jj) = zwx(ji,jj) * r1_hu_n(ji,jj) 
     1274               vn_adv(ji,jj) = zwy(ji,jj) * r1_hv_n(ji,jj) 
     1275            END DO 
     1276         END DO 
    10281277      ELSE 
    1029          un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 
    1030          vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 
     1278!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1279         DO jj = 1, jpj 
     1280            DO ji = 1, jpi 
     1281               un_adv(ji,jj) = z1_2 * ( ub2_b(ji,jj) + zwx(ji,jj) ) * r1_hu_n(ji,jj) 
     1282               vn_adv(ji,jj) = z1_2 * ( vb2_b(ji,jj) + zwy(ji,jj) ) * r1_hv_n(ji,jj) 
     1283            END DO 
     1284         END DO 
    10311285      END IF 
    10321286 
    10331287      IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 
    1034          ub2_b(:,:) = zwx(:,:) 
    1035          vb2_b(:,:) = zwy(:,:) 
     1288!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1289         DO jj = 1, jpj 
     1290            DO ji = 1, jpi 
     1291               ub2_b(ji,jj) = zwx(ji,jj) 
     1292               vb2_b(ji,jj) = zwy(ji,jj) 
     1293            END DO 
     1294         END DO 
    10361295      ENDIF 
    10371296      ! 
    10381297      ! Update barotropic trend: 
    10391298      IF( ln_dynadv_vec .OR. ln_linssh ) THEN 
     1299!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    10401300         DO jk=1,jpkm1 
    1041             ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 
    1042             va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 
     1301            DO jj = 1, jpj 
     1302               DO ji = 1, jpi 
     1303                  ua(ji,jj,jk) = ua(ji,jj,jk) + ( ua_b(ji,jj) - ub_b(ji,jj) ) * z1_2dt_b 
     1304                  va(ji,jj,jk) = va(ji,jj,jk) + ( va_b(ji,jj) - vb_b(ji,jj) ) * z1_2dt_b 
     1305               END DO 
     1306            END DO 
    10431307         END DO 
    10441308      ELSE 
    10451309         ! At this stage, ssha has been corrected: compute new depths at velocity points 
     1310!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    10461311         DO jj = 1, jpjm1 
    10471312            DO ji = 1, jpim1      ! NO Vector Opt. 
    … …  
    10561321         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    10571322         ! 
     1323!$OMP PARALLEL 
     1324!$OMP DO schedule(static) private(jk,jj,ji) 
    10581325         DO jk=1,jpkm1 
    1059             ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 
    1060             va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 
    1061          END DO 
     1326            DO jj = 1, jpj 
     1327               DO ji = 1, jpi 
     1328                  ua(ji,jj,jk) = ua(ji,jj,jk) + r1_hu_n(ji,jj) * ( ua_b(ji,jj) - ub_b(ji,jj) * hu_b(ji,jj) ) * z1_2dt_b 
     1329                  va(ji,jj,jk) = va(ji,jj,jk) + r1_hv_n(ji,jj) * ( va_b(ji,jj) - vb_b(ji,jj) * hv_b(ji,jj) ) * z1_2dt_b 
     1330               END DO 
     1331            END DO 
     1332         END DO 
     1333!$OMP END DO NOWAIT 
    10621334         ! Save barotropic velocities not transport: 
    1063          ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 
    1064          va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    1065       ENDIF 
    1066       ! 
     1335!$OMP DO schedule(static) private(jj,ji) 
     1336         DO jj = 1, jpj 
     1337            DO ji = 1, jpi 
     1338               ua_b(ji,jj) =  ua_b(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     1339               va_b(ji,jj) =  va_b(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     1340            END DO 
     1341         END DO 
     1342!$OMP END PARALLEL 
     1343      ENDIF 
     1344      ! 
     1345!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    10671346      DO jk = 1, jpkm1 
    1068          ! Correct velocities: 
    1069          un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 
    1070          vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 
    1071          ! 
     1347         DO jj = 1, jpj 
     1348            DO ji = 1, jpi 
     1349               ! Correct velocities: 
     1350               un(ji,jj,jk) = ( un(ji,jj,jk) + un_adv(ji,jj) - un_b(ji,jj) ) * umask(ji,jj,jk) 
     1351               vn(ji,jj,jk) = ( vn(ji,jj,jk) + vn_adv(ji,jj) - vn_b(ji,jj) ) * vmask(ji,jj,jk) 
     1352               ! 
     1353            END DO 
     1354         END DO 
    10721355      END DO 
    10731356      ! 
    … …  
    10811364      IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 
    10821365         IF( Agrif_NbStepint() == 0 ) THEN 
    1083             ub2_i_b(:,:) = 0._wp 
    1084             vb2_i_b(:,:) = 0._wp 
     1366!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1367            DO jj = 1, jpj 
     1368               DO ji = 1, jpi 
     1369                  ub2_i_b(ji,jj) = 0._wp 
     1370                  vb2_i_b(ji,jj) = 0._wp 
     1371               END DO 
     1372            END DO 
    10851373         END IF 
    10861374         ! 
    10871375         za1 = 1._wp / REAL(Agrif_rhot(), wp) 
    1088          ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 
    1089          vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 
     1376!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1377         DO jj = 1, jpj 
     1378            DO ji = 1, jpi 
     1379               ub2_i_b(ji,jj) = ub2_i_b(ji,jj) + za1 * ub2_b(ji,jj) 
     1380               vb2_i_b(ji,jj) = vb2_i_b(ji,jj) + za1 * vb2_b(ji,jj) 
     1381            END DO 
     1382         END DO 
    10901383      ENDIF 
    10911384#endif       

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

    r7646 r7698  
    9797      !!---------------------------------------------------------------------- 
    9898      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     99      INTEGER ::   jk, jj, ji 
    99100      ! 
    100101      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    … …  
    109110      CASE ( np_ENE )                                 !* energy conserving scheme 
    110111         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    111             ztrdu(:,:,:) = ua(:,:,:) 
    112             ztrdv(:,:,:) = va(:,:,:) 
     112!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     113            DO jk = 1, jpk 
     114               DO jj = 1, jpj 
     115                  DO ji = 1, jpi 
     116                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     117                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     118                  END DO 
     119               END DO 
     120            END DO 
    113121            CALL vor_ene( kt, nrvm, un , vn , ua, va )                    ! relative vorticity or metric trend 
    114             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    115             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     122!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     123            DO jk = 1, jpk 
     124               DO jj = 1, jpj 
     125                  DO ji = 1, jpi 
     126                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     127                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     128                  END DO 
     129               END DO 
     130            END DO 
    116131            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    117             ztrdu(:,:,:) = ua(:,:,:) 
    118             ztrdv(:,:,:) = va(:,:,:) 
     132!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     133            DO jk = 1, jpk 
     134               DO jj = 1, jpj 
     135                  DO ji = 1, jpi 
     136                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     137                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     138                  END DO 
     139               END DO 
     140            END DO 
    119141            CALL vor_ene( kt, ncor, un , vn , ua, va )                    ! planetary vorticity trend 
    120             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    121             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     142!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     143            DO jk = 1, jpk 
     144               DO jj = 1, jpj 
     145                  DO ji = 1, jpi 
     146                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     147                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     148                  END DO 
     149               END DO 
     150            END DO 
    122151            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    123152         ELSE                                               ! total vorticity trend 
    … …  
    128157      CASE ( np_ENS )                                 !* enstrophy conserving scheme 
    129158         IF( l_trddyn ) THEN                                ! trend diagnostics: splitthe trend in two     
    130             ztrdu(:,:,:) = ua(:,:,:) 
    131             ztrdv(:,:,:) = va(:,:,:) 
     159!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     160            DO jk = 1, jpk 
     161               DO jj = 1, jpj 
     162                  DO ji = 1, jpi 
     163                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     164                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     165                  END DO 
     166               END DO 
     167            END DO 
    132168            CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend 
    133             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    134             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     169!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     170            DO jk = 1, jpk 
     171               DO jj = 1, jpj 
     172                  DO ji = 1, jpi 
     173                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     174                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     175                  END DO 
     176               END DO 
     177            END DO 
    135178            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    136             ztrdu(:,:,:) = ua(:,:,:) 
    137             ztrdv(:,:,:) = va(:,:,:) 
     179!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     180            DO jk = 1, jpk 
     181               DO jj = 1, jpj 
     182                  DO ji = 1, jpi 
     183                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     184                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     185                  END DO 
     186               END DO 
     187            END DO 
    138188            CALL vor_ens( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend 
    139             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    140             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     189!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     190            DO jk = 1, jpk 
     191               DO jj = 1, jpj 
     192                  DO ji = 1, jpi 
     193                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     194                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     195                  END DO 
     196               END DO 
     197            END DO 
    141198            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    142199         ELSE                                               ! total vorticity trend 
    … …  
    147204      CASE ( np_MIX )                                 !* mixed ene-ens scheme 
    148205         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    149             ztrdu(:,:,:) = ua(:,:,:) 
    150             ztrdv(:,:,:) = va(:,:,:) 
     206!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     207            DO jk = 1, jpk 
     208               DO jj = 1, jpj 
     209                  DO ji = 1, jpi 
     210                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     211                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     212                  END DO 
     213               END DO 
     214            END DO 
    151215            CALL vor_ens( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend (ens) 
    152             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    153             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     216!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     217            DO jk = 1, jpk 
     218               DO jj = 1, jpj 
     219                  DO ji = 1, jpi 
     220                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     221                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     222                  END DO 
     223               END DO 
     224            END DO 
    154225            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    155             ztrdu(:,:,:) = ua(:,:,:) 
    156             ztrdv(:,:,:) = va(:,:,:) 
     226!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     227            DO jk = 1, jpk 
     228               DO jj = 1, jpj 
     229                  DO ji = 1, jpi 
     230                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     231                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     232                  END DO 
     233               END DO 
     234            END DO 
    157235            CALL vor_ene( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend (ene) 
    158             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    159             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     236!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     237            DO jk = 1, jpk 
     238               DO jj = 1, jpj 
     239                  DO ji = 1, jpi 
     240                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     241                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     242                  END DO 
     243               END DO 
     244            END DO 
    160245            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    161246         ELSE                                               ! total vorticity trend 
    … …  
    167252      CASE ( np_EEN )                                 !* energy and enstrophy conserving scheme 
    168253         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
    169             ztrdu(:,:,:) = ua(:,:,:) 
    170             ztrdv(:,:,:) = va(:,:,:) 
     254!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     255            DO jk = 1, jpk 
     256               DO jj = 1, jpj 
     257                  DO ji = 1, jpi 
     258                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     259                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     260                  END DO 
     261               END DO 
     262            END DO 
    171263            CALL vor_een( kt, nrvm, un , vn , ua, va )            ! relative vorticity or metric trend 
    172             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    173             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     264!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     265            DO jk = 1, jpk 
     266               DO jj = 1, jpj 
     267                  DO ji = 1, jpi 
     268                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     269                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     270                  END DO 
     271               END DO 
     272            END DO 
    174273            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    175             ztrdu(:,:,:) = ua(:,:,:) 
    176             ztrdv(:,:,:) = va(:,:,:) 
     274!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     275            DO jk = 1, jpk 
     276               DO jj = 1, jpj 
     277                  DO ji = 1, jpi 
     278                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     279                     ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     280                  END DO 
     281               END DO 
     282            END DO 
    177283            CALL vor_een( kt, ncor, un , vn , ua, va )            ! planetary vorticity trend 
    178             ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    179             ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     284!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     285            DO jk = 1, jpk 
     286               DO jj = 1, jpj 
     287                  DO ji = 1, jpi 
     288                     ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     289                     ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     290                  END DO 
     291               END DO 
     292            END DO 
    180293            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    181294         ELSE                                               ! total vorticity trend 
    … …  
    244357         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    245358         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    246             zwz(:,:) = ff_f(:,:)  
     359!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     360            DO jj = 1, jpj 
     361               DO ji = 1, jpi 
     362                  zwz(ji,jj) = ff_f(ji,jj) 
     363               END DO 
     364            END DO  
    247365         CASE ( np_RVO )                           !* relative vorticity 
     366!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    248367            DO jj = 1, jpjm1 
    249368               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    253372            END DO 
    254373         CASE ( np_MET )                           !* metric term 
     374!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    255375            DO jj = 1, jpjm1 
    256376               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    261381            END DO 
    262382         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
     383!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    263384            DO jj = 1, jpjm1 
    264385               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    269390            END DO 
    270391         CASE ( np_CME )                           !* Coriolis + metric 
     392!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    271393            DO jj = 1, jpjm1 
    272394               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    282404         ! 
    283405         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
     406!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    284407            DO jj = 1, jpjm1 
    285408               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    290413 
    291414         IF( ln_sco ) THEN 
    292             zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 
    293             zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 
    294             zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 
     415!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     416            DO jj = 1, jpj 
     417               DO ji = 1, jpi 
     418                  zwz(ji,jj) = zwz(ji,jj) / e3f_n(ji,jj,jk) 
     419                  zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 
     420                  zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 
     421               END DO 
     422            END DO 
    295423         ELSE 
    296             zwx(:,:) = e2u(:,:) * pun(:,:,jk) 
    297             zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 
     424!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     425            DO jj = 1, jpj 
     426               DO ji = 1, jpi 
     427                  zwx(ji,jj) = e2u(ji,jj) * pun(ji,jj,jk) 
     428                  zwy(ji,jj) = e1v(ji,jj) * pvn(ji,jj,jk) 
     429               END DO 
     430            END DO 
    298431         ENDIF 
    299432         !                                   !==  compute and add the vorticity term trend  =! 
     433!$OMP PARALLEL DO schedule(static) private(jj, ji, zy1, zy2, zx1, zx2) 
    300434         DO jj = 2, jpjm1 
    301435            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    487621         SELECT CASE( nn_een_e3f )           ! == reciprocal of e3 at F-point 
    488622         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     623!$OMP PARALLEL DO schedule(static) private(jj,ji,ze3) 
    489624            DO jj = 1, jpjm1 
    490625               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    497632            END DO 
    498633         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     634!$OMP PARALLEL DO schedule(static) private(jj,ji,ze3,zmsk) 
    499635            DO jj = 1, jpjm1 
    500636               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    512648         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    513649         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
     650!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    514651            DO jj = 1, jpjm1 
    515652               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    518655            END DO 
    519656         CASE ( np_RVO )                           !* relative vorticity 
     657!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    520658            DO jj = 1, jpjm1 
    521659               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    526664            END DO 
    527665         CASE ( np_MET )                           !* metric term 
     666!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    528667            DO jj = 1, jpjm1 
    529668               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    534673            END DO 
    535674         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
     675!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    536676            DO jj = 1, jpjm1 
    537677               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    542682            END DO 
    543683         CASE ( np_CME )                           !* Coriolis + metric 
     684!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    544685            DO jj = 1, jpjm1 
    545686               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    555696         ! 
    556697         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
     698!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    557699            DO jj = 1, jpjm1 
    558700               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    565707         ! 
    566708         !                                   !==  horizontal fluxes  ==! 
    567          zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 
    568          zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 
     709!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     710         DO jj = 1, jpj 
     711            DO ji = 1, jpi 
     712               zwx(ji,jj) = e2u(ji,jj) * e3u_n(ji,jj,jk) * pun(ji,jj,jk) 
     713               zwy(ji,jj) = e1v(ji,jj) * e3v_n(ji,jj,jk) * pvn(ji,jj,jk) 
     714            END DO 
     715         END DO 
    569716 
    570717         !                                   !==  compute and add the vorticity term trend  =! 
    571718         jj = 2 
    572719         ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
     720 
    573721         DO ji = 2, jpi          ! split in 2 parts due to vector opt. 
    574722               ztne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
    … …  
    577725               ztsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
    578726         END DO 
     727!$OMP PARALLEL 
     728!$OMP DO schedule(static) private(jj,ji) 
    579729         DO jj = 3, jpj 
    580730            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3 
    … …  
    585735            END DO 
    586736         END DO 
     737!$OMP DO schedule(static) private(jj,ji,zua,zva) 
    587738         DO jj = 2, jpjm1 
    588739            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    595746            END DO   
    596747         END DO   
     748!$OMP END PARALLEL  
    597749         !                                             ! =============== 
    598750      END DO                                           !   End of slab 
    … …  
    649801      IF(lwp) WRITE(numout,*) '      change fmask value in the angles (T)           ln_vorlat = ', ln_vorlat 
    650802      IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 
     803!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    651804         DO jk = 1, jpk 
    652805            DO jj = 2, jpjm1 

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

    r6140 r7698  
    7777      IF( l_trddyn )   THEN         ! Save ua and va trends 
    7878         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
    79          ztrdu(:,:,:) = ua(:,:,:)  
    80          ztrdv(:,:,:) = va(:,:,:)  
     79!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     80        DO jk = 1, jpk 
     81           DO jj = 1, jpj 
     82              DO ji = 1, jpi 
     83                 ztrdu(ji,jj,jk) = ua(ji,jj,jk) 
     84                 ztrdv(ji,jj,jk) = va(ji,jj,jk) 
     85              END DO 
     86           END DO 
     87        END DO 
    8188      ENDIF 
    8289       
     90!$OMP PARALLEL 
    8391      DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical 
     92!$OMP DO schedule(static) private(jj, ji) 
    8493         DO jj = 2, jpj                   ! vertical fluxes  
    8594            DO ji = fs_2, jpi             ! vector opt. 
    … …  
    8796            END DO 
    8897         END DO 
     98!$OMP DO schedule(static) private(jj, ji) 
    8999         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point 
    90100            DO ji = fs_2, fs_jpim1        ! vector opt. 
    … …  
    94104         END DO    
    95105      END DO 
     106!$OMP END PARALLEL 
    96107      ! 
    97108      ! Surface and bottom advective fluxes set to zero 
    98109      IF ( ln_isfcav ) THEN 
     110!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    99111         DO jj = 2, jpjm1 
    100112            DO ji = fs_2, fs_jpim1           ! vector opt. 
    … …  
    106118         END DO 
    107119      ELSE 
     120!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    108121         DO jj = 2, jpjm1         
    109122            DO ji = fs_2, fs_jpim1           ! vector opt. 
    … …  
    116129      END IF 
    117130 
     131!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zua, zva) 
    118132      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points 
    119133         DO jj = 2, jpjm1 
    … …  
    130144 
    131145      IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
    132          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    133          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     146!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     147           DO jk = 1, jpk 
     148              DO jj = 1, jpj 
     149                 DO ji = 1, jpi 
     150                    ztrdu(ji,jj,jk) = ua(ji,jj,jk) - ztrdu(ji,jj,jk) 
     151                    ztrdv(ji,jj,jk) = va(ji,jj,jk) - ztrdv(ji,jj,jk) 
     152                 END DO 
     153              END DO 
     154           END DO 
    134155         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    135156         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  

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

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

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

    r6752 r7698  
    9292      ! 
    9393      IF( ln_dynadv_vec .OR. ln_linssh ) THEN      ! applied on velocity 
     94!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    9495         DO jk = 1, jpkm1 
    95             ua(:,:,jk) = ( ub(:,:,jk) + p2dt * ua(:,:,jk) ) * umask(:,:,jk) 
    96             va(:,:,jk) = ( vb(:,:,jk) + p2dt * va(:,:,jk) ) * vmask(:,:,jk) 
     96            DO jj = 1, jpj 
     97               DO ji = 1, jpi 
     98                  ua(ji,jj,jk) = ( ub(ji,jj,jk) + p2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk) 
     99                  va(ji,jj,jk) = ( vb(ji,jj,jk) + p2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk) 
     100               END DO 
     101            END DO 
    97102         END DO 
    98103      ELSE                                         ! applied on thickness weighted velocity 
     104!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    99105         DO jk = 1, jpkm1 
    100             ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  & 
    101                &          + p2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
    102             va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  & 
    103                &          + p2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
     106            DO jj = 1, jpj 
     107               DO ji = 1, jpi 
     108                  ua(ji,jj,jk) = (         e3u_b(ji,jj,jk) * ub(ji,jj,jk)  & 
     109                     &          + p2dt * e3u_n(ji,jj,jk) * ua(ji,jj,jk)  ) / e3u_a(ji,jj,jk) * umask(ji,jj,jk) 
     110                  va(ji,jj,jk) = (         e3v_b(ji,jj,jk) * vb(ji,jj,jk)  & 
     111                     &          + p2dt * e3v_n(ji,jj,jk) * va(ji,jj,jk)  ) / e3v_a(ji,jj,jk) * vmask(ji,jj,jk) 
     112               END DO 
     113            END DO 
    104114         END DO 
    105115      ENDIF 
    … …  
    112122      ! 
    113123      IF( ln_bfrimp ) THEN 
     124!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    114125         DO jj = 2, jpjm1 
    115126            DO ji = 2, jpim1 
    … …  
    121132         END DO 
    122133         IF ( ln_isfcav ) THEN 
     134!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    123135            DO jj = 2, jpjm1 
    124136               DO ji = 2, jpim1 
    … …  
    138150      ! G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 
    139151      IF( ln_bfrimp .AND. ln_dynspg_ts ) THEN 
     152!$OMP PARALLEL 
     153!$OMP DO schedule(static) private(jk,jj,ji) 
    140154         DO jk = 1, jpkm1        ! remove barotropic velocities 
    141             ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 
    142             va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 
    143          END DO 
     155            DO jj = 1, jpj 
     156               DO ji = 1, jpi 
     157                  ua(ji,jj,jk) = ( ua(ji,jj,jk) - ua_b(ji,jj) ) * umask(ji,jj,jk) 
     158                  va(ji,jj,jk) = ( va(ji,jj,jk) - va_b(ji,jj) ) * vmask(ji,jj,jk) 
     159               END DO 
     160            END DO 
     161         END DO 
     162!$OMP DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va) 
    144163         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only 
    145164            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    152171            END DO 
    153172         END DO 
     173!$OMP END DO NOWAIT 
     174!$OMP END PARALLEL 
    154175         IF( ln_isfcav ) THEN    ! Ocean cavities (ISF) 
     176!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv, ze3ua, ze3va) 
    155177            DO jj = 2, jpjm1         
    156178               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    172194      ! non zero value at the ocean bottom depending on the bottom friction used. 
    173195      ! 
     196!$OMP PARALLEL 
     197!$OMP DO schedule(static) private(jk, jj, ji, ze3ua, zzwi, zzws) 
    174198      DO jk = 1, jpkm1        ! Matrix 
    175199         DO jj = 2, jpjm1  
    … …  
    184208         END DO 
    185209      END DO 
     210!$OMP DO schedule(static) private(jj, ji) 
    186211      DO jj = 2, jpjm1        ! Surface boundary conditions 
    187212         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    207232      ! 
    208233      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
     234!$OMP DO schedule(static) private(jj, ji) 
    209235         DO jj = 2, jpjm1    
    210236            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    212238            END DO 
    213239         END DO 
    214       END DO 
    215       ! 
     240!$OMP END DO NOWAIT 
     241      END DO 
     242      ! 
     243!$OMP DO schedule(static) private(jj, ji, ze3ua) 
    216244      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    217245         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    222250      END DO 
    223251      DO jk = 2, jpkm1 
     252!$OMP DO schedule(static) private(jj, ji) 
    224253         DO jj = 2, jpjm1 
    225254            DO ji = fs_2, fs_jpim1 
    … …  
    229258      END DO 
    230259      ! 
     260!$OMP DO schedule(static) private(jj, ji) 
    231261      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==! 
    232262         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    235265      END DO 
    236266      DO jk = jpk-2, 1, -1 
     267!$OMP DO schedule(static) private(jj, ji) 
    237268         DO jj = 2, jpjm1 
    238269            DO ji = fs_2, fs_jpim1 
    … …  
    248279      ! non zero value at the ocean bottom depending on the bottom friction used 
    249280      ! 
     281!$OMP DO schedule(static) private(jk, jj, ji, ze3va, zzwi, zzws) 
    250282      DO jk = 1, jpkm1        ! Matrix 
    251283         DO jj = 2, jpjm1    
    … …  
    260292         END DO 
    261293      END DO 
     294!$OMP DO schedule(static) private(jj, ji) 
    262295      DO jj = 2, jpjm1        ! Surface boundary conditions 
    263296         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    283316      ! 
    284317      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
     318!$OMP DO schedule(static) private(jj, ji) 
    285319         DO jj = 2, jpjm1    
    286320            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    288322            END DO 
    289323         END DO 
    290       END DO 
    291       ! 
     324!$OMP END DO NOWAIT 
     325      END DO 
     326      ! 
     327!$OMP DO schedule(static) private(jj, ji, ze3va) 
    292328      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    293329         DO ji = fs_2, fs_jpim1   ! vector opt.           
    … …  
    298334      END DO 
    299335      DO jk = 2, jpkm1 
     336!$OMP DO schedule(static) private(jj, ji) 
    300337         DO jj = 2, jpjm1 
    301338            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    305342      END DO 
    306343      ! 
     344!$OMP DO schedule(static) private(jj, ji) 
    307345      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==! 
    308346         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    311349      END DO 
    312350      DO jk = jpk-2, 1, -1 
     351!$OMP DO schedule(static) private(jj, ji) 
    313352         DO jj = 2, jpjm1 
    314353            DO ji = fs_2, fs_jpim1 
    … …  
    316355            END DO 
    317356         END DO 
    318       END DO 
     357!$OMP END DO NOWAIT 
     358      END DO 
     359!$OMP END PARALLEL  
    319360       
    320361      ! J. Chanut: Lines below are useless ? 
    … …  
    322363      !!gm  I almost sure it is !!!! 
    323364      IF( ln_bfrimp ) THEN 
     365!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    324366        DO jj = 2, jpjm1 
    325367           DO ji = 2, jpim1 
    … …  
    331373        END DO 
    332374        IF (ln_isfcav) THEN 
     375!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    333376           DO jj = 2, jpjm1 
    334377              DO ji = 2, jpim1 

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

    r7646 r7698  
    7272      INTEGER, INTENT(in) ::   kt   ! time step 
    7373      !  
    74       INTEGER  ::   jk            ! dummy loop indice 
     74      INTEGER  ::   jk, jj, ji            ! dummy loop indice 
    7575      REAL(wp) ::   z2dt, zcoef   ! local scalars 
    7676      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace 
    … …  
    9595      !                                           !------------------------------! 
    9696      IF(ln_wd) THEN 
    97          CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 
    98       ENDIF 
    99  
    100       CALL div_hor( kt )                               ! Horizontal divergence 
    101       ! 
    102       zhdiv(:,:) = 0._wp 
     97        CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 
     98      END IF 
     99 
     100      CALL div_hor( kt )                              ! Horizontal divergence 
     101      ! 
     102!$OMP PARALLEL 
     103!$OMP DO schedule(static) private(jj, ji) 
     104      DO jj = 1, jpj 
     105         DO ji = 1, jpi 
     106            zhdiv(ji,jj) = 0._wp 
     107         END DO 
     108      END DO            
    103109      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    104         zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
     110!$OMP DO schedule(static) private(jj, ji) 
     111         DO jj = 1, jpj 
     112            DO ji = 1, jpi 
     113               zhdiv(ji,jj) = zhdiv(ji,jj) + e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) 
     114            END DO 
     115         END DO            
    105116      END DO 
    106117      !                                                ! Sea surface elevation time stepping 
    … …  
    108119      ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 
    109120      !  
    110       ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
    111  
     121!$OMP DO schedule(static) private(jj, ji) 
     122      DO jj = 1, jpj 
     123         DO ji = 1, jpi 
     124            ssha(ji,jj) = (  sshb(ji,jj) - z2dt * ( zcoef * ( emp_b(ji,jj) + emp(ji,jj) ) + zhdiv(ji,jj) )  ) * ssmask(ji,jj) 
     125         END DO 
     126      END DO            
     127!$OMP END PARALLEL 
    112128      IF ( .NOT.ln_dynspg_ts ) THEN 
    113129         ! These lines are not necessary with time splitting since 
    … …  
    125141      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN     ! Include the IAU weighted SSH increment 
    126142         CALL ssh_asm_inc( kt ) 
    127          ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
     143!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     144         DO jj = 1, jpj 
     145            DO ji = 1, jpi 
     146               ssha(ji,jj) = ssha(ji,jj) + z2dt * ssh_iau(ji,jj) 
     147            END DO 
     148         END DO            
    128149      ENDIF 
    129150#endif 
    … …  
    171192         IF(lwp) WRITE(numout,*) '~~~~~ ' 
    172193         ! 
    173          wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
     194!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     195         DO jj = 1, jpj 
     196            DO ji = 1, jpi 
     197               wn(ji,jj,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
     198            END DO 
     199         END DO            
    174200      ENDIF 
    175201      !                                           !------------------------------! 
    … …  
    181207      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases 
    182208         CALL wrk_alloc( jpi, jpj, jpk, zhdiv )  
     209!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    183210         ! 
    184211         DO jk = 1, jpkm1 
    … …  
    196223         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    197224            ! computation of w 
    198             wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    & 
    199                &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )     ) * tmask(:,:,jk) 
     225!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     226            DO jj = 1, jpj 
     227               DO ji = 1, jpi   ! vector opt. 
     228                  wn(ji,jj,jk) = wn(ji,jj,jk+1) - ( e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) + zhdiv(ji,jj,jk)    & 
     229                  &                         + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) )     ) * tmask(ji,jj,jk) 
     230               END DO 
     231            END DO 
    200232         END DO 
    201233         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 
    … …  
    203235      ELSE   ! z_star and linear free surface cases 
    204236         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    205             ! computation of w 
    206             wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 & 
    207                &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk) 
     237!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     238            DO jj = 1, jpj 
     239               DO ji = 1, jpi   ! vector opt. 
     240                  ! computation of w 
     241                  wn(ji,jj,jk) = wn(ji,jj,jk+1) - (  e3t_n(ji,jj,jk) * hdivn(ji,jj,jk)                 & 
     242                  &                         + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) )  ) * tmask(ji,jj,jk) 
     243                END DO 
     244            END DO 
    208245         END DO 
    209246      ENDIF 
    210247 
    211248      IF( ln_bdy ) THEN 
     249!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    212250         DO jk = 1, jpkm1 
    213             wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
     251            DO jj = 1, jpj 
     252               DO ji = 1, jpi 
     253                  wn(ji,jj,jk) = wn(ji,jj,jk) * bdytmask(ji,jj) 
     254               END DO 
     255            END DO 
    214256         END DO 
    215257      ENDIF 
    … …  
    241283      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    242284      ! 
     285      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    243286      REAL(wp) ::   zcoef   ! local scalar 
    244287      !!---------------------------------------------------------------------- 
    … …  
    254297      IF(  ( neuler == 0 .AND. kt == nit000 ) .OR.    & 
    255298         & ( ln_bt_fw    .AND. ln_dynspg_ts )      ) THEN  
    256          sshb(:,:) = sshn(:,:)                              ! before <-- now 
    257          sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now) 
     299!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     300         DO jj = 1, jpj 
     301            DO ji = 1, jpi 
     302               sshb(ji,jj) = sshn(ji,jj)                              ! before <-- now 
     303               sshn(ji,jj) = ssha(ji,jj)                              ! now    <-- after  (before already = now) 
     304            END DO 
     305         END DO            
    258306         ! 
    259307      ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==! 
    260308         !                                                  ! before <-- now filtered 
    261          sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 
     309!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     310         DO jj = 1, jpj 
     311            DO ji = 1, jpi 
     312               sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) ) 
     313            END DO 
     314         END DO            
    262315         IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed 
    263316            zcoef = atfp * rdt * r1_rau0 
    264             sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   & 
    265                &                             -    rnf_b(:,:) + rnf   (:,:)   & 
    266                &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:) 
     317!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     318            DO jj = 1, jpj 
     319               DO ji = 1, jpi 
     320                  sshb(ji,jj) = sshb(ji,jj) - zcoef * (     emp_b(ji,jj) - emp   (ji,jj)   & 
     321                  &                             -    rnf_b(ji,jj) + rnf   (ji,jj)   & 
     322                  &                             + fwfisf_b(ji,jj) - fwfisf(ji,jj)   ) * ssmask(ji,jj) 
     323               END DO 
     324            END DO            
    267325         ENDIF 
    268          sshn(:,:) = ssha(:,:)                              ! now <-- after 
     326!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     327         DO jj = 1, jpj 
     328            DO ji = 1, jpi 
     329               sshn(ji,jj) = ssha(ji,jj)                              ! now <-- after 
     330            END DO 
     331         END DO            
    269332      ENDIF 
    270333      ! 

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

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

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

    r7646 r7698  
    381381         ! 
    382382         ! WARNING ptab is defined only between nld and nle 
     383!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    383384         DO jk = 1, jpk 
    384385            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only) 
    … …  
    399400         !                                        !* Cyclic east-west 
    400401         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    401             ptab( 1 ,:,:) = ptab(jpim1,:,:) 
    402             ptab(jpi,:,:) = ptab(  2  ,:,:) 
     402!$OMP PARALLEL DO schedule(static) private(jk, jj) 
     403            DO jk = 1, jpk 
     404               DO jj = 1, jpj 
     405                  ptab( 1 ,jj,jk) = ptab(jpim1,jj,jk) 
     406                  ptab(jpi,jj,jk) = ptab(  2  ,jj,jk) 
     407               END DO 
     408            END DO 
    403409         ELSE                                     !* closed 
    404             IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point 
    405                                          ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north 
     410            IF( .NOT. cd_type == 'F' ) THEN 
     411!$OMP PARALLEL DO schedule(static) private(jk, jj) 
     412               DO jk = 1, jpk 
     413                  DO jj = 1, jpj 
     414                     ptab(     1       :jpreci,jj,jk) = zland    ! south except F-point 
     415                  END DO 
     416               END DO 
     417            END IF 
     418!$OMP PARALLEL DO schedule(static) private(jk, jj) 
     419            DO jk = 1, jpk 
     420               DO jj = 1, jpj 
     421                  ptab(nlci-jpreci+1:jpi   ,jj,jk) = zland    ! north 
     422               END DO 
     423            END DO 
    406424         ENDIF 
    407425                                          ! North-south cyclic 
    408426         IF ( nbondj == 2 .AND. jperio == 7 )    THEN !* cyclic north south only with no mpp split in latitude 
    409             ptab(:,1 , :) = ptab(:, jpjm1,:) 
    410             ptab(:,jpj,:) = ptab(:,     2,:) 
     427!$OMP PARALLEL DO schedule(static) private(jk, ji) 
     428            DO jk = 1, jpk 
     429               DO ji = 1, jpi 
     430                  ptab(ji,1 , jk) = ptab(ji, jpjm1,jk) 
     431                  ptab(ji,jpj,jk) = ptab(ji,     2,jk) 
     432               END DO 
     433            END DO 
    411434         ELSE   !                                   ! North-South boundaries (closed) 
    412             IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point 
    413                                          ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north 
     435            IF( .NOT. cd_type == 'F' )   THEN 
     436!$OMP PARALLEL DO schedule(static) private(jk, ji) 
     437               DO jk = 1, jpk 
     438                  DO ji = 1, jpi 
     439                     ptab(ji,     1       :jprecj,jk) = zland       ! south except F-point 
     440                  END DO 
     441               END DO 
     442            END IF 
     443!$OMP PARALLEL DO schedule(static) private(jk, ji) 
     444            DO jk = 1, jpk 
     445               DO ji = 1, jpi 
     446                  ptab(ji,nlcj-jprecj+1:jpj   ,jk) = zland       ! north 
     447               END DO 
     448            END DO 
    414449         ENDIF 
    415450         ! 
    … …  
    423458      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    424459         iihom = nlci-nreci 
    425          DO jl = 1, jpreci 
    426             zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 
    427             zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 
     460!$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 
     461         DO jk = 1, jpk 
     462            DO jj = 1, jpj 
     463               DO jl = 1, jpreci 
     464                  zt3ew(jj,jl,jk,1) = ptab(jpreci+jl,jj,jk) 
     465                  zt3we(jj,jl,jk,1) = ptab(iihom +jl,jj,jk) 
     466               END DO 
     467            END DO 
    428468         END DO 
    429469      END SELECT 
    … …  
    455495      SELECT CASE ( nbondi ) 
    456496      CASE ( -1 ) 
    457          DO jl = 1, jpreci 
    458             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    459          END DO 
    460       CASE ( 0 ) 
    461          DO jl = 1, jpreci 
    462             ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
    463             ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 
    464          END DO 
    465       CASE ( 1 ) 
    466          DO jl = 1, jpreci 
    467             ptab(jl      ,:,:) = zt3we(:,jl,:,2) 
     497!$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 
     498         DO jk = 1, jpk 
     499            DO jl = 1, jpreci 
     500               DO jj = 1, jpj 
     501                  ptab(iihom+jl,jj,jk) = zt3ew(jj,jl,jk,2) 
     502               END DO 
     503            END DO 
     504         END DO 
     505      CASE ( 0 ) 
     506!$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 
     507         DO jk = 1, jpk 
     508            DO jl = 1, jpreci 
     509               DO jj = 1, jpj 
     510                  ptab(jl      ,jj,jk) = zt3we(jj,jl,jk,2) 
     511                  ptab(iihom+jl,jj,jk) = zt3ew(jj,jl,jk,2) 
     512               END DO 
     513            END DO 
     514         END DO 
     515      CASE ( 1 ) 
     516!$OMP PARALLEL DO schedule(static) private(jk, jj, jl) 
     517         DO jk = 1, jpk 
     518            DO jl = 1, jpreci 
     519               DO jj = 1, jpj 
     520                  ptab(jl      ,jj,jk) = zt3we(jj,jl,jk,2) 
     521               END DO 
     522            END DO 
    468523         END DO 
    469524      END SELECT 
    … …  
    475530      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    476531         ijhom = nlcj-nrecj 
    477          DO jl = 1, jprecj 
    478             zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 
    479             zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 
     532!$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 
     533         DO jk = 1, jpk 
     534            DO jl = 1, jprecj 
     535               DO ji = 1, jpi 
     536                  zt3sn(ji,jl,jk,1) = ptab(ji,ijhom +jl,jk) 
     537                  zt3ns(ji,jl,jk,1) = ptab(ji,jprecj+jl,jk) 
     538               END DO 
     539            END DO 
    480540         END DO 
    481541      ENDIF 
    … …  
    507567      SELECT CASE ( nbondj ) 
    508568      CASE ( -1 ) 
    509          DO jl = 1, jprecj 
    510             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    511          END DO 
    512       CASE ( 0 ) 
    513          DO jl = 1, jprecj 
    514             ptab(:,jl      ,:) = zt3sn(:,jl,:,2) 
    515             ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 
    516          END DO 
    517       CASE ( 1 ) 
    518          DO jl = 1, jprecj 
    519             ptab(:,jl,:) = zt3sn(:,jl,:,2) 
     569!$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 
     570         DO jk = 1, jpk 
     571            DO jl = 1, jprecj 
     572               DO ji = 1, jpi 
     573                  ptab(ji,ijhom+jl,jk) = zt3ns(ji,jl,jk,2) 
     574               END DO 
     575            END DO 
     576         END DO 
     577      CASE ( 0 ) 
     578!$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 
     579         DO jk = 1, jpk 
     580            DO jl = 1, jprecj 
     581               DO ji = 1, jpi 
     582                  ptab(ji,jl      ,jk) = zt3sn(ji,jl,jk,2) 
     583                  ptab(ji,ijhom+jl,jk) = zt3ns(ji,jl,jk,2) 
     584               END DO 
     585            END DO 
     586         END DO 
     587      CASE ( 1 ) 
     588!$OMP PARALLEL DO schedule(static) private(jk, ji, jl) 
     589         DO jk = 1, jpk 
     590            DO jl = 1, jprecj 
     591               DO ji = 1, jpi 
     592                  ptab(ji,jl,jk) = zt3sn(ji,jl,jk,2) 
     593               END DO 
     594            END DO 
    520595         END DO 
    521596      END SELECT 
    … …  
    917992      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    918993         iihom = nlci-nreci 
    919          DO jl = 1, jpreci 
    920             zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 
    921             zt2we(:,jl,1) = pt2d(iihom +jl,:) 
     994!$OMP PARALLEL DO schedule(static) private(jj,jl) 
     995         DO jj = 1, jpj 
     996            DO jl = 1, jpreci 
     997               zt2ew(jj,jl,1) = pt2d(jpreci+jl,jj) 
     998               zt2we(jj,jl,1) = pt2d(iihom +jl,jj) 
     999            END DO 
    9221000         END DO 
    9231001      END SELECT 
    … …  
    9491027      SELECT CASE ( nbondi ) 
    9501028      CASE ( -1 ) 
     1029!$OMP PARALLEL DO schedule(static) private(jj,jl) 
    9511030         DO jl = 1, jpreci 
    952             pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
    953          END DO 
    954       CASE ( 0 ) 
     1031            DO jj = 1, jpj 
     1032               pt2d(iihom+jl,jj) = zt2ew(jj,jl,2) 
     1033            END DO 
     1034         END DO 
     1035      CASE ( 0 ) 
     1036!$OMP PARALLEL DO schedule(static) private(jj,jl) 
    9551037         DO jl = 1, jpreci 
    956             pt2d(jl      ,:) = zt2we(:,jl,2) 
    957             pt2d(iihom+jl,:) = zt2ew(:,jl,2) 
    958          END DO 
    959       CASE ( 1 ) 
     1038            DO jj = 1, jpj 
     1039               pt2d(jl      ,jj) = zt2we(jj,jl,2) 
     1040               pt2d(iihom+jl,jj) = zt2ew(jj,jl,2) 
     1041            END DO 
     1042         END DO 
     1043      CASE ( 1 ) 
     1044!$OMP PARALLEL DO schedule(static) private(jj,jl) 
    9601045         DO jl = 1, jpreci 
    961             pt2d(jl      ,:) = zt2we(:,jl,2) 
     1046            DO jj = 1, jpj 
     1047               pt2d(jl      ,jj) = zt2we(jj,jl,2) 
     1048            END DO 
    9621049         END DO 
    9631050      END SELECT 
    … …  
    9701057      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    9711058         ijhom = nlcj-nrecj 
     1059!$OMP PARALLEL DO schedule(static) private(ji,jl) 
    9721060         DO jl = 1, jprecj 
    973             zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 
    974             zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 
     1061            DO ji = 1, jpi 
     1062               zt2sn(ji,jl,1) = pt2d(ji,ijhom +jl) 
     1063               zt2ns(ji,jl,1) = pt2d(ji,jprecj+jl) 
     1064            END DO 
    9751065         END DO 
    9761066      ENDIF 
    … …  
    10021092      SELECT CASE ( nbondj ) 
    10031093      CASE ( -1 ) 
     1094!$OMP PARALLEL DO schedule(static) private(ji,jl) 
    10041095         DO jl = 1, jprecj 
    1005             pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    1006          END DO 
    1007       CASE ( 0 ) 
     1096            DO ji = 1, jpi 
     1097               pt2d(ji,ijhom+jl) = zt2ns(ji,jl,2) 
     1098            END DO 
     1099         END DO 
     1100      CASE ( 0 ) 
     1101!$OMP PARALLEL DO schedule(static) private(ji,jl) 
    10081102         DO jl = 1, jprecj 
    1009             pt2d(:,jl      ) = zt2sn(:,jl,2) 
    1010             pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 
    1011          END DO 
    1012       CASE ( 1 ) 
     1103            DO ji = 1, jpi 
     1104               pt2d(ji,jl      ) = zt2sn(ji,jl,2) 
     1105               pt2d(ji,ijhom+jl) = zt2ns(ji,jl,2) 
     1106            END DO 
     1107         END DO 
     1108      CASE ( 1 ) 
     1109!$OMP PARALLEL DO schedule(static) private(ji,jl) 
    10131110         DO jl = 1, jprecj 
    1014             pt2d(:,jl      ) = zt2sn(:,jl,2) 
     1111            DO ji = 1, jpi 
     1112               pt2d(ji,jl      ) = zt2sn(ji,jl,2) 
     1113            END DO 
    10151114         END DO 
    10161115      END SELECT 

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

    r7646 r7698  
    148148            IF(lwp) WRITE(numout,*) '              momentum laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 
    149149            za00 = pah0 / zd_max 
     150!$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    150151            DO jj = 1, jpj  
    151152               DO ji = 1, jpi  
    … …  
    159160            IF(lwp) WRITE(numout,*) '              momentum bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 
    160161            za00 = pah0 / ( zd_max * zd_max * zd_max ) 
     162!$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    161163            DO jj = 1, jpj 
    162164               DO ji = 1, jpi 
    … …  
    171173         ENDIF 
    172174         !                                !  deeper values  (LAP and BLP cases) 
     175!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    173176         DO jk = 2, jpk 
    174             pah1(:,:,jk) = pah1(:,:,1) * tmask(:,:,jk)  
    175             pah2(:,:,jk) = pah2(:,:,1) * fmask(:,:,jk)  
     177            DO jj = 1, jpj 
     178               DO ji = 1, jpi 
     179                  pah1(ji,jj,jk) = pah1(ji,jj,1) * tmask(ji,jj,jk)  
     180                  pah2(ji,jj,jk) = pah2(ji,jj,1) * fmask(ji,jj,jk)  
     181               END DO 
     182            END DO 
    176183         END DO 
    177184         ! 
    … …  
    180187            IF(lwp) WRITE(numout,*) '              tracer laplacian coeffcients = rn_aht0/e_equ * max(e1,e2)' 
    181188            za00 = pah0 / zd_max 
     189!$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    182190            DO jj = 1, jpj  
    183191               DO ji = 1, jpi  
    … …  
    191199            IF(lwp) WRITE(numout,*) '              tracer bilaplacian coeffcients = rn_bht0/e_equ * max(e1,e2)**3' 
    192200            za00 = pah0 / ( zd_max * zd_max * zd_max ) 
     201!$OMP PARALLEL DO schedule(static) private(jj,ji,zemax1,zemax2) 
    193202            DO jj = 1, jpj 
    194203               DO ji = 1, jpi 
    … …  
    203212         ENDIF 
    204213         !                                !  deeper values  (LAP and BLP cases) 
     214!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    205215         DO jk = 2, jpk 
    206             pah1(:,:,jk) = pah1(:,:,1) * umask(:,:,jk)  
    207             pah2(:,:,jk) = pah2(:,:,1) * vmask(:,:,jk)  
     216            DO jj = 1, jpj 
     217               DO ji = 1, jpi 
     218                  pah1(ji,jj,jk) = pah1(ji,jj,1) * umask(ji,jj,jk)  
     219                  pah2(ji,jj,jk) = pah2(ji,jj,1) * vmask(ji,jj,jk)  
     220               END DO 
     221            END DO 
    208222         END DO 
    209223         ! 

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

    r7646 r7698  
    155155      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 
    156156      ! 
    157       ahmt(:,:,jpk) = 0._wp                           ! last level always 0   
    158       ahmf(:,:,jpk) = 0._wp 
     157!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     158      DO jj = 1, jpj 
     159         DO ji = 1, jpi 
     160            ahmt(ji,jj,jpk) = 0._wp                           ! last level always 0   
     161            ahmf(ji,jj,jpk) = 0._wp 
     162         END DO 
     163      END DO 
    159164      ! 
    160165      !                                               ! value of eddy mixing coef. 
    … …  
    173178         CASE(   0  )      !==  constant  ==! 
    174179            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant ' 
    175             ahmt(:,:,:) = zah0 * tmask(:,:,:) 
    176             ahmf(:,:,:) = zah0 * fmask(:,:,:) 
     180!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     181            DO jk = 1, jpk 
     182               DO jj = 1, jpj 
     183                  DO ji = 1, jpi 
     184                     ahmt(ji,jj,jk) = zah0 * tmask(ji,jj,jk) 
     185                     ahmf(ji,jj,jk) = zah0 * fmask(ji,jj,jk) 
     186                  END DO 
     187               END DO 
     188            END DO 
    177189            ! 
    178190         CASE(  10  )      !==  fixed profile  ==! 
    179191            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )' 
    180             ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value 
    181             ahmf(:,:,1) = zah0 * fmask(:,:,1) 
     192!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     193            DO jj = 1, jpj 
     194               DO ji = 1, jpi 
     195                  ahmt(ji,jj,1) = zah0 * tmask(ji,jj,1)            ! constant surface value 
     196                  ahmf(ji,jj,1) = zah0 * fmask(ji,jj,1) 
     197               END DO 
     198            END DO 
    182199            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 
    183200            ! 
    … …  
    191208!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 
    192209!!              better:  check that the max is <=1  i.e. it is a shape from 0 to 1, not a coef that has physical dimension 
     210!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    193211            DO jk = 2, jpkm1 
    194                ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 
    195                ahmf(:,:,jk) = ahmf(:,:,1) * fmask(:,:,jk) 
     212               DO jj = 1, jpj 
     213                  DO ji = 1, jpi 
     214                     ahmt(ji,jj,jk) = ahmt(ji,jj,1) * tmask(ji,jj,jk) 
     215                     ahmf(ji,jj,jk) = ahmf(ji,jj,1) * fmask(ji,jj,jk) 
     216                  END DO 
     217               END DO 
    196218            END DO 
    197219            ! 
    … …  
    209231!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ???? 
    210232!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 
     233!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    211234            DO jk = 1, jpkm1 
    212                ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 
    213                ahmf(:,:,jk) = ahmf(:,:,jk) * fmask(:,:,jk) 
     235               DO jj = 1, jpj 
     236                  DO ji = 1, jpi 
     237                     ahmt(ji,jj,jk) = ahmt(ji,jj,jk) * tmask(ji,jj,jk) 
     238                     ahmf(ji,jj,jk) = ahmf(ji,jj,jk) * fmask(ji,jj,jk) 
     239                  END DO 
     240               END DO 
    214241            END DO 
    215242            ! 
    … …  
    239266            ! 
    240267            ! Set local gridscale values 
     268!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    241269            DO jj = 2, jpjm1 
    242270               DO ji = fs_2, fs_jpim1 
    … …  
    251279         ! 
    252280         IF( ln_dynldf_blp .AND. .NOT. l_ldfdyn_time ) THEN       ! bilapcian and no time variation: 
    253             ahmt(:,:,:) = SQRT( ahmt(:,:,:) )                     ! take the square root of the coefficient 
    254             ahmf(:,:,:) = SQRT( ahmf(:,:,:) ) 
     281!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     282            DO jk = 1, jpk 
     283               DO jj = 1, jpj 
     284                  DO ji = 1, jpi 
     285                     ahmt(ji,jj,jk) = SQRT( ahmt(ji,jj,jk) )      ! take the square root of the coefficient 
     286                     ahmf(ji,jj,jk) = SQRT( ahmf(ji,jj,jk) ) 
     287                  END DO 
     288               END DO 
     289            END DO 
    255290         ENDIF 
    256291         ! 

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

    r6352 r7698  
    135135      z1_slpmax = 1._wp / rn_slpmax 
    136136      ! 
    137       zww(:,:,:) = 0._wp 
    138       zwz(:,:,:) = 0._wp 
    139       ! 
     137!$OMP PARALLEL 
     138!$OMP DO schedule(static) private(jk, jj, ji) 
     139      DO jk = 1, jpk 
     140         DO jj = 1, jpj 
     141            DO ji = 1, jpi 
     142               zww(ji,jj,jk) = 0._wp 
     143               zwz(ji,jj,jk) = 0._wp 
     144            END DO 
     145         END DO 
     146      END DO 
     147!$OMP END DO NOWAIT 
     148      ! 
     149!$OMP DO schedule(static) private(jk, jj, ji) 
    140150      DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
    141151         DO jj = 1, jpjm1 
    … …  
    146156         END DO 
    147157      END DO 
     158!$OMP END PARALLEL 
    148159      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
     160!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    149161         DO jj = 1, jpjm1 
    150162            DO ji = 1, jpim1 
    … …  
    155167      ENDIF 
    156168      IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level 
     169!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    157170         DO jj = 1, jpjm1 
    158171            DO ji = 1, jpim1 
    … …  
    163176      ENDIF 
    164177      ! 
    165       zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
     178!$OMP PARALLEL 
     179!$OMP DO schedule(static) private(jj, ji) 
     180         DO jj = 1, jpj 
     181            DO ji = 1, jpi 
     182               zdzr(ji,jj,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
     183            END DO 
     184         END DO 
     185!$OMP DO schedule(static) private(jk,jj,ji) 
    166186      DO jk = 2, jpkm1 
    167187         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
    … …  
    170190         !                                !          umask(ik+1) /= 0   =>   all pn2  /= 0   =>   zdzr divides by 2 
    171191         !                                ! NB: 1/(tmask+1) = (1-.5*tmask)  substitute a / by a *  ==> faster 
    172          zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp )              & 
    173             &                 * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 
    174       END DO 
     192         DO jj = 1, jpj 
     193            DO ji = 1, jpi 
     194               zdzr(ji,jj,jk) = zm1_g * ( prd(ji,jj,jk) + 1._wp )              & 
     195                    &                 * ( pn2(ji,jj,jk) + pn2(ji,jj,jk+1) ) * ( 1._wp - 0.5_wp * tmask(ji,jj,jk+1) ) 
     196            END DO 
     197         END DO 
     198      END DO 
     199!$OMP END PARALLEL 
    175200      ! 
    176201      !                          !==   Slopes just below the mixed layer   ==! 
    … …  
    182207      ! 
    183208      IF ( ln_isfcav ) THEN 
     209!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    184210         DO jj = 2, jpjm1 
    185211            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    191217         END DO 
    192218      ELSE 
     219!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    193220         DO jj = 2, jpjm1 
    194221            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    199226      END IF 
    200227 
     228!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zau, zav, zbu, zbv, zfj, zfi, zdepu, zdepv) 
    201229      DO jk = 2, jpkm1                            !* Slopes at u and v points 
    202230         DO jj = 2, jpjm1 
    … …  
    239267      ! 
    240268      !                                            !* horizontal Shapiro filter 
     269!$OMP PARALLEL  
     270!$OMP DO schedule(static) private(jk, jj, ji) 
    241271      DO jk = 2, jpkm1 
    242272         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    … …  
    283313      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
    284314      ! 
     315!$OMP DO schedule(static) private(jk, jj, ji, zbw, zfk, zck, zbi, zbj, zai, zaj, zci, zcj) 
    285316      DO jk = 2, jpkm1 
    286317         DO jj = 2, jpjm1 
    … …  
    318349         END DO 
    319350      END DO 
     351!$OMP END PARALLEL 
    320352      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions 
    321353      ! 
    322354      !                                           !* horizontal Shapiro filter 
     355!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcofw, zck) 
    323356      DO jk = 2, jpkm1 
    324357         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
    … …  
    670703      z1_slpmax = 1._wp / rn_slpmax 
    671704      ! 
    672       uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp 
    673       vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp 
    674       wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp 
    675       wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp 
     705!$OMP PARALLEL 
     706!$OMP DO schedule(static) private(jj)        
     707      DO jj = 1, jpj 
     708         uslpml (1,jj) = 0._wp      ;      uslpml (jpi,jj) = 0._wp 
     709         vslpml (1,jj) = 0._wp      ;      vslpml (jpi,jj) = 0._wp 
     710         wslpiml(1,jj) = 0._wp      ;      wslpiml(jpi,jj) = 0._wp 
     711         wslpjml(1,jj) = 0._wp      ;      wslpjml(jpi,jj) = 0._wp 
     712      END DO 
    676713      ! 
    677714      !                                            !==   surface mixed layer mask   ! 
     715!$OMP DO schedule(static) private(jk, jj, ji, ik) 
    678716      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    679717         DO jj = 1, jpj 
    … …  
    686724         END DO 
    687725      END DO 
     726!$OMP END DO NOWAIT 
    688727 
    689728 
    … …  
    698737      !----------------------------------------------------------------------- 
    699738      ! 
     739!$OMP DO schedule(static) private(jj, ji, iku, ikv, zbu, zbv, zau, zav, ik, ikm1, zbw, zci, zcj, zai, zaj, zbi, zbj)  
    700740      DO jj = 2, jpjm1 
    701741         DO ji = 2, jpim1 
    … …  
    742782         END DO 
    743783      END DO 
     784!$OMP END PARALLEL 
    744785      !!gm this lbc_lnk should be useless.... 
    745786      CALL lbc_lnk( uslpml , 'U', -1. )   ;   CALL lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change) 
    … …  
    791832         ! Direction of lateral diffusion (tracers and/or momentum) 
    792833         ! ------------------------------ 
    793          uslp (:,:,:) = 0._wp   ;   uslpml (:,:) = 0._wp      ! set the slope to zero (even in s-coordinates) 
    794          vslp (:,:,:) = 0._wp   ;   vslpml (:,:) = 0._wp 
    795          wslpi(:,:,:) = 0._wp   ;   wslpiml(:,:) = 0._wp 
    796          wslpj(:,:,:) = 0._wp   ;   wslpjml(:,:) = 0._wp 
    797  
     834 
     835!$OMP PARALLEL 
     836!$OMP DO schedule(static) private(jk, jj, ji)    
     837        DO jk = 1, jpk 
     838           DO jj = 1, jpj 
     839              DO ji = 1, jpi 
     840                 uslp (ji,jj,jk) = 0._wp 
     841                 vslp (ji,jj,jk) = 0._wp 
     842                 wslpi(ji,jj,jk) = 0._wp 
     843                 wslpj(ji,jj,jk) = 0._wp 
     844              END DO 
     845           END DO 
     846        END DO 
     847!$OMP END DO NOWAIT 
     848!$OMP DO schedule(static) private(jj, ji)        
     849        DO jj = 1, jpj 
     850            DO ji = 1, jpi 
     851               uslpml (ji,jj) = 0._wp 
     852               vslpml (ji,jj) = 0._wp 
     853               wslpiml(ji,jj) = 0._wp 
     854               wslpjml(ji,jj) = 0._wp 
     855             END DO 
     856        END DO 
     857!$OMP END PARALLEL 
    798858         !!gm I no longer understand this..... 
    799859!!gm         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN 

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

    r7646 r7698  
    116116      !!              aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 
    117117      !!---------------------------------------------------------------------- 
    118       INTEGER  ::   jk                ! dummy loop indices 
     118      INTEGER  ::   jk, jj, ji        ! dummy loop indices 
    119119      INTEGER  ::   ierr, inum, ios   ! local integer 
    120120      REAL(wp) ::   zah0              ! local scalar 
    … …  
    184184      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 
    185185      ! 
    186       ahtu(:,:,jpk) = 0._wp                           ! last level always 0   
    187       ahtv(:,:,jpk) = 0._wp 
     186!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     187      DO jj = 1, jpj 
     188         DO ji = 1, jpi 
     189            ahtu(ji,jj,jpk) = 0._wp                           ! last level always 0   
     190            ahtv(ji,jj,jpk) = 0._wp 
     191         END DO 
     192      END DO 
    188193      ! 
    189194      !                                               ! value of eddy mixing coef. 
    … …  
    200205         CASE(   0  )      !==  constant  ==! 
    201206            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0 
    202             ahtu(:,:,:) = zah0 * umask(:,:,:) 
    203             ahtv(:,:,:) = zah0 * vmask(:,:,:) 
     207!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     208            DO jk = 1, jpk 
     209               DO jj = 1, jpj 
     210                  DO ji = 1, jpi 
     211                     ahtu(ji,jj,jk) = zah0 * umask(ji,jj,jk) 
     212                     ahtv(ji,jj,jk) = zah0 * vmask(ji,jj,jk) 
     213                  END DO 
     214               END DO 
     215            END DO 
    204216            ! 
    205217         CASE(  10  )      !==  fixed profile  ==! 
    206218            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
    207             ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value 
    208             ahtv(:,:,1) = zah0 * vmask(:,:,1) 
     219!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     220            DO jj = 1, jpj 
     221               DO ji = 1, jpi 
     222                  ahtu(ji,jj,1) = zah0 * umask(ji,jj,1)                      ! constant surface value 
     223                  ahtv(ji,jj,1) = zah0 * vmask(ji,jj,1) 
     224               END DO 
     225            END DO 
    209226            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 
    210227            ! 
    … …  
    215232            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 
    216233            CALL iom_close( inum ) 
     234!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    217235            DO jk = 2, jpkm1 
    218                ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
    219                ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
     236               DO jj = 1, jpj 
     237                  DO ji = 1, jpi 
     238                     ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 
     239                     ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 
     240                  END DO 
     241               END DO 
    220242            END DO 
    221243            ! 
    … …  
    244266            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 
    245267            CALL iom_close( inum ) 
     268!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    246269            DO jk = 1, jpkm1 
    247                ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 
    248                ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 
     270               DO jj = 1, jpj 
     271                  DO ji = 1, jpi 
     272                     ahtu(ji,jj,jk) = ahtu(ji,jj,jk) * umask(ji,jj,jk) 
     273                     ahtv(ji,jj,jk) = ahtv(ji,jj,jk) * vmask(ji,jj,jk) 
     274                  END DO 
     275               END DO 
    249276            END DO 
    250277            ! 
    … …  
    267294         ! 
    268295         IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 
    269             ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 
    270             ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 
     296!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     297            DO jk = 1, jpk 
     298               DO jj = 1, jpj 
     299                  DO ji = 1, jpi 
     300                     ahtu(ji,jj,jk) = SQRT( ahtu(ji,jj,jk) ) 
     301                     ahtv(ji,jj,jk) = SQRT( ahtv(ji,jj,jk) ) 
     302                  END DO 
     303               END DO 
     304            END DO 
    271305         ENDIF 
    272306         ! 
    … …  
    313347         !                                             !   increase to rn_aht_0 within 20N-20S 
    314348         IF( ln_ldfeiv .AND. nn_aei_ijk_t == 21 ) THEN   ! use the already computed aei. 
    315             ahtu(:,:,1) = aeiu(:,:,1) 
    316             ahtv(:,:,1) = aeiv(:,:,1) 
     349!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     350            DO jj = 1, jpj 
     351               DO ji = 1, jpi 
     352                  ahtu(ji,jj,1) = aeiu(ji,jj,1) 
     353                  ahtv(ji,jj,1) = aeiv(ji,jj,1) 
     354               END DO 
     355            END DO 
    317356         ELSE                                            ! compute aht.  
    318357            CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) 
    … …  
    321360         z1_f20   = 1._wp / (  2._wp * omega * SIN( rad * 20._wp )  )      ! 1 / ff(20 degrees)    
    322361         zaht_min = 0.2_wp * rn_aht_0                                      ! minimum value for aht 
     362!$OMP PARALLEL 
     363!$OMP DO schedule(static) private(jj,ji,zaht,zahf) 
    323364         DO jj = 1, jpj 
    324365            DO ji = 1, jpi 
    … …  
    331372            END DO 
    332373         END DO 
     374!$OMP DO schedule(static) private(jk,jj,ji) 
    333375         DO jk = 2, jpkm1                             ! deeper value = surface value 
    334             ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
    335             ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 
    336          END DO 
     376            DO jj = 1, jpj 
     377               DO ji = 1, jpi 
     378                  ahtu(ji,jj,jk) = ahtu(ji,jj,1) * umask(ji,jj,jk) 
     379                  ahtv(ji,jj,jk) = ahtv(ji,jj,1) * vmask(ji,jj,jk) 
     380               END DO 
     381            END DO 
     382         END DO 
     383!$OMP END PARALLEL 
    337384         ! 
    338385      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity ) 
    339386         IF( ln_traldf_lap     ) THEN          !   laplacian operator |u| e /12 
     387!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    340388            DO jk = 1, jpkm1 
    341                ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 
    342                ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 
     389               DO jj = 1, jpj 
     390                  DO ji = 1, jpi 
     391                     ahtu(ji,jj,jk) = ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12 
     392                     ahtv(ji,jj,jk) = ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12 
     393                  END DO 
     394               END DO 
    343395            END DO 
    344396         ELSEIF( ln_traldf_blp ) THEN      ! bilaplacian operator      sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e 
     397!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    345398            DO jk = 1, jpkm1 
    346                ahtu(:,:,jk) = SQRT(  ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12  ) * e1u(:,:) 
    347                ahtv(:,:,jk) = SQRT(  ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12  ) * e2v(:,:) 
     399               DO jj = 1, jpj 
     400                  DO ji = 1, jpi 
     401                     ahtu(ji,jj,jk) = SQRT(  ABS( ub(ji,jj,jk) ) * e1u(ji,jj) * r1_12  ) * e1u(ji,jj) 
     402                     ahtv(ji,jj,jk) = SQRT(  ABS( vb(ji,jj,jk) ) * e2v(ji,jj) * r1_12  ) * e2v(ji,jj) 
     403                  END DO 
     404               END DO 
    348405            END DO 
    349406         ENDIF 
    … …  
    378435      !!               l_ldfeiv_time : =T if EIV coefficients vary with time 
    379436      !!---------------------------------------------------------------------- 
    380       INTEGER  ::   jk                ! dummy loop indices 
     437      INTEGER  ::   jk, jj, ji        ! dummy loop indices 
    381438      INTEGER  ::   ierr, inum, ios   ! local integer 
    382439      ! 
    … …  
    419476         CASE(   0  )      !==  constant  ==! 
    420477            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0 
    421             aeiu(:,:,:) = rn_aeiv_0 
    422             aeiv(:,:,:) = rn_aeiv_0 
     478!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     479            DO jk = 1, jpk 
     480               DO jj = 1, jpj 
     481                  DO ji = 1, jpi 
     482                     aeiu(ji,jj,jk) = rn_aeiv_0 
     483                     aeiv(ji,jj,jk) = rn_aeiv_0 
     484                  END DO 
     485               END DO 
     486            END DO 
    423487            ! 
    424488         CASE(  10  )      !==  fixed profile  ==! 
    425489            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )' 
    426             aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value 
    427             aeiv(:,:,1) = rn_aeiv_0 
     490!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     491            DO jj = 1, jpj 
     492               DO ji = 1, jpi 
     493                  aeiu(ji,jj,1) = rn_aeiv_0                                ! constant surface value 
     494                  aeiv(ji,jj,1) = rn_aeiv_0 
     495               END DO 
     496            END DO 
    428497            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 
    429498            ! 
    … …  
    434503            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 
    435504            CALL iom_close( inum ) 
     505!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    436506            DO jk = 2, jpk 
    437                aeiu(:,:,jk) = aeiu(:,:,1) 
    438                aeiv(:,:,jk) = aeiv(:,:,1) 
     507               DO jj = 1, jpj 
     508                  DO ji = 1, jpi 
     509                     aeiu(ji,jj,jk) = aeiu(ji,jj,1) 
     510                     aeiv(ji,jj,jk) = aeiv(ji,jj,1) 
     511                  END DO 
     512               END DO 
    439513            END DO 
    440514            ! 
    … …  
    498572      CALL wrk_alloc( jpi,jpj,   zn, zah, zhw, zross, zaeiw ) 
    499573      !       
    500       zn   (:,:) = 0._wp      ! Local initialization 
    501       zhw  (:,:) = 5._wp 
    502       zah  (:,:) = 0._wp 
    503       zross(:,:) = 0._wp 
     574!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     575      DO jj = 1, jpj 
     576         DO ji = 1, jpi 
     577            zn   (ji,jj) = 0._wp      ! Local initialization 
     578            zhw  (ji,jj) = 5._wp 
     579            zah  (ji,jj) = 0._wp 
     580            zross(ji,jj) = 0._wp 
     581         END DO 
     582      END DO 
    504583      !                       ! Compute lateral diffusive coefficient at T-point 
    505584      IF( ln_traldf_triad ) THEN 
    506585         DO jk = 1, jpk 
     586!$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w) 
    507587            DO jj = 2, jpjm1 
    508588               DO ji = 2, jpim1 
    … …  
    523603      ELSE 
    524604         DO jk = 1, jpk 
     605!$OMP PARALLEL DO schedule(static) private(jj,ji,zn2,ze3w) 
    525606            DO jj = 2, jpjm1 
    526607               DO ji = 2, jpim1 
    … …  
    542623      END IF 
    543624 
     625!$OMP PARALLEL  
     626!$OMP DO schedule(static) private(jj,ji,zfw) 
    544627      DO jj = 2, jpjm1 
    545628         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    554637      !                                         !==  Bound on eiv coeff.  ==! 
    555638      z1_f20 = 1._wp / (  2._wp * omega * sin( rad * 20._wp )  ) 
     639!$OMP DO schedule(static) private(jj,ji,zzaei) 
    556640      DO jj = 2, jpjm1 
    557641         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    560644         END DO 
    561645      END DO 
     646!$OMP END PARALLEL 
    562647      CALL lbc_lnk( zaeiw(:,:), 'W', 1. )       ! lateral boundary condition 
    563648      !                
     649!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    564650      DO jj = 2, jpjm1                          !== aei at u- and v-points  ==! 
    565651         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    570656      CALL lbc_lnk( paeiu(:,:,1), 'U', 1. )   ;   CALL lbc_lnk( paeiv(:,:,1), 'V', 1. )      ! lateral boundary condition 
    571657 
     658!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    572659      DO jk = 2, jpkm1                          !==  deeper values equal the surface one  ==! 
    573          paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 
    574          paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 
     660         DO jj = 1, jpj 
     661            DO ji = 1, jpi 
     662               paeiu(ji,jj,jk) = paeiu(ji,jj,1) * umask(ji,jj,jk) 
     663               paeiv(ji,jj,jk) = paeiv(ji,jj,1) * vmask(ji,jj,jk) 
     664            END DO  
     665         END DO  
    575666      END DO 
    576667      !   
    … …  
    624715 
    625716       
    626       zpsi_uw(:,:, 1 ) = 0._wp   ;   zpsi_vw(:,:, 1 ) = 0._wp 
    627       zpsi_uw(:,:,jpk) = 0._wp   ;   zpsi_vw(:,:,jpk) = 0._wp 
    628       ! 
     717!$OMP PARALLEL 
     718!$OMP DO schedule(static) private(jj,ji) 
     719      DO jj = 1, jpj 
     720         DO ji = 1, jpi 
     721            zpsi_uw(ji,jj, 1 ) = 0._wp   ;   zpsi_vw(ji,jj, 1 ) = 0._wp 
     722            zpsi_uw(ji,jj,jpk) = 0._wp   ;   zpsi_vw(ji,jj,jpk) = 0._wp 
     723         END DO 
     724      END DO 
     725!$OMP END DO NOWAIT 
     726      ! 
     727!$OMP DO schedule(static) private(jk,jj,ji) 
    629728      DO jk = 2, jpkm1 
    630729         DO jj = 1, jpjm1 
    … …  
    638737      END DO 
    639738      ! 
     739!$OMP DO schedule(static) private(jk,jj,ji) 
    640740      DO jk = 1, jpkm1 
    641741         DO jj = 1, jpjm1 
    … …  
    646746         END DO 
    647747      END DO 
     748!$OMP END DO NOWAIT 
     749!$OMP DO schedule(static) private(jk,jj,ji) 
    648750      DO jk = 1, jpkm1 
    649751         DO jj = 2, jpjm1 
    … …  
    654756         END DO 
    655757      END DO 
     758!$OMP END PARALLEL 
    656759      ! 
    657760      !                              ! diagnose the eddy induced velocity and associated heat transport 
    … …  
    695798      CALL wrk_alloc( jpi,jpj,jpk,   zw3d ) 
    696799      ! 
    697       zw3d(:,:,jpk) = 0._wp                                    ! bottom value always 0 
    698       ! 
     800!$OMP PARALLEL 
     801!$OMP DO schedule(static) private(jj,ji) 
     802      DO jj = 1, jpj 
     803         DO ji = 1, jpi 
     804            zw3d(ji,jj,jpk) = 0._wp                            ! bottom value always 0 
     805         END DO 
     806      END DO 
     807!$OMP END DO NOWAIT 
     808      ! 
     809!$OMP DO schedule(static) private(jk,jj,ji) 
    699810      DO jk = 1, jpkm1                                         ! e2u e3u u_eiv = -dk[psi_uw] 
    700          zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 
    701       END DO 
     811         DO jj = 1, jpj 
     812            DO ji = 1, jpi 
     813               zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
     814            END DO 
     815         END DO 
     816      END DO 
     817!$OMP END PARALLEL 
    702818      CALL iom_put( "uoce_eiv", zw3d ) 
    703819      ! 
     820!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    704821      DO jk = 1, jpkm1                                         ! e1v e3v v_eiv = -dk[psi_vw] 
    705          zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 
     822         DO jj = 1, jpj 
     823            DO ji = 1, jpi 
     824               zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 
     825            END DO 
     826         END DO 
    706827      END DO 
    707828      CALL iom_put( "voce_eiv", zw3d ) 
    708829      ! 
     830!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    709831      DO jk = 1, jpkm1                                         ! e1 e2 w_eiv = dk[psix] + dk[psix] 
    710832         DO jj = 2, jpjm1 
    … …  
    724846      zztmp = 0.5_wp * rau0 * rcp  
    725847      IF( iom_use('ueiv_heattr') .OR. iom_use('ueiv_heattr3d') ) THEN 
    726         zw2d(:,:)   = 0._wp  
    727         zw3d(:,:,:) = 0._wp  
    728         DO jk = 1, jpkm1 
    729            DO jj = 2, jpjm1 
    730               DO ji = fs_2, fs_jpim1   ! vector opt. 
    731                  zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    732                     &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
    733                  zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    734               END DO 
    735            END DO 
    736         END DO 
    737         CALL lbc_lnk( zw2d, 'U', -1. ) 
    738         CALL lbc_lnk( zw3d, 'U', -1. ) 
    739         CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction 
    740         CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
    741       ENDIF 
    742       zw2d(:,:)   = 0._wp  
    743       zw3d(:,:,:) = 0._wp  
     848!$OMP PARALLEL 
     849!$OMP DO schedule(static) private(jj,ji) 
     850         DO jj = 1, jpj 
     851            DO ji = 1, jpi 
     852               zw2d(ji,jj) = 0._wp 
     853            END DO 
     854         END DO 
     855!$OMP DO schedule(static) private(jk,jj,ji) 
     856         DO jk = 1, jpk 
     857            DO jj = 1, jpj 
     858               DO ji = 1, jpi 
     859                  zw3d(ji,jj,jk) = 0._wp  
     860               END DO 
     861            END DO 
     862         END DO 
     863         DO jk = 1, jpkm1 
     864!$OMP DO schedule(static) private(jj,ji) 
     865            DO jj = 2, jpjm1 
     866               DO ji = fs_2, fs_jpim1   ! vector opt. 
     867                  zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     868                     &                            * ( tsn   (ji,jj,jk,jp_tem) + tsn   (ji+1,jj,jk,jp_tem) )  
     869                  zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
     870               END DO 
     871            END DO 
     872         END DO 
     873!$OMP END PARALLEL 
     874         CALL lbc_lnk( zw2d, 'U', -1. ) 
     875         CALL lbc_lnk( zw3d, 'U', -1. ) 
     876         CALL iom_put( "ueiv_heattr"  , zztmp * zw2d )                  ! heat transport in i-direction 
     877         CALL iom_put( "ueiv_heattr3d", zztmp * zw3d )                  ! heat transport in i-direction 
     878      ENDIF 
     879!$OMP PARALLEL 
     880!$OMP DO schedule(static) private(jj,ji) 
     881      DO jj = 1, jpj 
     882         DO ji = 1, jpi 
     883            zw2d(ji,jj) = 0._wp 
     884         END DO 
     885      END DO 
     886!$OMP DO schedule(static) private(jk,jj,ji) 
     887      DO jk = 1, jpk 
     888         DO jj = 1, jpj 
     889            DO ji = 1, jpi 
     890               zw3d(ji,jj,jk) = 0._wp 
     891            END DO 
     892         END DO 
     893      END DO 
    744894      DO jk = 1, jpkm1 
     895!$OMP DO schedule(static) private(jj,ji) 
    745896         DO jj = 2, jpjm1 
    746897            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    751902         END DO 
    752903      END DO 
     904!$OMP END PARALLEL 
    753905      CALL lbc_lnk( zw2d, 'V', -1. ) 
    754906      CALL iom_put( "veiv_heattr", zztmp * zw2d )                  !  heat transport in j-direction 
    … …  
    759911      zztmp = 0.5_wp * 0.5 
    760912      IF( iom_use('ueiv_salttr') .OR. iom_use('ueiv_salttr3d')) THEN 
    761         zw2d(:,:) = 0._wp  
    762         zw3d(:,:,:) = 0._wp  
    763         DO jk = 1, jpkm1 
    764            DO jj = 2, jpjm1 
    765               DO ji = fs_2, fs_jpim1   ! vector opt. 
    766                  zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
    767                     &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
    768                  zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
    769               END DO 
    770            END DO 
    771         END DO 
    772         CALL lbc_lnk( zw2d, 'U', -1. ) 
    773         CALL lbc_lnk( zw3d, 'U', -1. ) 
    774         CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
    775         CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
    776       ENDIF 
    777       zw2d(:,:) = 0._wp  
    778       zw3d(:,:,:) = 0._wp  
     913!$OMP PARALLEL 
     914!$OMP DO schedule(static) private(jj,ji) 
     915         DO jj = 1, jpj 
     916            DO ji = 1, jpi 
     917               zw2d(ji,jj) = 0._wp 
     918            END DO 
     919         END DO 
     920!$OMP DO schedule(static) private(jk,jj,ji) 
     921         DO jk = 1, jpk 
     922            DO jj = 1, jpj 
     923               DO ji = 1, jpi 
     924                  zw3d(ji,jj,jk) = 0._wp  
     925               END DO 
     926            END DO 
     927         END DO 
     928         DO jk = 1, jpkm1 
     929!$OMP DO schedule(static) private(jj,ji) 
     930            DO jj = 2, jpjm1 
     931               DO ji = fs_2, fs_jpim1   ! vector opt. 
     932                  zw3d(ji,jj,jk) = zw3d(ji,jj,jk) * ( psi_uw(ji,jj,jk+1)      - psi_uw(ji,jj,jk)          )   & 
     933                     &                            * ( tsn   (ji,jj,jk,jp_sal) + tsn   (ji+1,jj,jk,jp_sal) )  
     934                  zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 
     935               END DO 
     936            END DO 
     937         END DO 
     938         CALL lbc_lnk( zw2d, 'U', -1. ) 
     939         CALL lbc_lnk( zw3d, 'U', -1. ) 
     940         CALL iom_put( "ueiv_salttr", zztmp * zw2d )                  ! salt transport in i-direction 
     941         CALL iom_put( "ueiv_salttr3d", zztmp * zw3d )                  ! salt transport in i-direction 
     942!$OMP END PARALLEL 
     943      ENDIF 
     944!$OMP PARALLEL 
     945!$OMP DO schedule(static) private(jj,ji) 
     946      DO jj = 1, jpj 
     947         DO ji = 1, jpi 
     948            zw2d(ji,jj) = 0._wp 
     949         END DO 
     950      END DO 
     951!$OMP DO schedule(static) private(jk,jj,ji) 
     952      DO jk = 1, jpk 
     953         DO jj = 1, jpj 
     954            DO ji = 1, jpi 
     955               zw3d(ji,jj,jk) = 0._wp 
     956            END DO 
     957         END DO 
     958      END DO 
    779959      DO jk = 1, jpkm1 
     960!$OMP DO schedule(static) private(jj,ji) 
    780961         DO jj = 2, jpjm1 
    781962            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    786967         END DO 
    787968      END DO 
     969!$OMP END PARALLEL 
    788970      CALL lbc_lnk( zw2d, 'V', -1. ) 
    789971      CALL iom_put( "veiv_salttr", zztmp * zw2d )                  !  salt transport in j-direction 

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

    r6416 r7698  
    115115          
    116116         !  Computation of ice albedo (free of snow) 
    117          WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im 
    118          ELSE WHERE                                              ;   zalb(:,:,:) = ralb_if 
    119          END  WHERE 
     117!$OMP PARALLEL DO schedule(static) private(jl,jj,ji) 
     118         DO jl = 1, ijpl 
     119            DO jj = 1, jpj 
     120               DO ji = 1, jpi 
     121                  IF ( ph_snw(ji,jj,jl) == 0._wp .AND. pt_ice(ji,jj,jl) >= rt0_ice ) THEN 
     122                     zalb(ji,jj,jl) = ralb_im 
     123                  ELSE 
     124                     zalb(ji,jj,jl) = ralb_if 
     125                  END IF 
     126               END DO 
     127            END DO 
     128         END DO 
    120129       
    121130         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb 
    … …  
    126135         ELSE WHERE                                       ;  zalb_it = 0.1    + 3.6    * ph_ice 
    127136         END WHERE 
    128       
     137!$OMP PARALLEL 
     138!$OMP DO schedule(static) private(jl, jj, ji,zswitch,zalb_sf,zalb_sm,zalb_st) 
    129139         DO jl = 1, ijpl 
    130140            DO jj = 1, jpj 
    … …  
    156166         END DO 
    157167 
    158          pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rcloud       ! Oberhuber correction for overcast sky 
     168!$OMP DO schedule(static) private(jl, jj, ji)      
     169         DO jl = 1, ijpl 
     170            DO jj = 1, jpj 
     171               DO ji = 1, jpi 
     172                  pa_ice_os(ji,jj,jl) = pa_ice_cs(ji,jj,jl) + rcloud       ! Oberhuber correction for overcast sky 
     173               END DO 
     174            END DO 
     175         END DO 
     176!$OMP END PARALLEL 
    159177 
    160178      !------------------------------------------ 
    … …  
    193211         z1_c2 = 1. / 0.03 
    194212         !  Computation of the snow/ice albedo 
     213!$OMP PARALLEL DO schedule(static) private(jl, jj, ji,zswitch,zalb_sf,zalb_sm,zalb_st)      
    195214         DO jl = 1, ijpl 
    196215            DO jj = 1, jpj 
    … …  
    230249      !! 
    231250      REAL(wp) :: zcoef  
     251      INTEGER  ::   ji, jj                                   ! dummy loop indices 
    232252      !!---------------------------------------------------------------------- 
    233253      ! 
    234254      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982 
    235       pa_oce_cs(:,:) = zcoef  
    236       pa_oce_os(:,:) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972 
     255!$OMP PARALLEL DO schedule(static) private(jj, ji)      
     256      DO jj = 1, jpj 
     257         DO ji = 1, jpi 
     258            pa_oce_cs(ji,jj) = zcoef  
     259            pa_oce_os(ji,jj) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972 
     260         END DO 
     261      END DO 
    237262      ! 
    238263   END SUBROUTINE albedo_oce 

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

    r6140 r7698  
    6666      !                                                             ! 'ij->e' = (i,j) components to east 
    6767      !                                                             ! 'ij->n' = (i,j) components to north 
     68      INTEGER  ::   ji, jj                                          ! dummy loop indices 
    6869      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   prot       
    6970      !!---------------------------------------------------------------------- 
    … …  
    8283      CASE( 'en->i' )                  ! east-north to i-component 
    8384         SELECT CASE (cd_type) 
    84          CASE ('T')   ;   prot(:,:) = pxin(:,:) * gcost(:,:) + pyin(:,:) * gsint(:,:) 
    85          CASE ('U')   ;   prot(:,:) = pxin(:,:) * gcosu(:,:) + pyin(:,:) * gsinu(:,:) 
    86          CASE ('V')   ;   prot(:,:) = pxin(:,:) * gcosv(:,:) + pyin(:,:) * gsinv(:,:) 
    87          CASE ('F')   ;   prot(:,:) = pxin(:,:) * gcosf(:,:) + pyin(:,:) * gsinf(:,:) 
     85         CASE ('T')    
     86!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     87            DO jj = 1, jpj 
     88               DO ji = 1, jpi 
     89                  prot(ji,jj) = pxin(ji,jj) * gcost(ji,jj) + pyin(ji,jj) * gsint(ji,jj) 
     90               END DO 
     91            END DO 
     92         CASE ('U') 
     93!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     94            DO jj = 1, jpj 
     95               DO ji = 1, jpi 
     96                  prot(ji,jj) = pxin(ji,jj) * gcosu(ji,jj) + pyin(ji,jj) * gsinu(ji,jj) 
     97               END DO 
     98            END DO 
     99         CASE ('V') 
     100!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     101            DO jj = 1, jpj 
     102               DO ji = 1, jpi 
     103                  prot(ji,jj) = pxin(ji,jj) * gcosv(ji,jj) + pyin(ji,jj) * gsinv(ji,jj) 
     104               END DO 
     105            END DO 
     106         CASE ('F') 
     107!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     108            DO jj = 1, jpj 
     109               DO ji = 1, jpi 
     110                  prot(ji,jj) = pxin(ji,jj) * gcosf(ji,jj) + pyin(ji,jj) * gsinf(ji,jj) 
     111               END DO 
     112            END DO 
    88113         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 
    89114         END SELECT 
    90115      CASE ('en->j')                   ! east-north to j-component 
    91116         SELECT CASE (cd_type) 
    92          CASE ('T')   ;   prot(:,:) = pyin(:,:) * gcost(:,:) - pxin(:,:) * gsint(:,:) 
    93          CASE ('U')   ;   prot(:,:) = pyin(:,:) * gcosu(:,:) - pxin(:,:) * gsinu(:,:) 
    94          CASE ('V')   ;   prot(:,:) = pyin(:,:) * gcosv(:,:) - pxin(:,:) * gsinv(:,:)    
    95          CASE ('F')   ;   prot(:,:) = pyin(:,:) * gcosf(:,:) - pxin(:,:) * gsinf(:,:)    
     117         CASE ('T') 
     118!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     119            DO jj = 1, jpj 
     120               DO ji = 1, jpi 
     121                  prot(ji,jj) = pyin(ji,jj) * gcost(ji,jj) - pxin(ji,jj) * gsint(ji,jj) 
     122               END DO 
     123            END DO 
     124         CASE ('U') 
     125!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     126            DO jj = 1, jpj 
     127               DO ji = 1, jpi 
     128                  prot(ji,jj) = pyin(ji,jj) * gcosu(ji,jj) - pxin(ji,jj) * gsinu(ji,jj) 
     129               END DO 
     130            END DO 
     131         CASE ('V')    
     132!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     133            DO jj = 1, jpj 
     134               DO ji = 1, jpi 
     135                  prot(ji,jj) = pyin(ji,jj) * gcosv(ji,jj) - pxin(ji,jj) * gsinv(ji,jj) 
     136               END DO 
     137            END DO 
     138         CASE ('F')    
     139!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     140            DO jj = 1, jpj 
     141               DO ji = 1, jpi 
     142                  prot(ji,jj) = pyin(ji,jj) * gcosf(ji,jj) - pxin(ji,jj) * gsinf(ji,jj) 
     143               END DO 
     144            END DO 
    96145         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 
    97146         END SELECT 
    98147      CASE ('ij->e')                   ! (i,j)-components to east 
    99148         SELECT CASE (cd_type) 
    100          CASE ('T')   ;   prot(:,:) = pxin(:,:) * gcost(:,:) - pyin(:,:) * gsint(:,:) 
    101          CASE ('U')   ;   prot(:,:) = pxin(:,:) * gcosu(:,:) - pyin(:,:) * gsinu(:,:) 
    102          CASE ('V')   ;   prot(:,:) = pxin(:,:) * gcosv(:,:) - pyin(:,:) * gsinv(:,:) 
    103          CASE ('F')   ;   prot(:,:) = pxin(:,:) * gcosf(:,:) - pyin(:,:) * gsinf(:,:) 
     149         CASE ('T') 
     150!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     151            DO jj = 1, jpj 
     152               DO ji = 1, jpi 
     153                  prot(ji,jj) = pxin(ji,jj) * gcost(ji,jj) - pyin(ji,jj) * gsint(ji,jj) 
     154               END DO 
     155            END DO 
     156         CASE ('U') 
     157!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     158            DO jj = 1, jpj 
     159               DO ji = 1, jpi 
     160                  prot(ji,jj) = pxin(ji,jj) * gcosu(ji,jj) - pyin(ji,jj) * gsinu(ji,jj) 
     161               END DO 
     162            END DO 
     163         CASE ('V') 
     164!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     165            DO jj = 1, jpj 
     166               DO ji = 1, jpi 
     167                  prot(ji,jj) = pxin(ji,jj) * gcosv(ji,jj) - pyin(ji,jj) * gsinv(ji,jj) 
     168               END DO 
     169            END DO 
     170         CASE ('F') 
     171!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     172            DO jj = 1, jpj 
     173               DO ji = 1, jpi 
     174                  prot(ji,jj) = pxin(ji,jj) * gcosf(ji,jj) - pyin(ji,jj) * gsinf(ji,jj) 
     175               END DO 
     176            END DO 
    104177         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 
    105178         END SELECT 
    106179      CASE ('ij->n')                   ! (i,j)-components to north  
    107180         SELECT CASE (cd_type) 
    108          CASE ('T')   ;   prot(:,:) = pyin(:,:) * gcost(:,:) + pxin(:,:) * gsint(:,:) 
    109          CASE ('U')   ;   prot(:,:) = pyin(:,:) * gcosu(:,:) + pxin(:,:) * gsinu(:,:) 
    110          CASE ('V')   ;   prot(:,:) = pyin(:,:) * gcosv(:,:) + pxin(:,:) * gsinv(:,:) 
    111          CASE ('F')   ;   prot(:,:) = pyin(:,:) * gcosf(:,:) + pxin(:,:) * gsinf(:,:) 
     181         CASE ('T') 
     182!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     183            DO jj = 1, jpj 
     184               DO ji = 1, jpi 
     185                  prot(ji,jj) = pyin(ji,jj) * gcost(ji,jj) + pxin(ji,jj) * gsint(ji,jj) 
     186               END DO 
     187            END DO 
     188         CASE ('U') 
     189!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     190            DO jj = 1, jpj 
     191               DO ji = 1, jpi 
     192                  prot(ji,jj) = pyin(ji,jj) * gcosu(ji,jj) + pxin(ji,jj) * gsinu(ji,jj) 
     193               END DO 
     194            END DO 
     195         CASE ('V') 
     196!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     197            DO jj = 1, jpj 
     198               DO ji = 1, jpi 
     199                  prot(ji,jj) = pyin(ji,jj) * gcosv(ji,jj) + pxin(ji,jj) * gsinv(ji,jj) 
     200               END DO 
     201            END DO 
     202         CASE ('F') 
     203!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     204            DO jj = 1, jpj 
     205               DO ji = 1, jpi 
     206                  prot(ji,jj) = pyin(ji,jj) * gcosf(ji,jj) + pxin(ji,jj) * gsinf(ji,jj) 
     207               END DO 
     208            END DO 
    112209         CASE DEFAULT   ;   CALL ctl_stop( 'Only T, U, V and F grid points are coded' ) 
    113210         END SELECT 
    … …  
    157254      ! (computation done on the north stereographic polar plane) 
    158255      ! 
     256!$OMP PARALLEL 
     257!$OMP DO schedule(static) private(jj,ji,zlam,zphi,zxnpt,zynpt,znnpt,zxnpu,zynpu,znnpu,zxnpv,zynpv,znnpv,zxnpf) & 
     258!$OMP& private(zynpf,znnpf,zlan,zphh,zxvvt,zyvvt,znvvt,zxffu,zyffu,znffu,zxffv,zyffv,znffv,zxuuf,zyuuf,znuuf) 
    159259      DO jj = 2, jpjm1 
    160260         DO ji = fs_2, jpi   ! vector opt. 
    … …  
    248348      ! =============== ! 
    249349 
     350!$OMP DO schedule(static) private(jj,ji) 
    250351      DO jj = 2, jpjm1 
    251352         DO ji = fs_2, jpi   ! vector opt. 
    … …  
    268369         END DO 
    269370      END DO 
     371!$OMP END DO NOWAIT 
     372!$OMP END PARALLEL 
    270373 
    271374      ! =========================== ! 

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

    r7646 r7698  
    316316#if defined key_cice 
    317317      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN 
    318          qlw_ice(:,:,1)   = sf(jp_qlw )%fnow(:,:,1) 
    319          IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
    320          ELSE                ; qsr_ice(:,:,1) =          sf(jp_qsr)%fnow(:,:,1)  
     318!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     319         DO jj = 1, jpj 
     320            DO ji = 1, jpi 
     321               qlw_ice(ji,jj,1)   = sf(jp_qlw)%fnow(ji,jj,1) 
     322            END DO 
     323         END DO 
     324         IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1)   = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 
     325         ELSE                 
     326!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     327            DO jj = 1, jpj 
     328               DO ji = 1, jpi 
     329                  qsr_ice(ji,jj,1)   = sf(jp_qsr)%fnow(ji,jj,1)  
     330               END DO 
     331            END DO 
    321332         ENDIF  
    322          tatm_ice(:,:)    = sf(jp_tair)%fnow(:,:,1) 
    323          qatm_ice(:,:)    = sf(jp_humi)%fnow(:,:,1) 
    324          tprecip(:,:)     = sf(jp_prec)%fnow(:,:,1) * rn_pfac 
    325          sprecip(:,:)     = sf(jp_snow)%fnow(:,:,1) * rn_pfac 
    326          wndi_ice(:,:)    = sf(jp_wndi)%fnow(:,:,1) 
    327          wndj_ice(:,:)    = sf(jp_wndj)%fnow(:,:,1) 
     333!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     334         DO jj = 1, jpj 
     335            DO ji = 1, jpi 
     336               tatm_ice(ji,jj)    = sf(jp_tair)%fnow(ji,jj,1) 
     337               qatm_ice(ji,jj)    = sf(jp_humi)%fnow(ji,jj,1) 
     338               tprecip(ji,jj)     = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac 
     339               sprecip(ji,jj)     = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac 
     340               wndi_ice(ji,jj)    = sf(jp_wndi)%fnow(ji,jj,1) 
     341               wndj_ice(ji,jj)    = sf(jp_wndj)%fnow(ji,jj,1) 
     342            END DO 
     343         END DO 
    328344      ENDIF 
    329345#endif 
    … …  
    382398      ! 
    383399 
    384       ! local scalars ( place there for vector optimisation purposes) 
    385       zst(:,:) = pst(:,:) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
    386  
     400!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     401      DO jj = 1, jpj 
     402         DO ji = 1, jpi 
     403         ! local scalars ( place there for vector optimisation purposes) 
     404            zst(ji,jj) = pst(ji,jj) + rt0      ! convert SST from Celcius to Kelvin (and set minimum value far above 0 K) 
     405 
     406            ! ... components ( U10m - U_oce ) at T-point (unmasked) 
     407!!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ??? 
     408            zwnd_i(ji,jj) = 0._wp 
     409            zwnd_j(ji,jj) = 0._wp 
     410         END DO 
     411      END DO 
    387412      ! ----------------------------------------------------------------------------- ! 
    388413      !      0   Wind components and module at T-point relative to the moving ocean   ! 
    389414      ! ----------------------------------------------------------------------------- ! 
    390415 
    391       ! ... components ( U10m - U_oce ) at T-point (unmasked) 
    392 !!gm    move zwnd_i (_j) set to zero  inside the key_cyclone ??? 
    393       zwnd_i(:,:) = 0._wp 
    394       zwnd_j(:,:) = 0._wp 
    395416#if defined key_cyclone 
    396417      CALL wnd_cyc( kt, zwnd_i, zwnd_j )    ! add analytical tropical cyclone (Vincent et al. JGR 2012) 
     418!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    397419      DO jj = 2, jpjm1 
    398420         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    402424      END DO 
    403425#endif 
     426!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    404427      DO jj = 2, jpjm1 
    405428         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    411434      CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. ) 
    412435      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked) 
    413       wndm(:,:) = SQRT(  zwnd_i(:,:) * zwnd_i(:,:)   & 
    414          &             + zwnd_j(:,:) * zwnd_j(:,:)  ) * tmask(:,:,1) 
    415  
     436!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     437      DO jj = 1, jpj 
     438         DO ji = 1, jpi 
     439            wndm(ji,jj) = SQRT(  zwnd_i(ji,jj) * zwnd_i(ji,jj)   & 
     440               &             + zwnd_j(ji,jj) * zwnd_j(ji,jj)  ) * tmask(ji,jj,1) 
     441 
     442         END DO 
     443      END DO 
    416444      ! ----------------------------------------------------------------------------- ! 
    417445      !      I   Radiative FLUXES                                                     ! 
    … …  
    421449      zztmp = 1. - albo 
    422450      IF( ln_dm2dc ) THEN   ;   qsr(:,:) = zztmp * sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
    423       ELSE                  ;   qsr(:,:) = zztmp *          sf(jp_qsr)%fnow(:,:,1)   * tmask(:,:,1) 
     451      ELSE          
     452!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     453         DO jj = 1, jpj 
     454            DO ji = 1, jpi 
     455               qsr(ji,jj) = zztmp *          sf(jp_qsr)%fnow(ji,jj,1)   * tmask(ji,jj,1) 
     456            END DO 
     457         END DO 
    424458      ENDIF 
    425459 
    426       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
     460!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     461      DO jj = 1, jpj 
     462         DO ji = 1, jpi 
     463            zqlw(ji,jj) = (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * zst(ji,jj)*zst(ji,jj)*zst(ji,jj)*zst(ji,jj)  ) * tmask(ji,jj,1)   ! Long  Wave 
     464         END DO 
     465      END DO 
    427466 
    428467 
    … …  
    461500      END IF 
    462501 
    463       Cd_oce(:,:) = Cd(:,:)  ! record value of pure ocean-atm. drag (clem) 
    464  
     502!$OMP PARALLEL 
     503!$OMP DO schedule(static) private(jj, ji) 
     504      DO jj = 1, jpj 
     505         DO ji = 1, jpi 
     506            Cd_oce(ji,jj) = Cd(ji,jj)  ! record value of pure ocean-atm. drag (clem) 
     507         END DO 
     508      END DO 
     509 
     510!$OMP DO schedule(static) private(jj, ji) 
    465511      DO jj = 1, jpj             ! tau module, i and j component 
    466512         DO ji = 1, jpi 
    … …  
    471517         END DO 
    472518      END DO 
     519!$OMP END PARALLEL 
    473520 
    474521      !                          ! add the HF tau contribution to the wind stress module 
    475       IF( lhftau )   taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
     522      IF( lhftau ) THEN 
     523!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     524         DO jj = 1, jpj 
     525            DO ji = 1, jpi 
     526               taum(ji,jj) = taum(ji,jj) + sf(jp_tdif)%fnow(ji,jj,1) 
     527            END DO 
     528         END DO 
     529      END IF 
    476530 
    477531      CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    … …  
    480534      !     Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 
    481535      !     Note the use of MAX(tmask(i,j),tmask(i+1,j) is to mask tau over ice shelves 
     536!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    482537      DO jj = 1, jpjm1 
    483538         DO ji = 1, fs_jpim1 
    … …  
    496551 
    497552      ! zqla used as temporary array, for rho*U (common term of bulk formulae): 
    498       zqla(:,:) = zrhoa(:,:) * zU_zu(:,:) 
     553!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     554      DO jj = 1, jpj 
     555         DO ji = 1, jpi 
     556            zqla(ji,jj) = zrhoa(ji,jj) * zU_zu(ji,jj) 
     557         END DO 
     558      END DO 
    499559 
    500560      IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 
    501561         !! q_air and t_air are given at 10m (wind reference height) 
    502          zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed 
    503          zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:)             )   ! Sensible Heat, using bulk wind speed 
     562!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     563         DO jj = 1, jpj 
     564            DO ji = 1, jpi 
     565               zevap(ji,jj) = rn_efac*MAX( 0._wp,             zqla(ji,jj)*Ce(ji,jj)*(zsq(ji,jj) - sf(jp_humi)%fnow(ji,jj,1)) ) ! Evaporation, using bulk wind speed 
     566            END DO 
     567         END DO 
     568         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - ztpot(:,:) )   ! Sensible Heat, using bulk wind speed 
    504569      ELSE 
    505570         !! q_air and t_air are not given at 10m (wind reference height) 
    506571         ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 
    507          zevap(:,:) = rn_efac*MAX( 0._wp,             zqla(:,:)*Ce(:,:)*(zsq(:,:) - zq_zu(:,:) ) ) ! Evaporation ! using bulk wind speed 
     572!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     573         DO jj = 1, jpj 
     574            DO ji = 1, jpi 
     575               zevap(ji,jj) = rn_efac*MAX( 0._wp,             zqla(ji,jj)*Ce(ji,jj)*(zsq(ji,jj) - zq_zu(ji,jj) ) ) ! Evaporation ! using bulk wind speed 
     576            END DO 
     577         END DO 
    508578         zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch(:,:)*(zst(:,:) - zt_zu(:,:) )   ! Sensible Heat ! using bulk wind speed 
    509579      ENDIF 
    … …  
    527597      ! ----------------------------------------------------------------------------- ! 
    528598      ! 
    529       emp (:,:) = (  zevap(:,:)                                          &   ! mass flux (evap. - precip.) 
    530          &         - sf(jp_prec)%fnow(:,:,1) * rn_pfac  ) * tmask(:,:,1) 
    531       ! 
    532       qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                &   ! Downward Non Solar 
    533          &     - sf(jp_snow)%fnow(:,:,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
    534          &     - zevap(:,:) * pst(:,:) * rcp                                      &   ! remove evap heat content at SST 
    535          &     + ( sf(jp_prec)%fnow(:,:,1) - sf(jp_snow)%fnow(:,:,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
    536          &     * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp                          & 
    537          &     + sf(jp_snow)%fnow(:,:,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
    538          &     * ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) 
    539       ! 
     599!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     600      DO jj = 1, jpj 
     601         DO ji = 1, jpi 
     602            emp (ji,jj) = (  zevap(ji,jj)                                          &   ! mass flux (evap. - precip.) 
     603               &         - sf(jp_prec)%fnow(ji,jj,1) * rn_pfac  ) * tmask(ji,jj,1) 
     604            ! 
     605            qns(ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj)                                &   ! Downward Non Solar 
     606               &     - sf(jp_snow)%fnow(ji,jj,1) * rn_pfac * lfus                         &   ! remove latent melting heat for solid precip 
     607               &     - zevap(ji,jj) * pst(ji,jj) * rcp                                      &   ! remove evap heat content at SST 
     608               &     + ( sf(jp_prec)%fnow(ji,jj,1) - sf(jp_snow)%fnow(ji,jj,1) ) * rn_pfac  &   ! add liquid precip heat content at Tair 
     609               &     * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp                          & 
     610               &     + sf(jp_snow)%fnow(ji,jj,1) * rn_pfac                                &   ! add solid  precip heat content at min(Tair,Tsnow) 
     611               &     * ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) 
     612            ! 
    540613#if defined key_lim3 
    541       qns_oce(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)                                ! non solar without emp (only needed by LIM3) 
    542       qsr_oce(:,:) = qsr(:,:) 
     614            qns_oce(ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj)                                ! non solar without emp (only needed by LIM3) 
     615            qsr_oce(ji,jj) = qsr(ji,jj) 
    543616#endif 
     617         END DO 
     618      END DO 
    544619      ! 
    545620      IF ( nn_ice == 0 ) THEN 
    … …  
    551626         CALL iom_put( "qsr_oce" ,   qsr  )                 ! output downward solar heat over the ocean 
    552627         CALL iom_put( "qt_oce"  ,   qns+qsr )              ! output total downward heat over the ocean 
    553          tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac   ! output total precipitation [kg/m2/s] 
    554          sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac   ! output solid precipitation [kg/m2/s] 
     628!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     629         DO jj = 1, jpj 
     630            DO ji = 1, jpi 
     631               tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac   ! output total precipitation [kg/m2/s] 
     632               sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac   ! output solid precipitation [kg/m2/s] 
     633            END DO 
     634         END DO 
    555635         CALL iom_put( 'snowpre', sprecip * 86400. )        ! Snow 
    556636         CALL iom_put( 'precip' , tprecip * 86400. )        ! Total precipitation 
    … …  
    599679      CALL wrk_alloc( jpi,jpj, Cd ) 
    600680 
    601       Cd(:,:) = Cd_ice 
     681!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     682      DO jj = 1, jpj 
     683         DO ji = 1, jpi 
     684            Cd(ji,jj) = Cd_ice 
     685         END DO 
     686      END DO 
    602687 
    603688      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 
    … …  
    613698      zrhoa (:,:) =  rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 
    614699 
    615       !!gm brutal.... 
    616       utau_ice  (:,:) = 0._wp 
    617       vtau_ice  (:,:) = 0._wp 
    618       wndm_ice  (:,:) = 0._wp 
    619       !!gm end 
     700!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     701      DO jj = 1, jpj 
     702         DO ji = 1, jpi 
     703            !!gm brutal.... 
     704            utau_ice  (ji,jj) = 0._wp 
     705            vtau_ice  (ji,jj) = 0._wp 
     706            wndm_ice  (ji,jj) = 0._wp 
     707            !!gm end 
     708         END DO 
     709      END DO 
    620710 
    621711      ! ----------------------------------------------------------------------------- ! 
    … …  
    625715      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation) 
    626716         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked) 
     717!$OMP PARALLEL DO schedule(static) private(jj,ji,zwndi_f,zwndj_f,zwnorm_f,zwndi_t,zwndj_t) 
    627718         DO jj = 2, jpjm1 
    628719            DO ji = 2, jpim1   ! B grid : NO vector opt 
    … …  
    649740         ! 
    650741      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean) 
     742!$OMP PARALLEL DO schedule(static) private(jj,ji,zwndi_t,zwndj_t) 
    651743         DO jj = 2, jpj 
    652744            DO ji = fs_2, jpi   ! vect. opt. 
    … …  
    656748            END DO 
    657749         END DO 
     750!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    658751         DO jj = 2, jpjm1 
    659752            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    700793      REAL(wp) ::   zztmp, z1_lsub           !   -      - 
    701794      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw         ! long wave heat flux over ice 
     795      REAL(wp), DIMENSION(:,:,:), POINTER ::   zevap_ice3d, zqns_ice3d, zqsr_ice3d  
    702796      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb         ! sensible  heat flux over ice 
    703797      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw        ! long wave heat sensitivity over ice 
    704798      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb        ! sensible  heat sensitivity over ice 
    705799      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap, zsnw   ! evaporation and snw distribution after wind blowing (LIM3) 
     800      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevap_ice2d, zqns_ice2d, zqsr_ice2d 
    706801      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa 
    707802      REAL(wp), DIMENSION(:,:)  , POINTER ::   Cd            ! transfer coefficient for momentum      (tau) 
    … …  
    710805      IF( nn_timing == 1 )  CALL timing_start('blk_ice_flx') 
    711806      ! 
    712       CALL wrk_alloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb ) 
    713       CALL wrk_alloc( jpi,jpj,       zrhoa) 
     807      CALL wrk_alloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb, zevap_ice3d, zqns_ice3d, zqsr_ice3d ) 
     808      CALL wrk_alloc( jpi,jpj,       zrhoa, zevap_ice2d, zqns_ice2d, zqsr_ice2d) 
    714809      CALL wrk_alloc( jpi,jpj, Cd ) 
    715810 
    716       Cd(:,:) = Cd_ice 
     811!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     812      DO jj = 1, jpj 
     813         DO ji = 1, jpi 
     814            Cd(ji,jj) = Cd_ice 
     815         END DO 
     816      END DO 
    717817 
    718818      ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al.  2012) (clem) 
    … …  
    731831      ! 
    732832      zztmp = 1. / ( 1. - albo ) 
    733       !                                     ! ========================== ! 
    734       DO jl = 1, jpl                        !  Loop over ice categories  ! 
    735          !                                  ! ========================== ! 
     833!$OMP PARALLEL 
     834!$OMP DO schedule(static) private(jl,jj,ji,zst2,zst3)            ! ========================== ! 
     835      DO jl = 1, jpl                                             !  Loop over ice categories  ! 
     836         !                                                       ! ========================== ! 
    736837         DO jj = 1 , jpj 
    737838            DO ji = 1, jpi 
    … …  
    781882      END DO 
    782883      ! 
    783       tprecip(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
    784       sprecip(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
     884!$OMP DO schedule(static) private(jj, ji) 
     885      DO jj = 1, jpj 
     886         DO ji = 1, jpi 
     887            tprecip(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) * rn_pfac      ! total precipitation [kg/m2/s] 
     888            sprecip(ji,jj) = sf(jp_snow)%fnow(ji,jj,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
     889         END DO 
     890      END DO 
     891!$OMP END PARALLEL 
    785892      CALL iom_put( 'snowpre', sprecip * 86400. )                  ! Snow precipitation 
    786893      CALL iom_put( 'precip' , tprecip * 86400. )                  ! Total precipitation 
    … …  
    791898      ! --- evaporation --- ! 
    792899      z1_lsub = 1._wp / Lsub 
    793       evap_ice (:,:,:) = rn_efac * qla_ice (:,:,:) * z1_lsub    ! sublimation 
    794       devap_ice(:,:,:) = rn_efac * dqla_ice(:,:,:) * z1_lsub    ! d(sublimation)/dT 
    795       zevap    (:,:)   = rn_efac * ( emp(:,:) + tprecip(:,:) )  ! evaporation over ocean 
    796  
    797       ! --- evaporation minus precipitation --- ! 
    798       zsnw(:,:) = 0._wp 
     900!$OMP PARALLEL 
     901!$OMP DO schedule(static) private(jl,jj,ji) 
     902      DO jl = 1, jpl 
     903         DO jj = 1 , jpj 
     904            DO ji = 1, jpi 
     905               evap_ice (ji,jj,jl) = rn_efac * qla_ice (ji,jj,jl) * z1_lsub    ! sublimation 
     906               devap_ice(ji,jj,jl) = rn_efac * dqla_ice(ji,jj,jl) * z1_lsub    ! d(sublimation)/dT 
     907            END DO 
     908         END DO 
     909      END DO 
     910      ! 
     911!$OMP DO schedule(static) private(jj, ji) 
     912      DO jj = 1, jpj 
     913         DO ji = 1, jpi 
     914            zevap    (ji,jj)   = rn_efac * ( emp(ji,jj) + tprecip(ji,jj) )  ! evaporation over ocean 
     915 
     916            ! --- evaporation minus precipitation --- ! 
     917            zsnw(ji,jj) = 0._wp 
     918         END DO 
     919      END DO 
     920!$OMP END PARALLEL 
    799921      CALL lim_thd_snwblow( pfrld, zsnw )  ! snow distribution over ice after wind blowing 
    800       emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 
    801       emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 
    802       emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 
    803  
    804       ! --- heat flux associated with emp --- ! 
    805       qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp                               & ! evap at sst 
    806          &          + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp  & ! liquid precip at Tair 
    807          &          +   sprecip(:,:) * ( 1._wp - zsnw ) *                                        & ! solid precip at min(Tair,Tsnow) 
    808          &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
    809       qemp_ice(:,:) =   sprecip(:,:) * zsnw *                                                    & ! solid precip (only) 
    810          &              ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
    811  
    812       ! --- total solar and non solar fluxes --- ! 
    813       qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 
    814       qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 
    815  
    816       ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    817       qprec_ice(:,:) = rhosn * ( ( MIN( sf(jp_tair)%fnow(:,:,1), rt0_snow ) - rt0 ) * cpic * tmask(:,:,1) - lfus ) 
     922!$OMP PARALLEL 
     923!$OMP DO schedule(static) private(jj,ji) 
     924      DO jj = 1, jpj 
     925         DO ji = 1, jpi 
     926            emp_oce(ji,jj) = pfrld(ji,jj) * zevap(ji,jj) - ( tprecip(ji,jj) - sprecip(ji,jj) ) - sprecip(ji,jj) * (1._wp - zsnw(ji,jj)) 
     927         END DO 
     928      END DO 
     929!$OMP END DO NOWAIT 
     930!$OMP DO schedule(static) private(jl,jj,ji) 
     931      DO jl = 1, jpl 
     932         DO jj = 1 , jpj 
     933            DO ji = 1, jpi 
     934               zevap_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * evap_ice(ji,jj,jl) 
     935               zqns_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * qns_ice(ji,jj,jl) 
     936               zqsr_ice3d(ji,jj,jl) = a_i_b(ji,jj,jl) * qsr_ice(ji,jj,jl) 
     937            END DO 
     938         END DO 
     939      END DO 
     940!$OMP END DO NOWAIT 
     941!$OMP DO schedule(static) private(jj,ji) 
     942      DO jj = 1, jpj 
     943         DO ji = 1, jpi 
     944            zevap_ice2d(ji,jj) = 0._wp  
     945            zqns_ice2d(ji,jj) = 0._wp 
     946            zqsr_ice2d(ji,jj) = 0._wp 
     947         END DO 
     948      END DO 
     949      DO jl = 1, jpl 
     950!$OMP DO schedule(static) private(jj,ji) 
     951         DO jj = 1 , jpj 
     952            DO ji = 1, jpi 
     953               zevap_ice2d(ji,jj) = zevap_ice2d(ji,jj) + zevap_ice3d(ji,jj,jl) 
     954               zqns_ice2d(ji,jj) = zqns_ice2d(ji,jj) + zqns_ice3d(ji,jj,jl) 
     955               zqsr_ice2d(ji,jj) = zqsr_ice2d(ji,jj) + zqsr_ice3d(ji,jj,jl) 
     956            END DO 
     957         END DO 
     958      END DO 
     959!$OMP DO schedule(static) private(jj,ji) 
     960      DO jj = 1 , jpj 
     961         DO ji = 1, jpi 
     962            emp_ice(ji,jj) = zevap_ice2d(ji,jj) - sprecip(ji,jj) * zsnw(ji,jj) 
     963            emp_tot(ji,jj) = emp_oce(ji,jj) + emp_ice(ji,jj) 
     964 
     965            ! --- heat flux associated with emp --- ! 
     966            qemp_oce(ji,jj) = - pfrld(ji,jj) * zevap(ji,jj) * sst_m(ji,jj) * rcp                                & ! evap at sst 
     967               &          + ( tprecip(ji,jj) - sprecip(ji,jj) ) * ( sf(jp_tair)%fnow(ji,jj,1) - rt0 ) * rcp     & ! liquid precip at Tair 
     968               &          +   sprecip(ji,jj) * ( 1._wp - zsnw(ji,jj) ) *                                        & ! solid precip at min(Tair,Tsnow) 
     969               &              ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 
     970            qemp_ice(ji,jj) =   sprecip(ji,jj) * zsnw(ji,jj) *                                                  & ! solid precip (only) 
     971               &              ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 
     972 
     973            ! --- total solar and non solar fluxes --- ! 
     974            qns_tot(ji,jj) = pfrld(ji,jj) * qns_oce(ji,jj) + zqns_ice2d(ji,jj) + qemp_ice(ji,jj) + qemp_oce(ji,jj) 
     975            qsr_tot(ji,jj) = pfrld(ji,jj) * qsr_oce(ji,jj) + zqsr_ice2d(ji,jj) 
     976 
     977            ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
     978            qprec_ice(ji,jj) = rhosn * ( ( MIN( sf(jp_tair)%fnow(ji,jj,1), rt0_snow ) - rt0 ) * cpic * tmask(ji,jj,1) - lfus ) 
     979         END DO 
     980      END DO 
     981!$OMP END DO NOWAIT 
    818982 
    819983      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- 
     984!$OMP DO schedule(static) private(jl,jj,ji) 
    820985      DO jl = 1, jpl 
    821          qevap_ice(:,:,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 
    822                                    ! But we do not have Tice => consider it at 0degC => evap=0  
    823       END DO 
     986         DO jj = 1, jpj 
     987            DO ji = 1, jpi 
     988               qevap_ice(ji,jj,jl) = 0._wp ! should be -evap_ice(:,:,jl)*( ( Tice - rt0 ) * cpic * tmask(:,:,1) ) 
     989                                           ! But we do not have Tice => consider it at 0degC => evap=0  
     990            END DO 
     991         END DO 
     992      END DO 
     993!$OMP END PARALLEL 
    824994 
    825995      CALL wrk_dealloc( jpi,jpj,   zevap, zsnw ) 
    … …  
    8311001      ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 
    8321002      ! 
    833       fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
    834       fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     1003!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     1004      DO jj = 1, jpj 
     1005         DO ji = 1, jpi 
     1006            fr1_i0(ji,jj) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 
     1007            fr2_i0(ji,jj) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
     1008         END DO 
     1009      END DO 
    8351010      ! 
    8361011      ! 
    … …  
    8441019      ENDIF 
    8451020 
    846       CALL wrk_dealloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb ) 
     1021      CALL wrk_dealloc( jpi,jpj,jpl,   z_qlw, z_qsb, z_dqlw, z_dqsb, zevap_ice3d, zqns_ice3d, zqsr_ice3d ) 
    8471022      CALL wrk_dealloc( jpi,jpj,       zrhoa ) 
    848       CALL wrk_dealloc( jpi,jpj, Cd ) 
     1023      CALL wrk_dealloc( jpi,jpj, Cd, zevap_ice2d, zqns_ice2d, zqsr_ice2d) 
    8491024      ! 
    8501025      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_flx') 
    … …  
    9081083      !!---------------------------------------------------------------------------------- 
    9091084      ! 
     1085!$OMP PARALLEL DO schedule(static) private(jj,ji,ztmp,ze_sat) 
    9101086      DO jj = 1, jpj 
    9111087         DO ji = 1, jpi 
    … …  
    9441120      !!---------------------------------------------------------------------------------- 
    9451121      ! 
     1122!$OMP PARALLEL DO schedule(static) private(jj,ji,zrv,ziRT) 
    9461123      DO jj = 1, jpj 
    9471124         DO ji = 1, jpi 

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

    r7646 r7698  
    114114      ! 
    115115      INTEGER ::   j_itt 
     116      INTEGER ::   ji, jj             ! dummy loop indices 
    116117      LOGICAL ::   l_zt_equal_zu = .FALSE.      ! if q and t are given at same height as U 
    117118      INTEGER , PARAMETER ::   nb_itt = 4       ! number of itterations 
    … …  
    141142      !! Neutral coefficients at 10m: 
    142143      IF( ln_cdgw ) THEN      ! wave drag case 
    143          cdn_wave(:,:) = cdn_wave(:,:) + rsmall * ( 1._wp - tmask(:,:,1) ) 
    144          ztmp0   (:,:) = cdn_wave(:,:) 
     144!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     145         DO jj = 1, jpj 
     146            DO ji = 1, jpi 
     147               cdn_wave(ji,jj) = cdn_wave(ji,jj) + rsmall * ( 1._wp - tmask(ji,jj,1) ) 
     148               ztmp0   (ji,jj) = cdn_wave(ji,jj) 
     149            END DO 
     150         END DO 
    145151      ELSE 
    146152         ztmp0 = cd_neutral_10m( U_blk ) 
    … …  
    245251      !!---------------------------------------------------------------------------------- 
    246252      ! 
     253!$OMP PARALLEL DO schedule(static) private(jj,ji,zw,zw6,zgt33) 
    247254      DO jj = 1, jpj 
    248255         DO ji = 1, jpi 
    … …  
    284291      !!---------------------------------------------------------------------------------- 
    285292      ! 
     293!$OMP PARALLEL DO schedule(static) private(jj,ji,zx2,zx,zstab) 
    286294      DO jj = 1, jpj 
    287295         DO ji = 1, jpi 
    … …  
    318326      !!---------------------------------------------------------------------------------- 
    319327      ! 
     328!$OMP PARALLEL DO schedule(static) private(jj,ji,zx2,zstab) 
    320329      DO jj = 1, jpj 
    321330         DO ji = 1, jpi 

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

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

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

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

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

    r7646 r7698  
    103103      INTEGER, INTENT(in) ::   kt          ! ocean time step 
    104104      ! 
    105       INTEGER  ::   ji, jj    ! dummy loop indices 
    106       INTEGER  ::   z_err = 0 ! dummy integer for error handling 
     105      INTEGER  ::   ji, jj, jn    ! dummy loop indices 
     106      INTEGER  ::   z_err = 0     ! dummy integer for error handling 
    107107      !!---------------------------------------------------------------------- 
    108108      REAL(wp), DIMENSION(:,:), POINTER       ::   ztfrz   ! freezing point used for temperature correction 
    … …  
    120120      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    121121         ! 
    122          IF( .NOT. l_rnfcpl )   rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )       ! updated runoff value at time step kt 
     122         IF( .NOT. l_rnfcpl ) THEN                             ! updated runoff value at time step kt 
     123!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     124            DO jj = 1, jpj 
     125               DO ji = 1, jpi 
     126                  rnf(ji,jj) = rn_rfact * ( sf_rnf(1)%fnow(ji,jj,1) ) 
     127               END DO 
     128            END DO 
     129         END IF 
    123130         ! 
    124131         !                                                     ! set temperature & salinity content of runoffs 
    125132         IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data 
    126             rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
     133!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     134            DO jj = 1, jpj 
     135               DO ji = 1, jpi 
     136                  rnf_tsc(ji,jj,jp_tem) = ( sf_t_rnf(1)%fnow(ji,jj,1) ) * rnf(ji,jj) * r1_rau0 
     137               END DO 
     138            END DO 
    127139            CALL eos_fzp( sss_m(:,:), ztfrz(:,:) ) 
    128             WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999._wp )             ! if missing data value use SST as runoffs temperature 
    129                rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    130             END WHERE 
    131             WHERE( sf_t_rnf(1)%fnow(:,:,1) == -222._wp )             ! where fwf comes from melting of ice shelves or iceberg 
    132                rnf_tsc(:,:,jp_tem) = ztfrz(:,:) * rnf(:,:) * r1_rau0 - rnf(:,:) * rlfusisf * r1_rau0_rcp 
    133             END WHERE 
     140!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     141            DO jj = 1, jpj 
     142               DO ji = 1, jpi 
     143                  IF ( sf_t_rnf(1)%fnow(ji,jj,1) == -999._wp ) THEN            ! if missing data value use SST as runoffs temperature 
     144                     rnf_tsc(ji,jj,jp_tem) = sst_m(ji,jj) * rnf(ji,jj) * r1_rau0 
     145                  END IF 
     146                  IF ( sf_t_rnf(1)%fnow(ji,jj,1) == -222._wp ) THEN            ! where fwf comes from melting of ice shelves or iceberg 
     147                     rnf_tsc(ji,jj,jp_tem) = ztfrz(ji,jj) * rnf(ji,jj) * r1_rau0 - rnf(ji,jj) * rlfusisf * r1_rau0_rcp 
     148                  END IF 
     149               END DO 
     150            END DO 
    134151         ELSE                                                        ! use SST as runoffs temperature 
    135             rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0 
    136          ENDIF 
     152!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     153            DO jj = 1, jpj 
     154               DO ji = 1, jpi 
     155                  rnf_tsc(ji,jj,jp_tem) = sst_m(ji,jj) * rnf(ji,jj) * r1_rau0 
     156               END DO 
     157            END DO 
     158         END IF 
    137159         !                                                           ! use runoffs salinity data 
    138          IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 
    139          !                                                           ! else use S=0 for runoffs (done one for all in the init) 
     160         IF( ln_rnf_sal ) THEN 
     161!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     162            DO jj = 1, jpj 
     163               DO ji = 1, jpi 
     164                  rnf_tsc(ji,jj,jp_sal) = ( sf_s_rnf(1)%fnow(ji,jj,1) ) * rnf(ji,jj) * r1_rau0 
     165               END DO 
     166            END DO 
     167         END IF 
     168         !                                                        ! else use S=0 for runoffs (done one for all in the init) 
    140169         CALL iom_put( "runoffs", rnf )         ! output runoffs arrays 
    141170      ENDIF 
    … …  
    152181         ELSE                                                   !* no restart: set from nit000 values 
    153182            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    154             rnf_b    (:,:  ) = rnf    (:,:  ) 
    155             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
     183!$OMP PARALLEL 
     184!$OMP DO schedule(static) private(jj,ji) 
     185            DO jj = 1, jpj 
     186               DO ji = 1, jpi 
     187                  rnf_b    (ji,jj  ) = rnf    (ji,jj  ) 
     188               END DO 
     189            END DO 
     190!$OMP END DO NOWAIT 
     191            DO jn = 1, jpts 
     192!$OMP DO schedule(static) private(jj,ji) 
     193               DO jj = 1, jpj 
     194                  DO ji = 1, jpi 
     195                     rnf_tsc_b(ji,jj,jn) = rnf_tsc(ji,jj,jn) 
     196                  END DO 
     197               END DO 
     198            END DO 
     199!$OMP END PARALLEL 
    156200         ENDIF 
    157201      ENDIF 
    … …  
    187231      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence 
    188232      !! 
    189       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     233      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    190234      REAL(wp) ::   zfact     ! local scalar 
    191235      !!---------------------------------------------------------------------- 
    … …  
    195239      IF( ln_rnf_depth .OR. ln_rnf_depth_ini ) THEN      !==   runoff distributed over several levels   ==! 
    196240         IF( ln_linssh ) THEN    !* constant volume case : just apply the runoff input flow 
     241!$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 
    197242            DO jj = 1, jpj 
    198243               DO ji = 1, jpi 
    … …  
    203248            END DO 
    204249         ELSE                    !* variable volume case 
     250!$OMP PARALLEL DO schedule(static) private(jj,ji,jk) 
    205251            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed 
    206252               DO ji = 1, jpi 
    … …  
    217263         ENDIF 
    218264      ELSE                       !==   runoff put only at the surface   ==! 
    219          h_rnf (:,:)   = e3t_n (:,:,1)        ! update h_rnf to be depth of top box 
    220          phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / e3t_n(:,:,1) 
     265!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     266         DO jj = 1, jpj 
     267            DO ji = 1, jpi 
     268               h_rnf (ji,jj)   = e3t_n (ji,jj,1)        ! update h_rnf to be depth of top box 
     269               phdivn(ji,jj,1) = phdivn(ji,jj,1) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / e3t_n(ji,jj,1) 
     270            END DO 
     271         END DO 
    221272      ENDIF 
    222273      ! 
    … …  
    235286      !!---------------------------------------------------------------------- 
    236287      CHARACTER(len=32) ::   rn_dep_file   ! runoff file name 
    237       INTEGER           ::   ji, jj, jk, jm    ! dummy loop indices 
     288      INTEGER           ::   ji, jj, jk, jm, jn    ! dummy loop indices 
    238289      INTEGER           ::   ierror, inum  ! temporary integer 
    239290      INTEGER           ::   ios           ! Local integer output status for namelist read 
    … …  
    256307         ln_rnf_mouth  = .FALSE.                   ! default definition needed for example by sbc_ssr or by tra_adv_muscl 
    257308         nkrnf         = 0 
    258          rnf     (:,:) = 0.0_wp 
    259          rnf_b   (:,:) = 0.0_wp 
    260          rnfmsk  (:,:) = 0.0_wp 
    261          rnfmsk_z(:)   = 0.0_wp 
     309!$OMP PARALLEL 
     310!$OMP DO schedule(static) private(jj, ji) 
     311         DO jj = 1, jpj 
     312            DO ji = 1, jpi 
     313               rnf     (ji,jj) = 0.0_wp 
     314               rnf_b   (ji,jj) = 0.0_wp 
     315               rnfmsk  (ji,jj) = 0.0_wp 
     316            END DO 
     317         END DO 
     318!$OMP END DO NOWAIT 
     319!$OMP DO schedule(static) private(jk) 
     320         DO jk = 1, jpk 
     321            rnfmsk_z(jk)   = 0.0_wp 
     322         END DO 
     323!$OMP END PARALLEL 
    262324         RETURN 
    263325      ENDIF 
    … …  
    338400         CALL iom_close( inum )                                        ! close file 
    339401         ! 
    340          nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
     402!$OMP PARALLEL 
     403!$OMP DO schedule(static) private(jj, ji) 
     404         DO jj = 1, jpj 
     405            DO ji = 1, jpi 
     406               nk_rnf(ji,jj) = 0                               ! set the number of level over which river runoffs are applied 
     407            END DO 
     408         END DO 
     409!$OMP DO schedule(static) private(jj, ji, jk) 
    341410         DO jj = 1, jpj 
    342411            DO ji = 1, jpi 
    … …  
    354423            END DO 
    355424         END DO 
     425!$OMP DO schedule(static) private(jj, ji, jk) 
    356426         DO jj = 1, jpj                                ! set the associated depth 
    357427            DO ji = 1, jpi 
    … …  
    362432            END DO 
    363433         END DO 
     434!$OMP END PARALLEL 
    364435         ! 
    365436      ELSE IF( ln_rnf_depth_ini ) THEN           ! runoffs applied at the surface 
    … …  
    381452         DEALLOCATE( zrnfcl ) 
    382453         ! 
    383          h_rnf(:,:) = 1. 
    384          ! 
    385454         zacoef = rn_dep_max / rn_rnf_max            ! coef of linear relation between runoff and its depth (150m for max of runoff) 
    386455         ! 
    387          WHERE( zrnf(:,:) > 0._wp )  h_rnf(:,:) = zacoef * zrnf(:,:)   ! compute depth for all runoffs 
    388          ! 
     456!$OMP PARALLEL 
     457         IF( zrnf(ji,jj) > 0._wp ) THEN 
     458!$OMP DO schedule(static) private(jj, ji) 
     459            DO jj = 1, jpj 
     460               DO ji = 1, jpi 
     461                  h_rnf(ji,jj) = zacoef * zrnf(ji,jj)   ! compute depth for all runoffs 
     462               END DO 
     463            END DO 
     464         END IF 
     465         ! 
     466!$OMP DO schedule(static) private(jj, ji, jk) 
    389467         DO jj = 1, jpj                     ! take in account min depth of ocean rn_hmin 
    390468            DO ji = 1, jpi 
    … …  
    396474         END DO 
    397475         ! 
    398          nk_rnf(:,:) = 0                       ! number of levels on which runoffs are distributed 
     476!$OMP DO schedule(static) private(jj, ji) 
     477         DO jj = 1, jpj 
     478            DO ji = 1, jpi 
     479               nk_rnf(ji,jj) = 0                       ! number of levels on which runoffs are distributed 
     480            END DO 
     481         END DO 
     482!$OMP DO schedule(static) private(jj, ji, jk) 
    399483         DO jj = 1, jpj 
    400484            DO ji = 1, jpi 
    … …  
    409493            END DO 
    410494         END DO 
     495!$OMP END PARALLEL 
    411496         ! 
    412497         DEALLOCATE( zrnf ) 
    413498         ! 
     499!$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    414500         DO jj = 1, jpj                                ! set the associated depth 
    415501            DO ji = 1, jpi 
    … …  
    428514         ENDIF 
    429515      ELSE                                       ! runoffs applied at the surface 
    430          nk_rnf(:,:) = 1 
    431          h_rnf (:,:) = e3t_n(:,:,1) 
    432       ENDIF 
    433       ! 
    434       rnf(:,:) =  0._wp                         ! runoff initialisation 
    435       rnf_tsc(:,:,:) = 0._wp                    ! runoffs temperature & salinty contents initilisation 
     516!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     517         DO jj = 1, jpj 
     518            DO ji = 1, jpi 
     519               nk_rnf(ji,jj) = 1 
     520               h_rnf (ji,jj) = e3t_n(ji,jj,1) 
     521            END DO 
     522         END DO 
     523      ENDIF 
     524      ! 
     525!$OMP PARALLEL 
     526!$OMP DO schedule(static) private(jj, ji) 
     527      DO jj = 1, jpj 
     528         DO ji = 1, jpi 
     529            rnf(ji,jj) =  0._wp                         ! runoff initialisation 
     530         END DO 
     531      END DO 
     532!$OMP END DO NOWAIT 
     533      DO jn = 1, jpts 
     534!$OMP DO schedule(static) private(jj, ji) 
     535         DO jj = 1, jpj 
     536            DO ji = 1, jpi 
     537               rnf_tsc(ji,jj,jn) = 0._wp                    ! runoffs temperature & salinty contents initilisation 
     538            END DO 
     539         END DO 
     540      END DO 
     541!$OMP END PARALLEL 
    436542      ! 
    437543      !                                   ! ======================== 
    … …  
    466572         IF(lwp) WRITE(numout,*) 
    467573         IF(lwp) WRITE(numout,*) '          No specific treatment at river mouths' 
    468          rnfmsk  (:,:) = 0._wp 
    469          rnfmsk_z(:)   = 0._wp 
     574!$OMP PARALLEL 
     575!$OMP DO schedule(static) private(jj, ji) 
     576         DO jj = 1, jpj 
     577            DO ji = 1, jpi 
     578               rnfmsk  (ji,jj) = 0._wp 
     579            END DO 
     580         END DO 
     581!$OMP END DO NOWAIT 
     582!$OMP DO schedule(static) private(jk) 
     583         DO jk = 1, jpk 
     584            rnfmsk_z(jk)   = 0._wp 
     585         END DO 
     586!$OMP END PARALLEL 
    470587         nkrnf = 0 
    471588      ENDIF 

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

    r7646 r7698  
    5959      ! 
    6060      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 
     61!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    6162      DO jj = 1, jpj 
    6263         DO ji = 1, jpi 
    … …  
    6869      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    6970         !                                                ! ---------------------------------------- ! 
    70          ssu_m(:,:) = ub(:,:,1) 
    71          ssv_m(:,:) = vb(:,:,1) 
    72          IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    73          ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
    74          ENDIF 
    75          sss_m(:,:) = zts(:,:,jp_sal) 
     71!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     72         DO jj = 1, jpj 
     73            DO ji = 1, jpi 
     74               ssu_m(ji,jj) = ub(ji,jj,1) 
     75               ssv_m(ji,jj) = vb(ji,jj,1) 
     76            END DO 
     77         END DO 
     78         IF( l_useCT )  THEN 
     79           sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     80         ELSE                     
     81!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     82            DO jj = 1, jpj 
     83               DO ji = 1, jpi 
     84                  sst_m(ji,jj) = zts(ji,jj,jp_tem) 
     85               END DO 
     86            END DO 
     87         ENDIF 
     88!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     89         DO jj = 1, jpj 
     90            DO ji = 1, jpi 
     91               sss_m(ji,jj) = zts(ji,jj,jp_sal) 
     92            END DO 
     93         END DO 
    7694         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    77          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    78          ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
    79          ENDIF 
    80          ! 
    81          e3t_m(:,:) = e3t_n(:,:,1) 
    82          ! 
    83          frq_m(:,:) = fraqsr_1lev(:,:) 
     95         IF( ln_apr_dyn ) THEN   
     96!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     97            DO jj = 1, jpj 
     98               DO ji = 1, jpi 
     99                  ssh_m(ji,jj) = sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) 
     100               END DO 
     101            END DO 
     102         ELSE                     
     103!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     104            DO jj = 1, jpj 
     105               DO ji = 1, jpi 
     106                  ssh_m(ji,jj) = sshn(ji,jj) 
     107               END DO 
     108            END DO 
     109         ENDIF 
     110         ! 
     111!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     112         DO jj = 1, jpj 
     113            DO ji = 1, jpi 
     114               e3t_m(ji,jj) = e3t_n(ji,jj,1) 
     115         ! 
     116               frq_m(ji,jj) = fraqsr_1lev(ji,jj) 
     117            END DO 
     118         END DO 
    84119         ! 
    85120      ELSE 
    … …  
    91126            IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    92127            zcoef = REAL( nn_fsbc - 1, wp ) 
    93             ssu_m(:,:) = zcoef * ub(:,:,1) 
    94             ssv_m(:,:) = zcoef * vb(:,:,1) 
    95             IF( l_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    96             ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
     128!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     129            DO jj = 1, jpj 
     130               DO ji = 1, jpi 
     131                  ssu_m(ji,jj) = zcoef * ub(ji,jj,1) 
     132                  ssv_m(ji,jj) = zcoef * vb(ji,jj,1) 
     133               END DO 
     134            END DO 
     135            IF( l_useCT )  THEN 
     136              sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     137            ELSE                     
     138!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     139              DO jj = 1, jpj 
     140                 DO ji = 1, jpi 
     141                    sst_m(ji,jj) = zcoef * zts(ji,jj,jp_tem) 
     142                 END DO 
     143              END DO 
    97144            ENDIF 
    98             sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
     145!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     146            DO jj = 1, jpj 
     147               DO ji = 1, jpi 
     148                  sss_m(ji,jj) = zcoef * zts(ji,jj,jp_sal) 
     149               END DO 
     150            END DO 
    99151            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    100             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    101             ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
     152            IF( ln_apr_dyn ) THEN    
     153!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     154               DO jj = 1, jpj 
     155                  DO ji = 1, jpi 
     156                     ssh_m(ji,jj) = zcoef * ( sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) ) 
     157                  END DO 
     158               END DO 
     159            ELSE                     
     160!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     161               DO jj = 1, jpj 
     162                  DO ji = 1, jpi 
     163                     ssh_m(ji,jj) = zcoef * sshn(ji,jj) 
     164                  END DO 
     165               END DO 
    102166            ENDIF 
    103167            ! 
    104             e3t_m(:,:) = zcoef * e3t_n(:,:,1) 
    105             ! 
    106             frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
     168!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     169            DO jj = 1, jpj 
     170               DO ji = 1, jpi 
     171                  e3t_m(ji,jj) = zcoef * e3t_n(ji,jj,1) 
     172                  ! 
     173                  frq_m(ji,jj) = zcoef * fraqsr_1lev(ji,jj) 
     174               END DO 
     175            END DO 
    107176            !                                             ! ---------------------------------------- ! 
    108177         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
    109178            !                                             ! ---------------------------------------- ! 
    110             ssu_m(:,:) = 0._wp     ! reset to zero ocean mean sbc fields 
    111             ssv_m(:,:) = 0._wp 
    112             sst_m(:,:) = 0._wp 
    113             sss_m(:,:) = 0._wp 
    114             ssh_m(:,:) = 0._wp 
    115             e3t_m(:,:) = 0._wp 
    116             frq_m(:,:) = 0._wp 
     179!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     180            DO jj = 1, jpj 
     181               DO ji = 1, jpi 
     182                  ssu_m(ji,jj) = 0._wp     ! reset to zero ocean mean sbc fields 
     183                  ssv_m(ji,jj) = 0._wp 
     184                  sst_m(ji,jj) = 0._wp 
     185                  sss_m(ji,jj) = 0._wp 
     186                  ssh_m(ji,jj) = 0._wp 
     187                  e3t_m(ji,jj) = 0._wp 
     188                  frq_m(ji,jj) = 0._wp 
     189               END DO 
     190            END DO 
    117191         ENDIF 
    118192         !                                                ! ---------------------------------------- ! 
    119193         !                                                !        Cumulate at each time step        ! 
    120194         !                                                ! ---------------------------------------- ! 
    121          ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
    122          ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    123          IF( l_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    124          ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
    125          ENDIF 
    126          sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
     195!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     196         DO jj = 1, jpj 
     197            DO ji = 1, jpi 
     198               ssu_m(ji,jj) = ssu_m(ji,jj) + ub(ji,jj,1) 
     199               ssv_m(ji,jj) = ssv_m(ji,jj) + vb(ji,jj,1) 
     200            END DO 
     201         END DO 
     202         IF( l_useCT )  THEN    
     203           sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
     204         ELSE                    
     205!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     206           DO jj = 1, jpj 
     207              DO ji = 1, jpi 
     208                 sst_m(ji,jj) = sst_m(ji,jj) + zts(ji,jj,jp_tem) 
     209              END DO 
     210           END DO 
     211         ENDIF 
     212!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     213         DO jj = 1, jpj 
     214            DO ji = 1, jpi 
     215               sss_m(ji,jj) = sss_m(ji,jj) + zts(ji,jj,jp_sal) 
     216            END DO 
     217         END DO 
    127218         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    128          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    129          ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
    130          ENDIF 
    131          ! 
    132          e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 
    133          ! 
    134          frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 
     219         IF( ln_apr_dyn ) THEN    
     220!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     221            DO jj = 1, jpj 
     222               DO ji = 1, jpi 
     223                  ssh_m(ji,jj) = ssh_m(ji,jj) + sshn(ji,jj) - 0.5 * ( ssh_ib(ji,jj) + ssh_ibb(ji,jj) ) 
     224               END DO 
     225            END DO 
     226         ELSE                     
     227!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     228           DO jj = 1, jpj 
     229              DO ji = 1, jpi 
     230                 ssh_m(ji,jj) = ssh_m(ji,jj) + sshn(ji,jj) 
     231              END DO 
     232           END DO 
     233         ENDIF 
     234         ! 
     235!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     236         DO jj = 1, jpj 
     237            DO ji = 1, jpi 
     238               e3t_m(ji,jj) = e3t_m(ji,jj) + e3t_n(ji,jj,1) 
     239               ! 
     240               frq_m(ji,jj) = frq_m(ji,jj) + fraqsr_1lev(ji,jj) 
     241            END DO 
     242         END DO 
    135243 
    136244         !                                                ! ---------------------------------------- ! 
    … …  
    138246            !                                             ! ---------------------------------------- ! 
    139247            zcoef = 1. / REAL( nn_fsbc, wp ) 
    140             sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celsius] 
    141             sss_m(:,:) = sss_m(:,:) * zcoef     ! mean SSS             [psu] 
    142             ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s] 
    143             ssv_m(:,:) = ssv_m(:,:) * zcoef     ! 
    144             ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m] 
    145             e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m] 
    146             frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
     248!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     249            DO jj = 1, jpj 
     250               DO ji = 1, jpi 
     251                  sst_m(ji,jj) = sst_m(ji,jj) * zcoef     ! mean SST             [Celsius] 
     252                  sss_m(ji,jj) = sss_m(ji,jj) * zcoef     ! mean SSS             [psu] 
     253                  ssu_m(ji,jj) = ssu_m(ji,jj) * zcoef     ! mean suface current  [m/s] 
     254                  ssv_m(ji,jj) = ssv_m(ji,jj) * zcoef     ! 
     255                  ssh_m(ji,jj) = ssh_m(ji,jj) * zcoef     ! mean SSH             [m] 
     256                  e3t_m(ji,jj) = e3t_m(ji,jj) * zcoef     ! mean vertical scale factor [m] 
     257                  frq_m(ji,jj) = frq_m(ji,jj) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
     258               END DO 
     259            END DO 
    147260            ! 
    148261         ENDIF 
    … …  
    190303      !!---------------------------------------------------------------------- 
    191304      REAL(wp) ::   zcoef, zf_sbc   ! local scalar 
     305      INTEGER  ::   ji, jj          ! loop index 
    192306      !!---------------------------------------------------------------------- 
    193307      ! 
    … …  
    217331               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  ) 
    218332            ELSE 
    219                frq_m(:,:) = 1._wp   ! default definition 
     333!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     334               DO jj = 1, jpj 
     335                  DO ji = 1, jpi 
     336                     frq_m(ji,jj) = 1._wp   ! default definition 
     337                  END DO 
     338               END DO 
    220339            ENDIF 
    221340            ! 
    … …  
    223342               IF(lwp) WRITE(numout,*) '   restart with a change in the frequency of mean from ', zf_sbc, ' to ', nn_fsbc  
    224343               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc  
    225                ssu_m(:,:) = zcoef * ssu_m(:,:)  
    226                ssv_m(:,:) = zcoef * ssv_m(:,:) 
    227                sst_m(:,:) = zcoef * sst_m(:,:) 
    228                sss_m(:,:) = zcoef * sss_m(:,:) 
    229                ssh_m(:,:) = zcoef * ssh_m(:,:) 
    230                e3t_m(:,:) = zcoef * e3t_m(:,:) 
    231                frq_m(:,:) = zcoef * frq_m(:,:) 
     344!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     345               DO jj = 1, jpj 
     346                  DO ji = 1, jpi 
     347                     ssu_m(ji,jj) = zcoef * ssu_m(ji,jj)  
     348                     ssv_m(ji,jj) = zcoef * ssv_m(ji,jj) 
     349                     sst_m(ji,jj) = zcoef * sst_m(ji,jj) 
     350                     sss_m(ji,jj) = zcoef * sss_m(ji,jj) 
     351                     ssh_m(ji,jj) = zcoef * ssh_m(ji,jj) 
     352                     e3t_m(ji,jj) = zcoef * e3t_m(ji,jj) 
     353                     frq_m(ji,jj) = zcoef * frq_m(ji,jj) 
     354                  END DO 
     355               END DO 
    232356            ELSE 
    233357               IF(lwp) WRITE(numout,*) '   mean fields read in the ocean restart file' 
    … …  
    239363         ! 
    240364         IF(lwp) WRITE(numout,*) '   default initialisation of ss._m arrays' 
    241          ssu_m(:,:) = ub(:,:,1) 
    242          ssv_m(:,:) = vb(:,:,1) 
     365!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     366            DO jj = 1, jpj 
     367               DO ji = 1, jpi 
     368                  ssu_m(ji,jj) = ub(ji,jj,1) 
     369                  ssv_m(ji,jj) = vb(ji,jj,1) 
     370               END DO 
     371            END DO 
    243372         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
    244373         ELSE                   ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
    245374         ENDIF 
    246          sss_m(:,:) = tsn  (:,:,1,jp_sal) 
    247          ssh_m(:,:) = sshn (:,:) 
    248          e3t_m(:,:) = e3t_n(:,:,1) 
    249          frq_m(:,:) = 1._wp 
     375!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     376         DO jj = 1, jpj 
     377            DO ji = 1, jpi 
     378               sss_m(ji,jj) = tsn  (ji,jj,1,jp_sal) 
     379               ssh_m(ji,jj) = sshn (ji,jj) 
     380               e3t_m(ji,jj) = e3t_n(ji,jj,1) 
     381               frq_m(ji,jj) = 1._wp 
     382            END DO 
     383         END DO 
    250384         ! 
    251385      ENDIF 

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

    r7646 r7698  
    9393            ! 
    9494            IF( nn_sstr == 1 ) THEN                                   !* Temperature restoring term 
     95!$OMP PARALLEL DO schedule(static) private(jj,ji,zqrp) 
    9596               DO jj = 1, jpj 
    9697                  DO ji = 1, jpi 
    … …  
    105106            IF( nn_sssr == 1 ) THEN                                   !* Salinity damping term (salt flux only (sfx)) 
    106107               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
     108!$OMP PARALLEL DO schedule(static) private(jj, ji, zerp) 
    107109               DO jj = 1, jpj 
    108110                  DO ji = 1, jpi 
    … …  
    118120               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    119121               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
     122!$OMP PARALLEL DO schedule(static) private(jj, ji, zerp) 
    120123               DO jj = 1, jpj 
    121124                  DO ji = 1, jpi                             

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

    r7646 r7698  
    237237      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    238238         ! 
     239!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    239240         DO jk = 1, jpkm1 
    240241            DO jj = 1, jpj 
    … …  
    277278      CASE( np_seos )                !==  simplified EOS  ==! 
    278279         ! 
     280!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    279281         DO jk = 1, jpkm1 
    280282            DO jj = 1, jpj 
    … …  
    345347            END DO 
    346348            ! 
     349!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, jsmp, jdof, zh, zt, zstemp, zs, ztm, zn3, zn2, zn1) 
    347350            DO jk = 1, jpkm1 
    348351               DO jj = 1, jpj 
    … …  
    399402         ! Non-stochastic equation of state 
    400403         ELSE 
     404!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    401405            DO jk = 1, jpkm1 
    402406               DO jj = 1, jpj 
    … …  
    441445      CASE( np_seos )                !==  simplified EOS  ==! 
    442446         ! 
     447!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    443448         DO jk = 1, jpkm1 
    444449            DO jj = 1, jpj 
    … …  
    493498      IF( nn_timing == 1 )   CALL timing_start('eos2d') 
    494499      ! 
    495       prd(:,:) = 0._wp 
     500!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     501      DO jj = 1, jpj 
     502         DO ji = 1, jpi 
     503            prd(ji,jj) = 0._wp 
     504         END DO 
     505      END DO 
    496506      ! 
    497507      SELECT CASE( neos ) 
    … …  
    499509      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    500510         ! 
     511!$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn) 
    501512         DO jj = 1, jpjm1 
    502513            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    538549      CASE( np_seos )                !==  simplified EOS  ==! 
    539550         ! 
     551!$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn) 
    540552         DO jj = 1, jpjm1 
    541553            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    589601      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    590602         ! 
     603!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    591604         DO jk = 1, jpkm1 
    592605            DO jj = 1, jpj 
    … …  
    646659      CASE( np_seos )                  !==  simplified EOS  ==! 
    647660         ! 
     661!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    648662         DO jk = 1, jpkm1 
    649663            DO jj = 1, jpj 
    … …  
    698712      IF( nn_timing == 1 ) CALL timing_start('rab_2d') 
    699713      ! 
    700       pab(:,:,:) = 0._wp 
     714!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     715         DO jk = 1, jpts 
     716            DO jj = 1, jpj 
     717               DO ji = 1, jpi 
     718                  pab(ji,jj,jk) = 0._wp 
     719               END DO 
     720            END DO 
     721         END DO 
    701722      ! 
    702723      SELECT CASE ( neos ) 
    … …  
    704725      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    705726         ! 
     727!$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn3, zn2, zn1, zn0, zn) 
    706728         DO jj = 1, jpjm1 
    707729            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    762784      CASE( np_seos )                  !==  simplified EOS  ==! 
    763785         ! 
     786!$OMP PARALLEL DO schedule(static) private(jj, ji, zh, zt, zs, zn) 
    764787         DO jj = 1, jpjm1 
    765788            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    917940      IF( nn_timing == 1 ) CALL timing_start('bn2') 
    918941      ! 
     942!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrw, zaw, zbw) 
    919943      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    920944         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
    … …  
    952976      !!                Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 
    953977      !!---------------------------------------------------------------------- 
    954       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp   [Celsius] 
    955       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity     [psu] 
     978      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ctmp   ! Cons. Temp [Celsius] 
     979      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity   [psu] 
    956980      ! Leave result array automatic rather than making explicitly allocated 
    957981      REAL(wp), DIMENSION(jpi,jpj) ::   ptmp   ! potential temperature [Celsius] 
    … …  
    969993      z1_T0   = 1._wp/40._wp 
    970994      ! 
     995!$OMP PARALLEL DO schedule(static) private(jj, ji, zt, zs, ztm, zn,zd) 
    971996      DO jj = 1, jpj 
    972997         DO ji = 1, jpi 
    … …  
    10241049         ! 
    10251050         z1_S0 = 1._wp / 35.16504_wp 
     1051!$OMP PARALLEL 
     1052!$OMP DO schedule(static) private(jj, ji, zs) 
    10261053         DO jj = 1, jpj 
    10271054            DO ji = 1, jpi 
    … …  
    10311058            END DO 
    10321059         END DO 
    1033          ptf(:,:) = ptf(:,:) * psal(:,:) 
    1034          ! 
    1035          IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     1060!$OMP DO schedule(static) private(jj, ji) 
     1061         DO jj = 1, jpj 
     1062            DO ji = 1, jpi 
     1063               ptf(ji,jj) = ptf(ji,jj) * psal(ji,jj) 
     1064            END DO 
     1065         END DO 
     1066!$OMP END PARALLEL 
     1067         ! 
     1068         IF( PRESENT( pdep ) ) THEN 
     1069!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     1070           DO jj = 1, jpj 
     1071              DO ji = 1, jpi 
     1072                 ptf(ji,jj) = ptf(ji,jj) - 7.53e-4 * pdep(ji,jj) 
     1073              END DO 
     1074           END DO 
     1075         END IF 
    10361076         ! 
    10371077      CASE ( np_eos80 )                !==  PT,SP (UNESCO formulation)  ==! 
    10381078         ! 
    1039          ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   & 
    1040             &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:) 
     1079!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     1080         DO jj = 1, jpj 
     1081            DO ji = 1, jpi 
     1082            ptf(ji,jj) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(ji,jj) )   & 
     1083               &                     - 2.154996e-4_wp *       psal(ji,jj)   ) * psal(ji,jj) 
     1084            END DO 
     1085         END DO 
    10411086            ! 
    1042          IF( PRESENT( pdep ) )   ptf(:,:) = ptf(:,:) - 7.53e-4 * pdep(:,:) 
     1087         IF( PRESENT( pdep ) ) THEN 
     1088!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     1089           DO jj = 1, jpj 
     1090              DO ji = 1, jpi 
     1091                 ptf(ji,jj) = ptf(ji,jj) - 7.53e-4 * pdep(ji,jj) 
     1092              END DO 
     1093           END DO 
     1094         END IF 
    10431095         ! 
    10441096      CASE DEFAULT 
    … …  
    11341186      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    11351187         ! 
     1188!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn2, zn1, zn0, zn) 
    11361189         DO jk = 1, jpkm1 
    11371190            DO jj = 1, jpj 
    … …  
    11971250      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==! 
    11981251         ! 
     1252!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    11991253         DO jk = 1, jpkm1 
    12001254            DO jj = 1, jpj 

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

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

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

    r7646 r7698  
    113113      IF( l_trd .OR. l_hst )  THEN 
    114114         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    115          ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
     115!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     116         DO jk = 1, jpk 
     117            DO jj = 1, jpj 
     118               DO ji = 1, jpi 
     119                  ztrdx(ji,jj,jk) = 0._wp 
     120                  ztrdy(ji,jj,jk) = 0._wp 
     121                  ztrdz(ji,jj,jk) = 0._wp 
     122               END DO 
     123            END DO 
     124         END DO 
    116125      ENDIF 
    117126      ! 
    118127      IF( l_ptr ) THEN   
    119128         CALL wrk_alloc( jpi, jpj, jpk, zptry ) 
    120          zptry(:,:,:) = 0._wp 
     129!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     130         DO jk = 1, jpk 
     131            DO jj = 1, jpj 
     132               DO ji = 1, jpi 
     133                  zptry(ji,jj,jk) = 0._wp 
     134               END DO 
     135            END DO 
     136         END DO 
    121137      ENDIF 
    122138      !                          ! surface & bottom value : flux set to zero one for all 
    123       zwz(:,:, 1 ) = 0._wp             
    124       zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp 
    125       ! 
    126       zwi(:,:,:) = 0._wp         
     139!$OMP PARALLEL 
     140!$OMP DO schedule(static) private(jj, ji) 
     141      DO jj = 1, jpj 
     142         DO ji = 1, jpi 
     143            zwz(ji,jj, 1 ) = 0._wp 
     144            zwx(ji,jj,jpk) = 0._wp 
     145            zwy(ji,jj,jpk) = 0._wp 
     146            zwz(ji,jj,jpk) = 0._wp 
     147         END DO 
     148      END DO 
     149!$OMP END DO NOWAIT 
     150!$OMP DO schedule(static) private(jk, jj, ji) 
     151      DO jk = 1, jpk 
     152         DO jj = 1, jpj 
     153            DO ji = 1, jpi 
     154               zwi(ji,jj,jk) = 0._wp 
     155            END DO 
     156         END DO 
     157      END DO 
     158!$OMP END PARALLEL 
    127159      ! 
    128160      DO jn = 1, kjpt            !==  loop over the tracers  ==! 
    … …  
    130162         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
    131163         !                    !* upstream tracer flux in the i and j direction  
     164!$OMP PARALLEL 
     165!$OMP DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui,zfm_ui) 
    132166         DO jk = 1, jpkm1 
    133167            DO jj = 1, jpjm1 
    … …  
    143177            END DO 
    144178         END DO 
     179!$OMP END DO NOWAIT 
    145180         !                    !* upstream tracer flux in the k direction *! 
     181!$OMP DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk) 
    146182         DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask) 
    147183            DO jj = 1, jpj 
    … …  
    153189            END DO 
    154190         END DO 
     191!$OMP END PARALLEL 
    155192         IF( ln_linssh ) THEN    ! top ocean value (only in linear free surface as zwz has been w-masked) 
    156193            IF( ln_isfcav ) THEN             ! top of the ice-shelf cavities and at the ocean surface 
     194!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    157195               DO jj = 1, jpj 
    158196                  DO ji = 1, jpi 
    … …  
    161199               END DO    
    162200            ELSE                             ! no cavities: only at the ocean surface 
    163                zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
     201!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     202               DO jj = 1, jpj 
     203                  DO ji = 1, jpi 
     204                     zwz(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 
     205                  END DO 
     206               END DO 
    164207            ENDIF 
    165208         ENDIF 
    166209         !                
     210!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztra) 
    167211         DO jk = 1, jpkm1     !* trend and after field with monotonic scheme 
    168212            DO jj = 2, jpjm1 
    … …  
    181225         !                 
    182226         IF( l_trd .OR. l_hst )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
    183             ztrdx(:,:,:) = zwx(:,:,:)   ;   ztrdy(:,:,:) = zwy(:,:,:)   ;   ztrdz(:,:,:) = zwz(:,:,:) 
     227!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     228            DO jk = 1, jpk 
     229               DO jj = 1, jpj 
     230                  DO ji = 1, jpi 
     231                     ztrdx(ji,jj,jk) = zwx(ji,jj,jk) 
     232                     ztrdy(ji,jj,jk) = zwy(ji,jj,jk) 
     233                     ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 
     234                  END DO 
     235               END DO 
     236            END DO 
    184237         END IF 
    185238         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    186          IF( l_ptr )  zptry(:,:,:) = zwy(:,:,:)  
     239         IF( l_ptr ) THEN 
     240!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     241            DO jk = 1, jpk 
     242               DO jj = 1, jpj 
     243                  DO ji = 1, jpi 
     244                     zptry(ji,jj,jk) = zwy(ji,jj,jk) 
     245                  END DO 
     246               END DO 
     247            END DO 
     248         END IF 
    187249         ! 
    188250         !        !==  anti-diffusive flux : high order minus low order  ==! 
    … …  
    191253         ! 
    192254         CASE(  2  )                   !- 2nd order centered 
     255!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    193256            DO jk = 1, jpkm1 
    194257               DO jj = 1, jpjm1 
    … …  
    201264            ! 
    202265         CASE(  4  )                   !- 4th order centered 
    203             zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero 
    204             zltv(:,:,jpk) = 0._wp 
     266!$OMP PARALLEL  
     267!$OMP DO schedule(static) private(jj, ji) 
     268            DO jj = 1, jpj 
     269               DO ji = 1, jpi 
     270                  zltu(ji,jj,jpk) = 0._wp            ! Bottom value : flux set to zero 
     271                  zltv(ji,jj,jpk) = 0._wp 
     272               END DO 
     273            END DO 
     274!$OMP DO schedule(static) private(jk, jj, ji) 
    205275            DO jk = 1, jpkm1                 ! Laplacian 
    206276               DO jj = 1, jpjm1                    ! 1st derivative (gradient) 
    … …  
    217287               END DO 
    218288            END DO 
     289!$OMP END PARALLEL 
    219290            CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
    220291            ! 
     292!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v) 
    221293            DO jk = 1, jpkm1                 ! Horizontal advective fluxes 
    222294               DO jj = 1, jpjm1 
    … …  
    232304            ! 
    233305         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
    234             ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero 
    235             ztv(:,:,jpk) = 0._wp 
     306!$OMP PARALLEL 
     307!$OMP DO schedule(static) private(jj, ji) 
     308            DO jj = 1, jpj 
     309               DO ji = 1, jpi 
     310                  ztu(ji,jj,jpk) = 0._wp             ! Bottom value : flux set to zero 
     311                  ztv(ji,jj,jpk) = 0._wp 
     312               END DO 
     313            END DO 
     314!$OMP DO schedule(static) private(jk, jj, ji) 
    236315            DO jk = 1, jpkm1                 ! 1st derivative (gradient) 
    237316               DO jj = 1, jpjm1 
    … …  
    242321               END DO 
    243322            END DO 
     323!$OMP END PARALLEL 
    244324            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn) 
    245325            ! 
     326!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v, zC4t_u, zC4t_v) 
    246327            DO jk = 1, jpkm1                 ! Horizontal advective fluxes 
    247328               DO jj = 2, jpjm1 
    … …  
    264345         ! 
    265346         CASE(  2  )                   !- 2nd order centered 
     347!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    266348            DO jk = 2, jpkm1     
    267349               DO jj = 2, jpjm1 
    … …  
    275357         CASE(  4  )                   !- 4th order COMPACT 
    276358            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
     359!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    277360            DO jk = 2, jpkm1 
    278361               DO jj = 2, jpjm1 
    … …  
    285368         END SELECT 
    286369         IF( ln_linssh ) THEN    ! top ocean value: high order = upstream  ==>>  zwz=0 
    287             zwz(:,:,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked 
     370!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     371            DO jj = 1, jpj 
     372               DO ji = 1, jpi 
     373                  zwz(ji,jj,1) = 0._wp   ! only ocean surface as interior zwz values have been w-masked 
     374               END DO 
     375            END DO 
    288376         ENDIF 
    289377         ! 
    … …  
    297385         !        !==  final trend with corrected fluxes  ==! 
    298386         ! 
     387!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    299388         DO jk = 1, jpkm1 
    300389            DO jj = 2, jpjm1 
    … …  
    309398         ! 
    310399         IF( l_trd .OR. l_hst ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
    311             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    312             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    313             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
     400!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     401            DO jk = 1, jpk 
     402               DO jj = 1, jpj 
     403                  DO ji = 1, jpi 
     404                     ztrdx(ji,jj,jk) = ztrdx(ji,jj,jk) + zwx(ji,jj,jk)  ! <<< Add to previously computed 
     405                     ztrdy(ji,jj,jk) = ztrdy(ji,jj,jk) + zwy(ji,jj,jk)  ! <<< Add to previously computed 
     406                     ztrdz(ji,jj,jk) = ztrdz(ji,jj,jk) + zwz(ji,jj,jk)  ! <<< Add to previously computed 
     407                  END DO 
     408               END DO 
     409            END DO 
    314410         ENDIF 
    315411            ! 
    … …  
    325421         !                                ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    326422         IF( l_ptr ) THEN   
    327             zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
     423!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     424            DO jk = 1, jpk 
     425               DO jj = 1, jpj 
     426                  DO ji = 1, jpi 
     427                     zptry(ji,jj,jk) = zptry(ji,jj,jk) + zwy(ji,jj,jk)  ! <<< Add to previously computed 
     428                  END DO 
     429               END DO 
     430            END DO 
    328431            CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 
    329432         ENDIF 
    … …  
    662765      zbig  = 1.e+40_wp 
    663766      zrtrn = 1.e-15_wp 
    664       zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
    665767 
    666768      ! Search local extrema 
    … …  
    672774         &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    673775 
     776!$OMP PARALLEL 
     777!$OMP DO schedule(static) private(jk, jj, ji) 
     778      DO jk = 1, jpk 
     779         DO jj = 1, jpj 
     780            DO ji = 1, jpi 
     781               zbetup(ji,jj,jk) = 0._wp 
     782               zbetdo(ji,jj,jk) = 0._wp 
     783            END DO 
     784         END DO 
     785      END DO 
     786!$OMP DO schedule(static) private(jk, jj, ji, ikm1, zup, zdo, zpos, zneg, zbt) 
    674787      DO jk = 1, jpkm1 
    675788         ikm1 = MAX(jk-1,1) 
    … …  
    706819         END DO 
    707820      END DO 
     821!$OMP END PARALLEL 
    708822      CALL lbc_lnk( zbetup, 'T', 1. )   ;   CALL lbc_lnk( zbetdo, 'T', 1. )   ! lateral boundary cond. (unchanged sign) 
    709823 
    710824      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    711825      ! ---------------------------------------- 
     826!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu) 
    712827      DO jk = 1, jpkm1 
    713828         DO jj = 2, jpjm1 

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

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

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

    r7646 r7698  
    108108         ! 
    109109         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 
    110          xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed 
     110!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     111         DO jk = 1, jpk 
     112            DO jj = 1, jpj 
     113               DO ji = 1, jpi 
     114                  xind(ji,jj,jk) = 1._wp              ! set equal to 1 where up-stream is not needed 
     115               END DO 
     116            END DO 
     117         END DO 
    111118         ! 
    112119         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked) 
    113120            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
    114             upsmsk(:,:) = 0._wp                             ! not upstream by default 
     121!$OMP PARALLEL 
     122!$OMP DO schedule(static) private(jj, ji) 
     123            DO jj = 1, jpj 
     124               DO ji = 1, jpi 
     125                  upsmsk(ji,jj) = 0._wp                             ! not upstream by default 
     126               END DO 
     127            END DO 
    115128            ! 
     129!$OMP DO schedule(static) private(jk,jj,ji) 
    116130            DO jk = 1, jpkm1 
    117                xind(:,:,jk) = 1._wp                              &                 ! =>1 where up-stream is not needed 
    118                   &         - MAX ( rnfmsk(:,:) * rnfmsk_z(jk),  &                 ! =>0 near runoff mouths (& closed sea outflows) 
    119                   &                 upsmsk(:,:)                ) * tmask(:,:,jk)   ! =>0 in some user defined area 
    120             END DO 
     131               DO jj = 1, jpj 
     132                  DO ji = 1, jpi 
     133                     xind(ji,jj,jk) = 1._wp                              &                   ! =>1 where up-stream is not needed 
     134                        &         - MAX ( rnfmsk(ji,jj) * rnfmsk_z(jk),  &                   ! =>0 near runoff mouths (& closed sea outflows) 
     135                        &                 upsmsk(ji,jj)                ) * tmask(ji,jj,jk)   ! =>0 in some user defined area 
     136                  END DO 
     137               END DO 
     138            END DO 
     139!$OMP END DO NOWAIT 
     140!$OMP END PARALLEL 
    121141         ENDIF  
    122142         ! 
    … …  
    136156         ! 
    137157         !                                !-- first guess of the slopes 
    138          zwx(:,:,jpk) = 0._wp                   ! bottom values 
    139          zwy(:,:,jpk) = 0._wp   
     158!$OMP PARALLEL 
     159!$OMP DO schedule(static) private(jj, ji) 
     160         DO jj = 1, jpj 
     161            DO ji = 1, jpi 
     162               zwx(ji,jj,jpk) = 0._wp           ! bottom values 
     163               zwy(ji,jj,jpk) = 0._wp 
     164            END DO 
     165         END DO 
     166!$OMP DO schedule(static) private(jk, jj, ji) 
    140167         DO jk = 1, jpkm1                       ! interior values 
    141168            DO jj = 1, jpjm1       
    … …  
    146173           END DO 
    147174         END DO 
     175!$OMP END DO NOWAIT 
     176!$OMP END PARALLEL 
    148177         CALL lbc_lnk( zwx, 'U', -1. )          ! lateral boundary conditions   (changed sign) 
    149178         CALL lbc_lnk( zwy, 'V', -1. ) 
    150179         !                                !-- Slopes of tracer 
    151          zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    152          zslpy(:,:,jpk) = 0._wp 
     180!$OMP PARALLEL 
     181!$OMP DO schedule(static) private(jj, ji) 
     182         DO jj = 1, jpj 
     183            DO ji = 1, jpi 
     184               zslpx(ji,jj,jpk) = 0._wp                 ! bottom values 
     185               zslpy(ji,jj,jpk) = 0._wp 
     186            END DO 
     187         END DO 
     188!$OMP DO schedule(static) private(jk, jj, ji) 
    153189         DO jk = 1, jpkm1                       ! interior values 
    154190            DO jj = 2, jpj 
    … …  
    162198         END DO 
    163199         ! 
     200!$OMP DO schedule(static) private(jk, jj, ji) 
    164201         DO jk = 1, jpkm1                 !-- Slopes limitation 
    165202            DO jj = 2, jpj 
    … …  
    175212         END DO 
    176213         ! 
     214!$OMP DO schedule(static) private(jk, jj, ji, z0u, zalpha, zu, zv, zzwx, zzwy, z0v) 
    177215         DO jk = 1, jpkm1                 !-- MUSCL horizontal advective fluxes 
    178216            DO jj = 2, jpjm1 
    … …  
    195233            END DO 
    196234         END DO 
     235!$OMP END DO NOWAIT 
     236!$OMP END PARALLEL 
    197237         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
    198238         ! 
     239!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    199240         DO jk = 1, jpkm1                 !-- Tracer advective trend 
    200241            DO jj = 2, jpjm1       
    … …  
    219260         ! 
    220261         !                                !-- first guess of the slopes 
    221          zwx(:,:, 1 ) = 0._wp                   ! surface & bottom boundary conditions 
    222          zwx(:,:,jpk) = 0._wp 
     262!$OMP PARALLEL  
     263!$OMP DO schedule(static) private(jj, ji) 
     264         DO jj = 1, jpj 
     265            DO ji = 1, jpi 
     266               zwx(ji,jj, 1 ) = 0._wp           ! surface & bottom boundary conditions 
     267               zwx(ji,jj,jpk) = 0._wp 
     268           END DO 
     269         END DO 
     270!$OMP DO schedule(static) private(jk, jj, ji) 
    223271         DO jk = 2, jpkm1                       ! interior values 
    224             zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 
     272            DO jj = 1, jpj 
     273               DO ji = 1, jpi 
     274                  zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
     275              END DO 
     276            END DO 
    225277         END DO 
    226278         !                                !-- Slopes of tracer 
    227          zslpx(:,:,1) = 0._wp                   ! surface values 
     279!$OMP END DO NOWAIT 
     280!$OMP DO schedule(static) private(jj, ji) 
     281         DO jj = 1, jpj 
     282            DO ji = 1, jpi 
     283               zslpx(ji,jj,1) = 0._wp                   ! surface values 
     284           END DO 
     285         END DO 
     286!$OMP DO schedule(static) private(jk, jj, ji) 
    228287         DO jk = 2, jpkm1                       ! interior value 
    229288            DO jj = 1, jpj 
    … …  
    234293            END DO 
    235294         END DO 
     295!$OMP DO schedule(static) private(jk, jj, ji) 
    236296         DO jk = 2, jpkm1                 !-- Slopes limitation 
    237297            DO jj = 1, jpj                      ! interior values 
    … …  
    243303            END DO 
    244304         END DO 
     305!$OMP DO schedule(static) private(jk, jj, ji, z0w, zalpha, zw, zzwx, zzwy) 
    245306         DO jk = 1, jpk-2                 !-- vertical advective flux 
    246307            DO jj = 2, jpjm1       
    … …  
    255316            END DO 
    256317         END DO 
     318!$OMP END DO NOWAIT 
     319!$OMP END PARALLEL 
    257320         IF( ln_linssh ) THEN                   ! top values, linear free surface only 
    258321            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean) 
     322!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    259323               DO jj = 1, jpj 
    260324                  DO ji = 1, jpi 
    … …  
    263327               END DO    
    264328            ELSE                                      ! no cavities: only at the ocean surface 
    265                zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
     329!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     330               DO jj = 1, jpj 
     331                  DO ji = 1, jpi 
     332                     zwx(ji,jj,1) = pwn(ji,jj,1) * ptb(ji,jj,1,jn) 
     333                  END DO 
     334               END DO 
    266335            ENDIF 
    267336         ENDIF 
    268337         ! 
     338!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    269339         DO jk = 1, jpkm1                 !-- vertical advective trend 
    270340            DO jj = 2, jpjm1       

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

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

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

    r7646 r7698  
    105105      !!---------------------------------------------------------------------- 
    106106      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
     107      INTEGER  ::   ji, jj, jk        ! dummy loop indices 
    107108      ! 
    108109      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdt, ztrds 
    … …  
    113114      IF( l_trdtra )   THEN                         !* Save the input trends 
    114115         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    115          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    116          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     116!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     117         DO jk = 1, jpk 
     118            DO jj = 1, jpj 
     119               DO ji = 1, jpi 
     120                  ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
     121                  ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 
     122               END DO 
     123            END DO 
     124         END DO 
    117125      ENDIF 
    118126 
    … …  
    146154 
    147155      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
    148          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    149          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
     156!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     157         DO jk = 1, jpk 
     158            DO jj = 1, jpj 
     159               DO ji = 1, jpi 
     160                  ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
     161                  ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 
     162               END DO 
     163            END DO 
     164         END DO 
    150165         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    151166         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    … …  
    195210      DO jn = 1, kjpt                                     ! tracer loop 
    196211         !                                                ! =========== 
     212!$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 
    197213         DO jj = 1, jpj 
    198214            DO ji = 1, jpi 
    … …  
    202218         END DO 
    203219         !                
     220!$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 
    204221         DO jj = 2, jpjm1                                    ! Compute the trend 
    205222            DO ji = 2, jpim1 
    … …  
    357374      ENDIF 
    358375      !                                        !* bottom variables (T, S, alpha, beta, depth, velocity) 
     376!$OMP PARALLEL DO schedule(static) private(jj,ji,ik) 
    359377      DO jj = 1, jpj 
    360378         DO ji = 1, jpi 
    … …  
    374392      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   ! 
    375393         !                                !-------------------! 
     394!$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign) 
    376395         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 
    377396            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    406425         ! 
    407426         CASE( 1 )                                   != use of upper velocity 
     427!$OMP PARALLEL DO schedule(static) private(jj,ji,za,zb,zgdrho,zsign,zsigna) 
    408428            DO jj = 1, jpjm1                                 ! criteria: grad(rho).grad(h)<0  and grad(rho).grad(h)<0 
    409429               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    437457         CASE( 2 )                                 != bbl velocity = F( delta rho ) 
    438458            zgbbl = grav * rn_gambbl 
     459!$OMP PARALLEL DO schedule(static) private(jj,ji,iid,iis,ikud,ikus,za,zb,zgdrho,ijd,ijs,ikvd,ikvs) 
    439460            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down 
    440461               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    533554 
    534555      !                             !* vertical index of  "deep" bottom u- and v-points 
     556!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    535557      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv) 
    536558         DO ji = 1, jpim1 
    … …  
    547569      !                                 !* sign of grad(H) at u- and v-points 
    548570      mgrhu(jpi,:) = 0   ;   mgrhu(:,jpj) = 0   ;   mgrhv(jpi,:) = 0   ;   mgrhv(:,jpj) = 0 
     571!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    549572      DO jj = 1, jpjm1 
    550573         DO ji = 1, jpim1 
    … …  
    554577      END DO 
    555578      ! 
     579!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    556580      DO jj = 1, jpjm1              !* bbl thickness at u- (v-) point 
    557581         DO ji = 1, jpim1                 ! minimum of top & bottom e3u_0 (e3v_0) 
    … …  
    563587      ! 
    564588      !                             !* masked diffusive flux coefficients 
    565       ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 
    566       ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 
     589!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     590      DO jj = 1, jpj 
     591         DO ji = 1, jpi 
     592            ahu_bbl_0(ji,jj) = rn_ahtbbl * e2_e1u(ji,jj) * e3u_bbl_0(ji,jj) * umask(ji,jj,1) 
     593            ahv_bbl_0(ji,jj) = rn_ahtbbl * e1_e2v(ji,jj) * e3v_bbl_0(ji,jj) * vmask(ji,jj,1) 
     594         END DO 
     595      END DO 
    567596 
    568597      ! 

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

    r7646 r7698  
    102102      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    103103         CALL wrk_alloc( jpi,jpj,jpk,jpts,   ztrdts )  
    104          ztrdts(:,:,:,:) = tsa(:,:,:,:)  
     104         DO jn = 1, jpts 
     105!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     106            DO jk = 1, jpk 
     107               DO jj = 1, jpj 
     108                  DO ji = 1, jpi 
     109                     ztrdts(ji,jj,jk,jn) = tsa(ji,jj,jk,jn)  
     110                  END DO 
     111               END DO 
     112            END DO 
     113         END DO 
    105114      ENDIF 
    106115      !                           !==  input T-S data at kt  ==! 
    … …  
    111120      CASE( 0 )                        !*  newtonian damping throughout the water column  *! 
    112121         DO jn = 1, jpts 
     122!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    113123            DO jk = 1, jpkm1 
    114124               DO jj = 2, jpjm1 
    … …  
    121131         ! 
    122132      CASE ( 1 )                       !*  no damping in the turbocline (avt > 5 cm2/s)  *! 
     133!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    123134         DO jk = 1, jpkm1 
    124135            DO jj = 2, jpjm1 
    … …  
    135146         ! 
    136147      CASE ( 2 )                       !*  no damping in the mixed layer   *! 
     148!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    137149         DO jk = 1, jpkm1 
    138150            DO jj = 2, jpjm1 
    … …  
    151163      ! 
    152164      IF( l_trdtra )   THEN       ! trend diagnostic 
    153          ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 
     165         DO jn = 1, jpts 
     166!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     167            DO jk = 1, jpk 
     168               DO jj = 1, jpj 
     169                  DO ji = 1, jpi 
     170                     ztrdts(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) - ztrdts(ji,jj,jk,jn) 
     171                  END DO 
     172               END DO 
     173            END DO 
     174         END DO 
    154175         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    155176         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 

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

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

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

    r7646 r7698  
    125125         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    126126         ! 
    127          akz     (:,:,:) = 0._wp       
    128          ah_wslp2(:,:,:) = 0._wp 
     127!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     128         DO jk = 1, jpk 
     129            DO jj = 1, jpj 
     130               DO ji = 1, jpi 
     131                  akz     (ji,jj,jk) = 0._wp 
     132                  ah_wslp2(ji,jj,jk) = 0._wp 
     133               END DO 
     134            END DO 
     135         END DO 
    129136      ENDIF 
    130137      !    
    … …  
    151158      IF( kpass == 1 ) THEN                  !==  first pass only  ==! 
    152159         ! 
     160!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w) 
    153161         DO jk = 2, jpkm1 
    154162            DO jj = 2, jpjm1 
    … …  
    172180         ! 
    173181         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
     182!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    174183            DO jk = 2, jpkm1 
    175184               DO jj = 2, jpjm1 
    … …  
    185194            ! 
    186195            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
     196!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    187197               DO jk = 2, jpkm1 
    188198                  DO jj = 1, jpjm1 
    … …  
    194204               END DO 
    195205            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
     206!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3w_2, zcoef0) 
    196207               DO jk = 2, jpkm1 
    197208                  DO jj = 1, jpjm1 
    … …  
    206217           ! 
    207218         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
    208             akz(:,:,:) = ah_wslp2(:,:,:)       
     219!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     220           DO jk = 1, jpk 
     221              DO jj = 1, jpj 
     222                 DO ji = 1, jpi 
     223                    akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 
     224                 END DO 
     225              END DO 
     226           END DO 
    209227         ENDIF 
    210228      ENDIF 
    … …  
    218236         !!---------------------------------------------------------------------- 
    219237!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
    220          zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp 
    221          zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp 
     238!$OMP PARALLEL 
     239!$OMP DO schedule(static) private(jk, jj) 
     240         DO jk = 1, jpk 
     241            DO jj = 1, jpj 
     242               zdit (1,jj,jk) = 0._wp     ;     zdit (jpi,jj,jk) = 0._wp 
     243               zdjt (1,jj,jk) = 0._wp     ;     zdjt (jpi,jj,jk) = 0._wp 
     244            END DO 
     245         END DO 
    222246         !!end 
    223247 
    224248         ! Horizontal tracer gradient  
     249!$OMP DO schedule(static) private(jk, jj, ji) 
    225250         DO jk = 1, jpkm1 
    226251            DO jj = 1, jpjm1 
    … …  
    231256            END DO 
    232257         END DO 
     258!$OMP END PARALLEL 
    233259         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
     260!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    234261            DO jj = 1, jpjm1              ! bottom correction (partial bottom cell) 
    235262               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    239266            END DO 
    240267            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
     268!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    241269               DO jj = 1, jpjm1 
    242270                  DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    252280         !!---------------------------------------------------------------------- 
    253281         ! 
     282!$OMP PARALLEL 
    254283         DO jk = 1, jpkm1                                 ! Horizontal slab 
    255284            ! 
    256285            !                             !== Vertical tracer gradient 
    257             zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
    258             ! 
    259             IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
    260             ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 
     286!$OMP DO schedule(static) private(jj, ji) 
     287            DO jj = 1 , jpj 
     288               DO ji = 1, jpi 
     289                  zdk1t(ji,jj) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1)     ! level jk+1 
     290               END DO 
     291            END DO 
     292            ! 
     293            IF( jk == 1 ) THEN    
     294!$OMP DO schedule(static) private(jj, ji) 
     295               DO jj = 1 , jpj 
     296                  DO ji = 1, jpi 
     297                     zdkt(ji,jj) = zdk1t(ji,jj)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
     298                  END DO 
     299               END DO 
     300            ELSE   
     301!$OMP DO schedule(static) private(jj, ji) 
     302               DO jj = 1 , jpj 
     303                  DO ji = 1, jpi 
     304                     zdkt(ji,jj) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
     305                  END DO 
     306               END DO 
    261307            ENDIF 
     308!$OMP DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2) 
    262309            DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    263310               DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    283330            END DO 
    284331            ! 
     332!$OMP DO schedule(static) private(jj, ji) 
    285333            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta 
    286334               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    296344         !!---------------------------------------------------------------------- 
    297345         ! 
    298          ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp 
     346!$OMP DO schedule(static) private(jk, jj) 
     347         DO jk = 1, jpk 
     348            DO jj = 1, jpj 
     349               ztfw(1,jj,jk) = 0._wp     ;     ztfw(jpi,jj,jk) = 0._wp 
     350            END DO 
     351         END DO 
    299352         ! 
    300353         ! Vertical fluxes 
    301354         ! --------------- 
    302355         !                          ! Surface and bottom vertical fluxes set to zero 
    303          ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
     356!$OMP DO schedule(static) private(jj, ji) 
     357         DO jj = 1, jpj 
     358            DO ji = 1, jpi 
     359               ztfw(ji,jj, 1 ) = 0._wp      ;      ztfw(ji,jj,jpk) = 0._wp 
     360            END DO 
     361         END DO 
    304362          
     363!$OMP DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w, zcoef3, zcoef4) 
    305364         DO jk = 2, jpkm1           ! interior (2=<jk=<jpk-1) 
    306365            DO jj = 2, jpjm1 
    … …  
    327386            END DO 
    328387         END DO 
     388!$OMP END PARALLEL 
    329389         !                                !==  add the vertical 33 flux  ==! 
    330390         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
     391!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    331392            DO jk = 2, jpkm1        
    332393               DO jj = 1, jpjm1 
    … …  
    342403            SELECT CASE( kpass ) 
    343404            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
     405!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    344406               DO jk = 2, jpkm1  
    345407                  DO jj = 1, jpjm1 
    … …  
    352414               END DO  
    353415            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
     416!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    354417               DO jk = 2, jpkm1  
    355418                  DO jj = 1, jpjm1 
    … …  
    364427         ENDIF 
    365428         !          
     429!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    366430         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
    367431            DO jj = 2, jpjm1 

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

    r7646 r7698  
    121121      IF( l_trdtra )   THEN                     
    122122         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
    123          ztrdt(:,:,jk) = 0._wp 
    124          ztrds(:,:,jk) = 0._wp 
     123!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     124         DO jk = 1, jpk 
     125            DO jj = 1, jpj 
     126               DO ji = 1, jpi 
     127                  ztrdt(ji,jj,jk) = 0._wp  
     128                  ztrds(ji,jj,jk) = 0._wp 
     129               END DO 
     130            END DO 
     131         END DO 
    125132         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
    126133            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 
    … …  
    129136         ! total trend for the non-time-filtered variables.  
    130137            zfact = 1.0 / rdt 
    131          DO jk = 1, jpkm1 
    132             ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact  
    133             ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact  
     138!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     139         DO jk = 1, jpkm1 
     140            DO jj = 1, jpj 
     141               DO ji = 1, jpi 
     142                  ztrdt(ji,jj,jk) = ( tsa(ji,jj,jk,jp_tem) - tsn(ji,jj,jk,jp_tem) ) * zfact 
     143                  ztrds(ji,jj,jk) = ( tsa(ji,jj,jk,jp_sal) - tsn(ji,jj,jk,jp_sal) ) * zfact 
     144               END DO 
     145            END DO 
    134146         END DO 
    135147         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 
    … …  
    137149         ! Store now fields before applying the Asselin filter  
    138150         ! in order to calculate Asselin filter trend later. 
    139          ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
    140          ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     151!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     152         DO jk = 1, jpkm1 
     153            DO jj = 1, jpj 
     154               DO ji = 1, jpi 
     155                  ztrdt(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) 
     156                  ztrds(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) 
     157               END DO 
     158            END DO 
     159         END DO 
    141160      ENDIF 
    142161 
    143162      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap) 
    144163         DO jn = 1, jpts 
     164!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    145165            DO jk = 1, jpkm1 
    146                tsn(:,:,jk,jn) = tsa(:,:,jk,jn)     
     166               DO jj = 1, jpj 
     167                  DO ji = 1, jpi 
     168                     tsn(ji,jj,jk,jn) = tsa(ji,jj,jk,jn)     
     169                  END DO 
     170               END DO 
    147171            END DO 
    148172         END DO 
    … …  
    163187      ! 
    164188      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    165          DO jk = 1, jpkm1 
    166             zfact = 1._wp / r2dt              
    167             ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 
    168             ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 
     189!$OMP PARALLEL DO schedule(static) private(jk, zfact) 
     190         DO jk = 1, jpkm1 
     191            DO jj = 1, jpj 
     192               DO ji = 1, jpi 
     193                  zfact = 1._wp / r2dt              
     194                  ztrdt(ji,jj,jk) = ( tsb(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) ) * zfact 
     195                  ztrds(ji,jj,jk) = ( tsb(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) ) * zfact 
     196               END DO 
     197            END DO 
    169198         END DO 
    170199         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 
    … …  
    214243      DO jn = 1, kjpt 
    215244         ! 
     245!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztn,ztd) 
    216246         DO jk = 1, jpkm1 
    217247            DO jj = 2, jpjm1 
    … …  
    280310      ! 
    281311      DO jn = 1, kjpt       
     312!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zfact1,zfact2,ze3t_b,ze3t_n,ze3t_a,ze3t_d,ze3t_f,ztc_b,ztc_n,ztc_a,ztc_d,ztc_f) 
    282313         DO jk = 1, jpkm1 
    283314            zfact1 = atfp * p2dt 

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

    r7646 r7698  
    128128      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    129129         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )  
    130          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     130!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     131            DO jk = 1, jpk 
     132               DO jj = 1, jpj 
     133                  DO ji = 1, jpi 
     134                     ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
     135                  END DO 
     136               END DO 
     137            END DO 
    131138      ENDIF 
    132139      ! 
    … …  
    142149         ELSE                                           ! No restart or restart not found: Euler forward time stepping 
    143150            z1_2 = 1._wp 
    144             qsr_hc_b(:,:,:) = 0._wp 
     151!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     152            DO jk = 1, jpk 
     153               DO jj = 1, jpj 
     154                  DO ji = 1, jpi 
     155                     qsr_hc_b(ji,jj,jk) = 0._wp 
     156                  END DO 
     157               END DO 
     158            END DO 
    145159         ENDIF 
    146160      ELSE                             !==  Swap of qsr heat content  ==! 
    147161         z1_2 = 0.5_wp 
    148          qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 
     162!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     163            DO jk = 1, jpk 
     164               DO jj = 1, jpj 
     165                  DO ji = 1, jpi 
     166                     qsr_hc_b(ji,jj,jk) = qsr_hc(ji,jj,jk) 
     167                  END DO 
     168               END DO 
     169            END DO 
    149170      ENDIF 
    150171      ! 
    … …  
    155176      CASE( np_BIO )                   !==  bio-model fluxes  ==! 
    156177         ! 
     178!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    157179         DO jk = 1, nksr 
    158             qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
     180            DO jj = 1, jpj 
     181               DO ji = 1, jpi 
     182                  qsr_hc(ji,jj,jk) = r1_rau0_rcp * ( etot3(ji,jj,jk) - etot3(ji,jj,jk+1) ) 
     183               END DO 
     184             END DO 
    159185         END DO 
    160186         ! 
    … …  
    166192         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    167193            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
     194!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,zCtot,zze,zpsi,zlogc,zlogc2,zlogc3,zCb,zCmax,zpsimax,zdelpsi,zCze) 
    168195            DO jk = 1, nksr + 1 
    169196               DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl 
    … …  
    190217            END DO 
    191218         ELSE                                !* constant chrlorophyll 
     219!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    192220           DO jk = 1, nksr + 1 
    193               zchl3d(:,:,jk) = 0.05  
     221              DO jj = 1, jpj 
     222                 DO ji = 1, jpi 
     223                    zchl3d(ji,jj,jk) = 0.05 
     224                 ENDDO 
     225              ENDDO 
    194226            ENDDO 
    195227         ENDIF 
    196228         ! 
    197229         zcoef  = ( 1. - rn_abs ) / 3._wp    !* surface equi-partition in R-G-B 
     230!$OMP PARALLEL 
     231!$OMP DO schedule(static) private(jj,ji) 
    198232         DO jj = 2, jpjm1 
    199233            DO ji = fs_2, fs_jpim1 
    … …  
    205239            END DO 
    206240         END DO 
     241!$OMP END DO NOWAIT 
    207242         ! 
    208243         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl 
     244!$OMP DO schedule(static) private(jj,ji,zchl,irgb) 
    209245            DO jj = 2, jpjm1 
    210246               DO ji = fs_2, fs_jpim1 
    … …  
    217253            END DO 
    218254 
     255!$OMP DO schedule(static) private(jj,ji,zc0,zc1,zc2,zc3) 
    219256            DO jj = 2, jpjm1 
    220257               DO ji = fs_2, fs_jpim1 
    … …  
    232269         END DO 
    233270         ! 
     271!$OMP DO schedule(static) private(jk,jj,ji) 
    234272         DO jk = 1, nksr                     !* now qsr induced heat content 
    235273            DO jj = 2, jpjm1 
    … …  
    239277            END DO 
    240278         END DO 
     279!$OMP END PARALLEL 
    241280         ! 
    242281         CALL wrk_dealloc( jpi,jpj,        zekb, zekg, zekr        )  
    … …  
    247286         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands 
    248287         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 
     288!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zc0,zc1) 
    249289         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m  
    250290            DO jj = 2, jpjm1 
    … …  
    260300      ! 
    261301      !                          !-----------------------------! 
     302!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    262303      DO jk = 1, nksr            !  update to the temp. trend  ! 
    263304         DO jj = 2, jpjm1        !-----------------------------! 
    … …  
    270311      ! 
    271312      IF( ln_qsr_ice ) THEN      ! sea-ice: store the 1st ocean level attenuation coefficient 
     313!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    272314         DO jj = 2, jpjm1  
    273315            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    284326         CALL wrk_alloc( jpi,jpj,jpk,   zetot ) 
    285327         ! 
    286          zetot(:,:,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
     328!$OMP PARALLEL 
     329!$OMP DO schedule(static) private(jj,ji) 
     330         DO jj = 1, jpj  
     331            DO ji = 1, jpi   ! vector opt. 
     332               zetot(ji,jj,nksr+1:jpk) = 0._wp     ! below ~400m set to zero 
     333            END DO 
     334         END DO 
    287335         DO jk = nksr, 1, -1 
    288             zetot(:,:,jk) = zetot(:,:,jk+1) + qsr_hc(:,:,jk) / r1_rau0_rcp 
     336!$OMP DO schedule(static) private(jj,ji) 
     337            DO jj = 1, jpj  
     338               DO ji = 1, jpi   ! vector opt. 
     339                  zetot(ji,jj,jk) = zetot(ji,jj,jk+1) + qsr_hc(ji,jj,jk) / r1_rau0_rcp 
     340               END DO 
     341            END DO 
    289342         END DO          
     343!$OMP END PARALLEL 
    290344         CALL iom_put( 'qsr3d', zetot )   ! 3D distribution of shortwave Radiation 
    291345         ! 
    … …  
    299353      ! 
    300354      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics 
    301          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
     355!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     356         DO jk = 1, jpk 
     357            DO jj = 1, jpj 
     358               DO ji = 1, jpi 
     359                  ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
     360               END DO 
     361            END DO 
     362         END DO 
    302363         CALL trd_tra( kt, 'TRA', jp_tem, jptra_qsr, ztrdt ) 
    303364         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdt )  
    … …  
    426487      END SELECT 
    427488      ! 
    428       qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed 
     489!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     490      DO jk = 1, jpk 
     491         DO jj = 1, jpj 
     492            DO ji = 1, jpi 
     493               qsr_hc(ji,jj,jk) = 0._wp     ! now qsr heat content set to zero where it will not be computed 
     494            END DO 
     495         END DO 
     496      END DO 
    429497      ! 
    430498      ! 1st ocean level attenuation coefficient (used in sbcssm) 
    … …  
    432500         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  ) 
    433501      ELSE 
    434          fraqsr_1lev(:,:) = 1._wp   ! default : no penetration 
     502!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     503         DO jj = 1, jpj 
     504            DO ji = 1, jpi 
     505               fraqsr_1lev(ji,jj) = 1._wp   ! default : no penetration 
     506            END DO 
     507         END DO 
    435508      ENDIF 
    436509      ! 

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

    r6701 r7698  
    8888      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    8989         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
    90          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    91          ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     90!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     91         DO jk = 1, jpk 
     92            DO jj = 1, jpj 
     93               DO ji = 1, jpi 
     94                  ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) 
     95                  ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) 
     96               END DO 
     97            END DO 
     98         END DO 
    9299      ENDIF 
    93100      ! 
    94101!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 
    95102      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
    96          qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns 
    97          qsr(:,:) = 0._wp                     ! qsr set to zero 
     103!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     104         DO jj = 1, jpj 
     105            DO ji = 1, jpi 
     106               qns(ji,jj) = qns(ji,jj) + qsr(ji,jj)      ! total heat flux in qns 
     107               qsr(ji,jj) = 0._wp                     ! qsr set to zero 
     108            END DO 
     109         END DO 
    98110      ENDIF 
    99111 
    … …  
    111123         ELSE                                   ! No restart or restart not found: Euler forward time stepping 
    112124            zfact = 1._wp 
    113             sbc_tsc(:,:,:) = 0._wp 
    114             sbc_tsc_b(:,:,:) = 0._wp 
     125            DO jn = 1, jpts 
     126!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     127               DO jj = 1, jpj 
     128                  DO ji = 1, jpi 
     129                     sbc_tsc(ji,jj,jn) = 0._wp 
     130                     sbc_tsc_b(ji,jj,jn) = 0._wp 
     131                  END DO 
     132               END DO 
     133            END DO 
    115134         ENDIF 
    116135      ELSE                                !* other time-steps: swap of forcing fields 
    117136         zfact = 0.5_wp 
    118          sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 
     137         DO jn = 1, jpts 
     138!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     139            DO jj = 1, jpj 
     140               DO ji = 1, jpi 
     141                  sbc_tsc_b(ji,jj,jn) = sbc_tsc(ji,jj,jn) 
     142               END DO 
     143            END DO 
     144         END DO 
    119145      ENDIF 
    120146      !                             !==  Now sbc tracer content fields  ==! 
     147!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    121148      DO jj = 2, jpj 
    122149         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    126153      END DO 
    127154      IF( ln_linssh ) THEN                !* linear free surface   
     155!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    128156         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell 
    129157            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    137165      ! 
    138166      DO jn = 1, jpts               !==  update tracer trend  ==! 
     167!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    139168         DO jj = 2, jpj 
    140169            DO ji = fs_2, fs_jpim1   ! vector opt.   
    … …  
    218247      ! 
    219248      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff  
     249!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zdep) 
    220250         DO jk = 1,jpk 
    221251            DO jj = 2, jpj  
    … …  
    232262 
    233263      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    234          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    235          ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
     264!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     265         DO jk = 1, jpk 
     266            DO jj = 1, jpj 
     267               DO ji = 1, jpi 
     268                  ztrdt(ji,jj,jk) = tsa(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) 
     269                  ztrds(ji,jj,jk) = tsa(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) 
     270               END DO   
     271            END DO   
     272         END DO 
    236273         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    237274         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 

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

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

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

    r6140 r7698  
    106106            ! 
    107107            ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 
    108             IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN   ;   zwt(:,:,2:jpk) = avt  (:,:,2:jpk) 
    109             ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 
     108            IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 
     109!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     110               DO jj = 1, jpj 
     111                  DO ji = 1, jpi 
     112                     zwt(ji,jj,2:jpk) = avt  (ji,jj,2:jpk) 
     113                  END DO 
     114               END DO 
     115            ELSE                                             
     116!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     117               DO jj = 1, jpj 
     118                  DO ji = 1, jpi 
     119                     zwt(ji,jj,2:jpk) = fsavs(ji,jj,2:jpk) 
     120                  END DO 
     121               END DO 
    110122            ENDIF 
    111             zwt(:,:,1) = 0._wp 
     123!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     124            DO jj = 1, jpj 
     125               DO ji = 1, jpi 
     126                  zwt(ji,jj,1) = 0._wp 
     127               END DO 
     128            END DO 
    112129            ! 
    113130            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
    114131               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
     132!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    115133                  DO jk = 2, jpkm1 
    116134                     DO jj = 2, jpjm1 
    … …  
    121139                  END DO 
    122140               ELSE                          ! standard or triad iso-neutral operator 
     141!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    123142                  DO jk = 2, jpkm1 
    124143                     DO jj = 2, jpjm1 
    … …  
    132151            ! 
    133152            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
     153!$OMP PARALLEL  
     154!$OMP DO schedule(static) private(jk, jj, ji) 
    134155            DO jk = 1, jpkm1 
    135156               DO jj = 2, jpjm1 
    … …  
    162183            !   used as a work space array: its value is modified. 
    163184            ! 
     185!$OMP DO schedule(static) private(jj, ji) 
    164186            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    165187               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction) 
    … …  
    167189               END DO 
    168190            END DO 
     191!$OMP END DO NOWAIT  
    169192            DO jk = 2, jpkm1 
     193!$OMP DO schedule(static) private(jj, ji) 
    170194               DO jj = 2, jpjm1 
    171195                  DO ji = fs_2, fs_jpim1 
    … …  
    174198               END DO 
    175199            END DO 
     200!$OMP END PARALLEL  
    176201            ! 
    177202         ENDIF  
    178203         !          
     204!$OMP PARALLEL  
     205!$OMP DO schedule(static) private(jj, ji) 
    179206         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    180207            DO ji = fs_2, fs_jpim1 
    … …  
    183210         END DO 
    184211         DO jk = 2, jpkm1 
     212!$OMP DO schedule(static) private(jj, ji, zrhs) 
    185213            DO jj = 2, jpjm1 
    186214               DO ji = fs_2, fs_jpim1 
    … …  
    191219         END DO 
    192220         ! 
     221!$OMP DO schedule(static) private(jj, ji) 
    193222         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer) 
    194223            DO ji = fs_2, fs_jpim1 
    … …  
    197226         END DO 
    198227         DO jk = jpk-2, 1, -1 
     228!$OMP DO schedule(static) private(jj, ji) 
    199229            DO jj = 2, jpjm1 
    200230               DO ji = fs_2, fs_jpim1 
    … …  
    204234            END DO 
    205235         END DO 
     236!$OMP END PARALLEL  
    206237         !                                            ! ================= ! 
    207238      END DO                                          !  end tracer loop  ! 

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

    r6140 r7698  
    101101      IF( nn_timing == 1 )   CALL timing_start( 'zps_hde') 
    102102      ! 
    103       pgtu(:,:,:)=0._wp   ;   zti (:,:,:)=0._wp   ;   zhi (:,:  )=0._wp 
    104       pgtv(:,:,:)=0._wp   ;   ztj (:,:,:)=0._wp   ;   zhj (:,:  )=0._wp 
     103      DO jn = 1, kjpt 
     104!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     105         DO jj = 1, jpjm1 
     106            DO ji = 1, jpim1 
     107               pgtu(ji,jj,jn)=0._wp   ;   zti (ji,jj,jn)=0._wp 
     108               pgtv(ji,jj,jn)=0._wp   ;   ztj (ji,jj,jn)=0._wp 
     109            END DO 
     110         END DO 
     111      END DO 
     112!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     113      DO jj = 1, jpjm1 
     114         DO ji = 1, jpim1 
     115            zhi (ji,jj  )=0._wp 
     116            zhj (ji,jj  )=0._wp 
     117         END DO 
     118       END DO 
    105119      ! 
    106120      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    107121         ! 
     122!$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv,zmaxu,zmaxv) 
    108123         DO jj = 1, jpjm1 
    109124            DO ji = 1, jpim1 
    … …  
    150165      !                 
    151166      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    152          pgru(:,:) = 0._wp 
    153          pgrv(:,:) = 0._wp                ! depth of the partial step level 
     167!$OMP PARALLEL 
     168!$OMP DO schedule(static) private(jj,ji) 
     169         DO jj = 1, jpjm1 
     170            DO ji = 1, jpim1 
     171               pgru(ji,jj) = 0._wp 
     172               pgrv(ji,jj) = 0._wp                ! depth of the partial step level 
     173            END DO 
     174         END DO 
     175!$OMP END DO NOWAIT 
     176!$OMP DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv) 
    154177         DO jj = 1, jpjm1 
    155178            DO ji = 1, jpim1 
    … …  
    166189            END DO 
    167190         END DO 
     191!$OMP END DO NOWAIT 
     192!$OMP END PARALLEL 
    168193         ! 
    169194         CALL eos( zti, zhi, zri )        ! interpolated density from zti, ztj  
    170195         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    171196         ! 
     197!$OMP PARALLEL DO schedule(static) private(jj,ji,iku,ikv,ze3wu,ze3wv) 
    172198         DO jj = 1, jpjm1                 ! Gradient of density at the last level  
    173199            DO ji = 1, jpim1 

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

    r7427 r7698  
    388388      ! 
    389389      DO jc = 1, jpncs 
     390!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    390391         DO jj = ncsj1(jc), ncsj2(jc) 
    391392            DO ji = ncsi1(jc), ncsi2(jc) 

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

    r6960 r7698  
    103103      ENDIF 
    104104      !    
     105!$OMP PARALLEL 
     106!$OMP DO schedule(static) private(jj, ji, zim1, zjm1) 
    105107      DO jj = 1, jpj  
    106108         DO ji = 1, jpi  
    … …  
    129131         END DO 
    130132      END DO 
     133!$OMP END DO NOWAIT 
    131134      ! 
    132135      !                       !== Horizontal scale factors ==! (in meters) 
    133136      !                      
    134137      !                                         ! constant grid spacing 
    135       pe1t(:,:) =  ze1     ;      pe2t(:,:) = ze1 
    136       pe1u(:,:) =  ze1     ;      pe2u(:,:) = ze1 
    137       pe1v(:,:) =  ze1     ;      pe2v(:,:) = ze1 
    138       pe1f(:,:) =  ze1     ;      pe2f(:,:) = ze1 
    139       ! 
    140       !                                         ! NO reduction of grid size in some straits  
     138!$OMP DO schedule(static) private(jj, ji) 
     139      DO jj = 1, jpj 
     140         DO ji = 1, jpi 
     141            pe1t(ji,jj) =  ze1     ;      pe2t(ji,jj) = ze1 
     142            pe1u(ji,jj) =  ze1     ;      pe2u(ji,jj) = ze1 
     143            pe1v(ji,jj) =  ze1     ;      pe2v(ji,jj) = ze1 
     144            pe1f(ji,jj) =  ze1     ;      pe2f(ji,jj) = ze1 
     145            ! 
     146            !                                         ! NO reduction of grid size in some straits  
     147            pe1e2u(ji,jj) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that 
     148            pe1e2v(ji,jj) = 0._wp                       !             require an initialization of INTENT(out) arguments 
     149         END DO 
     150      END DO 
     151!$OMP END PARALLEL 
    141152      ke1e2u_v = 0                              !    ==>> u_ & v_surfaces will be computed in dom_ghr routine 
    142       pe1e2u(:,:) = 0._wp                       !    CAUTION: set to zero to avoid error with some compilers that 
    143       pe1e2v(:,:) = 0._wp                       !             require an initialization of INTENT(out) arguments 
    144153      ! 
    145154      ! 
    … …  
    153162      zf0   = 2. * omega * SIN( rad * zphi0 )            !  compute f0 1st point south 
    154163      ! 
    155       pff_f(:,:) = ( zf0 + zbeta * ABS( pphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
    156       pff_t(:,:) = ( zf0 + zbeta * ABS( pphit(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
     164!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     165      DO jj = 1, jpj 
     166         DO ji = 1, jpi 
     167            pff_f(ji,jj) = ( zf0 + zbeta * ABS( pphif(ji,jj) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
     168            pff_t(ji,jj) = ( zf0 + zbeta * ABS( pphit(ji,jj) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 
     169         END DO 
     170      END DO 
    157171      ! 
    158172      IF(lwp) WRITE(numout,*) '                           beta-plane used. beta = ', zbeta, ' 1/(s.m)' 

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

    r6923 r7698  
    5555      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   Ocean at rest, with an horizontally uniform T and S profiles' 
    5656      ! 
    57       pu  (:,:,:) = 0._wp        ! ocean at rest 
    58       pv  (:,:,:) = 0._wp 
    59       pssh(:,:)   = 0._wp 
     57!$OMP PARALLEL 
     58!$OMP DO schedule(static) private(jk,jj,ji) 
     59      DO jk = 1, jpk 
     60         DO jj = 1, jpj 
     61            DO ji = 1, jpi 
     62               pu  (ji,jj,jk) = 0._wp        ! ocean at rest 
     63               pv  (ji,jj,jk) = 0._wp 
     64            END DO 
     65         END DO 
     66      END DO 
     67!$OMP END DO NOWAIT 
     68!$OMP DO schedule(static) private(jj,ji) 
     69      DO jj = 1, jpj 
     70         DO ji = 1, jpi 
     71            pssh(ji,jj)   = 0._wp 
     72         END DO 
     73      END DO 
     74!$OMP END DO NOWAIT 
    6075      ! 
     76!$OMP DO schedule(static) private(jk,jj,ji) 
    6177      DO jk = 1, jpk             ! horizontally uniform T & S profiles 
    6278         DO jj = 1, jpj 
    … …  
    7995         END DO 
    8096      END DO 
     97!$OMP END PARALLEL 
    8198      !    
    8299   END SUBROUTINE usr_def_istate 

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

    r7426 r7698  
    109109      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K) 
    110110      zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s 
     111!$OMP PARALLEL DO schedule(static) private(jj, ji, t_star) 
    111112      DO jj = 1, jpj 
    112113         DO ji = 1, jpi 
    … …  
    137138 
    138139      ! freshwater (mass flux) and update of qns with heat content of emp 
    139       emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average) 
    140       sfx (:,:) = 0.0_wp                                   ! no salt flux 
    141       qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST 
     140!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     141      DO jj = 1, jpj 
     142         DO ji = 1, jpi 
     143            emp (ji,jj) = emp(ji,jj) - zsumemp * tmask(ji,jj,1)          ! freshwater flux (=0 in domain average) 
     144            sfx (ji,jj) = 0.0_wp                                         ! no salt flux 
     145            qns (ji,jj) = qns(ji,jj) - emp(ji,jj) * sst_m(ji,jj) * rcp   ! evap and precip are at SST 
     146         END DO 
     147      END DO 
    142148 
    143149 
    … …  
    166172      ztau_sais = 0.015 
    167173      ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 
     174!$OMP PARALLEL 
     175!$OMP DO schedule(static) private(jj, ji) 
    168176      DO jj = 1, jpj 
    169177         DO ji = 1, jpi 
    … …  
    177185      ! module of wind stress and wind speed at T-point 
    178186      zcoef = 1. / ( zrhoa * zcdrag )  
     187!$OMP DO schedule(static) private(jj, ji, ztx, zty, zmod) 
    179188      DO jj = 2, jpjm1 
    180189         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    … …  
    186195         END DO 
    187196      END DO 
     197!$OMP END PARALLEL 
    188198      CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
    189199 

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

    r7200 r7698  
    199199      ! 
    200200      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D local workspace 
     201 
     202      INTEGER  ::   ji, jj 
    201203      !!---------------------------------------------------------------------- 
    202204      ! 
    … …  
    206208      IF(lwp) WRITE(numout,*) '       GYRE case : closed flat box ocean without ocean cavities' 
    207209      ! 
    208       z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom 
     210!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     211      DO jj = 1, jpj 
     212         DO ji = 1, jpi 
     213            z2d(ji,jj) = REAL( jpkm1 , wp )          ! flat bottom 
     214         END DO 
     215      END DO 
    209216      ! 
    210217      CALL lbc_lnk( z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
    211218      ! 
    212       k_bot(:,:) = INT( z2d(:,:) )           ! =jpkm1 over the ocean point, =0 elsewhere 
    213       ! 
    214       k_top(:,:) = MIN( 1 , k_bot(:,:) )     ! = 1    over the ocean point, =0 elsewhere 
     219!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     220      DO jj = 1, jpj 
     221         DO ji = 1, jpi 
     222            k_bot(ji,jj) = INT( z2d(ji,jj) )           ! =jpkm1 over the ocean point, =0 elsewhere 
     223            ! 
     224            k_top(ji,jj) = MIN( 1 , k_bot(ji,jj) )     ! = 1    over the ocean point, =0 elsewhere 
     225         END DO 
     226      END DO 
    215227      ! 
    216228   END SUBROUTINE zgr_msk_top_bot 
    … …  
    234246      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   pe3w , pe3uw, pe3vw         !    -       -      - 
    235247      ! 
    236       INTEGER  ::   jk 
     248      INTEGER  ::   ji, jj, jk 
    237249      !!---------------------------------------------------------------------- 
    238250      ! 
    239251      IF( nn_timing == 1 )  CALL timing_start('zgr_zco') 
    240252      ! 
     253!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    241254      DO jk = 1, jpk 
    242          pdept(:,:,jk) = pdept_1d(jk) 
    243          pdepw(:,:,jk) = pdepw_1d(jk) 
    244          pe3t (:,:,jk) = pe3t_1d (jk) 
    245          pe3u (:,:,jk) = pe3t_1d (jk) 
    246          pe3v (:,:,jk) = pe3t_1d (jk) 
    247          pe3f (:,:,jk) = pe3t_1d (jk) 
    248          pe3w (:,:,jk) = pe3w_1d (jk) 
    249          pe3uw(:,:,jk) = pe3w_1d (jk) 
    250          pe3vw(:,:,jk) = pe3w_1d (jk) 
     255         DO jj = 1, jpj 
     256            DO ji = 1, jpi 
     257               pdept(ji,jj,jk) = pdept_1d(jk) 
     258               pdepw(ji,jj,jk) = pdepw_1d(jk) 
     259               pe3t (ji,jj,jk) = pe3t_1d (jk) 
     260               pe3u (ji,jj,jk) = pe3t_1d (jk) 
     261               pe3v (ji,jj,jk) = pe3t_1d (jk) 
     262               pe3f (ji,jj,jk) = pe3t_1d (jk) 
     263               pe3w (ji,jj,jk) = pe3w_1d (jk) 
     264               pe3uw(ji,jj,jk) = pe3w_1d (jk) 
     265               pe3vw(ji,jj,jk) = pe3w_1d (jk) 
     266            END DO 
     267         END DO 
    251268      END DO 
    252269      ! 

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

    r7646 r7698  
    106106         IF ( ln_loglayer.AND. .NOT.ln_linssh ) THEN ! "log layer" bottom friction coefficient 
    107107 
     108!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 
    108109            DO jj = 1, jpj 
    109110               DO ji = 1, jpi 
    … …  
    117118! (ISF) 
    118119            IF ( ln_isfcav ) THEN 
     120!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 
    119121               DO jj = 1, jpj 
    120122                  DO ji = 1, jpi 
    … …  
    129131            !    
    130132         ELSE 
    131             zbfrt(:,:) = bfrcoef2d(:,:) 
    132             ztfrt(:,:) = tfrcoef2d(:,:) 
    133          ENDIF 
    134  
     133!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     134            DO jj = 1, jpj 
     135               DO ji = 1, jpi 
     136                  zbfrt(ji,jj) = bfrcoef2d(ji,jj) 
     137                  ztfrt(ji,jj) = tfrcoef2d(ji,jj) 
     138               END DO 
     139            END DO 
     140         ENDIF 
     141 
     142!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv) 
    135143         DO jj = 2, jpjm1 
    136144            DO ji = 2, jpim1 
    … …  
    167175 
    168176         IF( ln_isfcav ) THEN 
     177!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv) 
    169178            DO jj = 2, jpjm1 
    170179               DO ji = 2, jpim1 
    … …  
    260269      CASE( 0 ) 
    261270         IF(lwp) WRITE(numout,*) '      free-slip ' 
    262          bfrua(:,:) = 0._wp 
    263          bfrva(:,:) = 0._wp 
    264          tfrua(:,:) = 0._wp 
    265          tfrva(:,:) = 0._wp 
     271!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     272            DO jj = 1, jpj 
     273               DO ji = 1, jpi 
     274                  bfrua(ji,jj) = 0.e0 
     275                  bfrva(ji,jj) = 0.e0 
     276                  tfrua(ji,jj) = 0.e0 
     277                  tfrva(ji,jj) = 0.e0 
     278               END DO 
     279            END DO 
    266280         ! 
    267281      CASE( 1 ) 
    … …  
    285299            CALL iom_get (inum, jpdom_data, 'bfr_coef',bfrcoef2d,1) ! bfrcoef2d is used as tmp array 
    286300            CALL iom_close(inum) 
    287             bfrcoef2d(:,:) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 
     301!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     302            DO jj = 1, jpj 
     303               DO ji = 1, jpi 
     304                  bfrcoef2d(ji,jj) = rn_bfri1 * ( 1 + rn_bfrien * bfrcoef2d(ji,jj) ) 
     305               END DO 
     306            END DO 
    288307         ELSE 
    289             bfrcoef2d(:,:) = rn_bfri1  ! initialize bfrcoef2d to the namelist variable 
    290          ENDIF 
    291          ! 
    292          bfrua(:,:) = - bfrcoef2d(:,:) 
    293          bfrva(:,:) = - bfrcoef2d(:,:) 
     308!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     309            DO jj = 1, jpj 
     310               DO ji = 1, jpi 
     311                  bfrcoef2d(ji,jj) = rn_bfri1  ! initialize bfrcoef2d to the namelist variable 
     312               END DO 
     313            END DO 
     314         ENDIF 
     315         ! 
     316!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     317            DO jj = 1, jpj 
     318               DO ji = 1, jpi 
     319                  bfrua(ji,jj) = - bfrcoef2d(ji,jj) 
     320                  bfrva(ji,jj) = - bfrcoef2d(ji,jj) 
     321               END DO 
     322            END DO 
    294323         ! 
    295324         IF ( ln_isfcav ) THEN 
    … …  
    299328               CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 
    300329               CALL iom_close(inum) 
    301                tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 
     330!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     331               DO jj = 1, jpj 
     332                  DO ji = 1, jpi 
     333                     tfrcoef2d(ji,jj) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(ji,jj) ) 
     334                  END DO 
     335               END DO 
    302336            ELSE 
    303                tfrcoef2d(:,:) = rn_tfri1  ! initialize tfrcoef2d to the namelist variable 
     337!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     338               DO jj = 1, jpj 
     339                  DO ji = 1, jpi 
     340                     tfrcoef2d(ji,jj) = rn_tfri1  ! initialize tfrcoef2d to the namelist variable 
     341                  END DO 
     342               END DO 
    304343            ENDIF 
    305344            ! 
    306             tfrua(:,:) = - tfrcoef2d(:,:) 
    307             tfrva(:,:) = - tfrcoef2d(:,:) 
     345!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     346            DO jj = 1, jpj 
     347               DO ji = 1, jpi 
     348                  tfrua(ji,jj) = - tfrcoef2d(ji,jj) 
     349                  tfrva(ji,jj) = - tfrcoef2d(ji,jj) 
     350               END DO 
     351            END DO 
    308352         END IF 
    309353         ! 
    … …  
    346390            CALL iom_close(inum) 
    347391            ! 
    348             bfrcoef2d(:,:) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(:,:) ) 
     392!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     393            DO jj = 1, jpj 
     394               DO ji = 1, jpi 
     395                  bfrcoef2d(ji,jj) = rn_bfri2 * ( 1 + rn_bfrien * bfrcoef2d(ji,jj) ) 
     396               END DO 
     397            END DO 
    349398         ELSE 
    350             bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable 
     399!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     400            DO jj = 1, jpj 
     401               DO ji = 1, jpi 
     402                  bfrcoef2d(ji,jj) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable 
     403               END DO 
     404            END DO 
    351405         ENDIF 
    352406          
    … …  
    358412               CALL iom_close(inum) 
    359413               ! 
    360                tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 
     414!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     415               DO jj = 1, jpj 
     416                  DO ji = 1, jpi 
     417                     tfrcoef2d(ji,jj) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(ji,jj) ) 
     418                  END DO 
     419               END DO 
    361420            ELSE 
    362                tfrcoef2d(:,:) = rn_tfri2  ! initialize tfrcoef2d to the namelist variable 
     421!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     422               DO jj = 1, jpj 
     423                  DO ji = 1, jpi 
     424                     tfrcoef2d(ji,jj) = rn_tfri2  ! initialize tfrcoef2d to the namelist variable 
     425                  END DO 
     426               END DO 
    363427            ENDIF 
    364428         END IF 
    365429         ! 
    366430         IF( ln_loglayer.AND. ln_linssh ) THEN ! set "log layer" bottom friction once for all 
     431!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 
    367432            DO jj = 1, jpj 
    368433               DO ji = 1, jpi 
    … …  
    374439            END DO 
    375440            IF ( ln_isfcav ) THEN 
     441!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbt,ztmp) 
    376442               DO jj = 1, jpj 
    377443                  DO ji = 1, jpi 
    … …  
    413479      zmaxtfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient 
    414480      ! 
     481!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv,zfru,zfrv,ictu,ictv,zminbfr,zmaxbfr,zmintfr,zmaxtfr) 
    415482      DO jj = 2, jpjm1 
    416483         DO ji = 2, jpim1 

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

    r6497 r7698  
    112112         ! Define the mask  
    113113         ! --------------- 
     114!$OMP PARALLEL 
     115!$OMP DO schedule(static) private(jj,ji,zrw,zaw,zbw,zdt,zds) 
    114116         DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s]) 
    115117            DO ji = 1, jpi 
    … …  
    128130            END DO 
    129131         END DO 
    130  
     132!$OMP END DO NOWAIT 
     133 
     134!$OMP DO schedule(static) private(jj,ji) 
    131135         DO jj = 1, jpj                                     ! indicators: 
    132136            DO ji = 1, jpi 
    … …  
    155159         END DO 
    156160         ! mask zmsk in order to have avt and avs masked 
    157          zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 
    158  
     161 
     162!$OMP DO schedule(static) private(jj,ji) 
     163         DO jj = 1, jpj                                
     164            DO ji = 1, jpi 
     165               zmsks(ji,jj) = zmsks(ji,jj) * wmask(ji,jj,jk) 
     166            END DO 
     167         END DO 
    159168 
    160169         ! Update avt and avs 
    161170         ! ------------------ 
    162171         ! Constant eddy coefficient: reset to the background value 
     172!$OMP DO schedule(static) private(jj,ji,zinr,zrr,zavfs,zavft,zavdt,zavds) 
    163173         DO jj = 1, jpj 
    164174            DO ji = 1, jpi 
    … …  
    189199         ! -------------------------------- 
    190200!!gm to be changed following the definition of avm. 
     201!$OMP DO schedule(static) private(jj,ji) 
    191202         DO jj = 1, jpjm1 
    192203            DO ji = 1, fs_jpim1   ! vector opt. 
    … …  
    199210            END DO 
    200211         END DO 
     212!$OMP END DO NOWAIT 
     213!$OMP END PARALLEL 
    201214         !                                                ! =============== 
    202215      END DO                                              !   End of slab 
    … …  
    232245      !!---------------------------------------------------------------------- 
    233246      INTEGER ::   ios   ! local integer 
     247      INTEGER  ::   ji, jj , jk     ! dummy loop indices 
    234248      !! 
    235249      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr 
    … …  
    257271      IF( zdf_ddm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 
    258272      !                               ! initialization to masked Kz 
    259       avs(:,:,:) = rn_avt0 * wmask(:,:,:)  
     273!$OMP DO schedule(static) private(jk,jj,ji) 
     274      DO jk = 1, jpk                                
     275         DO jj = 1, jpj                                
     276            DO ji = 1, jpi 
     277               avs(ji,jj,jk) = rn_avt0 * wmask(ji,jj,jk) 
     278            END DO 
     279         END DO 
     280      END DO  
    260281      ! 
    261282   END SUBROUTINE zdf_ddm_init 

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

    r7646 r7698  
    7070      CALL wrk_alloc( jpi,jpj,jpk,   zavt_evd, zavm_evd )  
    7171      ! 
    72       zavt_evd(:,:,:) = avt(:,:,:)           ! set avt prior to evd application 
     72!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     73      DO jk = 1, jpk 
     74         DO jj = 1, jpj 
     75            DO ji = 1, jpi 
     76               zavt_evd(ji,jj,jk) = avt(ji,jj,jk)           ! set avt prior to evd application 
     77            END DO 
     78         END DO 
     79      END DO  
    7380      ! 
    7481      SELECT CASE ( nn_evdm ) 
    … …  
    7683      CASE ( 1 )           ! enhance vertical eddy viscosity and diffusivity (if rn2<-1.e-12) 
    7784         ! 
    78          zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application 
     85!$OMP PARALLEL 
     86!$OMP DO schedule(static) private(jk, jj, ji) 
     87         DO jk = 1, jpk 
     88            DO jj = 1, jpj 
     89               DO ji = 1, jpi 
     90                  zavm_evd(ji,jj,jk) = avm(ji,jj,jk)           ! set avm prior to evd application 
     91               END DO 
     92            END DO 
     93         END DO  
    7994         ! 
     95!$OMP DO schedule(static) private(jk, jj, ji) 
    8096         DO jk = 1, jpkm1  
    8197            DO jj = 2, jpj             ! no vector opt. 
    … …  
    92108            END DO 
    93109         END DO  
     110!$OMP END PARALLEL 
    94111         CALL lbc_lnk( avt , 'W', 1. )   ;   CALL lbc_lnk( avm , 'W', 1. )   ! Lateral boundary conditions 
    95112         CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. ) 
    96113         ! 
    97          zavm_evd(:,:,:) = avm(:,:,:) - zavm_evd(:,:,:)   ! change in avm due to evd 
     114!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     115         DO jk = 1, jpk 
     116            DO jj = 1, jpj 
     117               DO ji = 1, jpi 
     118                  zavm_evd(ji,jj,jk) = avm(ji,jj,jk) - zavm_evd(ji,jj,jk)   ! change in avm due to evd 
     119               END DO 
     120            END DO 
     121         END DO  
    98122         CALL iom_put( "avm_evd", zavm_evd )              ! output this change 
    99123         ! 
    100124      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12)  
     125!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    101126         DO jk = 1, jpkm1 
    102127!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!  
    … …  
    111136      END SELECT  
    112137 
    113       zavt_evd(:,:,:) = avt(:,:,:) - zavt_evd(:,:,:)   ! change in avt due to evd 
     138!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     139      DO jk = 1, jpk 
     140         DO jj = 1, jpj 
     141            DO ji = 1, jpi 
     142               zavt_evd(ji,jj,jk) = avt(ji,jj,jk) - zavt_evd(ji,jj,jk)   ! change in avt due to evd 
     143            END DO 
     144         END DO 
     145      END DO  
    114146      CALL iom_put( "avt_evd", zavt_evd )              ! output this change 
    115147      IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd ) 

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

    r7646 r7698  
    9696 
    9797      ! w-level of the mixing and mixed layers 
    98       nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point 
    99       hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
    100       zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria 
     98      zN2_c = grav * rho_c * r1_rau0           ! convert density criteria into N^2 criteria 
     99!$OMP PARALLEL 
     100!$OMP DO schedule(static) private(jj, ji) 
     101      DO jj = 1, jpj 
     102         DO ji = 1, jpi 
     103            nmln(ji,jj)  = nlb10               ! Initialization to the number of w ocean point 
     104            hmlp(ji,jj)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
     105         END DO 
     106      END DO 
    101107      DO jk = nlb10, jpkm1 
     108!$OMP DO schedule(static) private(jj, ji, ikt) 
    102109         DO jj = 1, jpj                ! Mixed layer level: w-level  
    103110            DO ji = 1, jpi 
    … …  
    110117      ! 
    111118      ! w-level of the turbocline and mixing layer (iom_use) 
    112       imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
     119!$OMP DO schedule(static) private(jj, ji) 
     120      DO jj = 1, jpj 
     121         DO ji = 1, jpi 
     122            imld(ji,jj) = mbkt(ji,jj) + 1        ! Initialization to the number of w ocean point 
     123         END DO 
     124      END DO 
    113125      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
     126!$OMP DO schedule(static) private(jj, ji) 
    114127         DO jj = 1, jpj 
    115128            DO ji = 1, jpi 
    … …  
    119132      END DO 
    120133      ! depth of the mixing and mixed layers 
     134!$OMP DO schedule(static) private(jj, ji, iiki, iikn) 
    121135      DO jj = 1, jpj 
    122136         DO ji = 1, jpi 
    … …  
    128142         END DO 
    129143      END DO 
     144!$OMP END PARALLEL 
    130145      ! 
    131146      IF( .NOT.l_offline ) THEN 

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

    r6497 r7698  
    171171      !!---------------------------------------------------------------------- 
    172172      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     173      INTEGER             ::   jk, jj, ji   
    173174      !!---------------------------------------------------------------------- 
    174175      ! 
    … …  
    179180      ! 
    180181      IF( kt /= nit000 ) THEN   ! restore before value to compute tke 
    181          avt (:,:,:) = avt_k (:,:,:)  
    182          avm (:,:,:) = avm_k (:,:,:)  
    183          avmu(:,:,:) = avmu_k(:,:,:)  
    184          avmv(:,:,:) = avmv_k(:,:,:)  
     182!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     183         DO jk = 1, jpk 
     184            DO jj = 1, jpj 
     185               DO ji = 1, jpi 
     186                  avt (ji,jj,jk) = avt_k (ji,jj,jk)  
     187                  avm (ji,jj,jk) = avm_k (ji,jj,jk)  
     188                  avmu(ji,jj,jk) = avmu_k(ji,jj,jk)  
     189                  avmv(ji,jj,jk) = avmv_k(ji,jj,jk)  
     190               END DO 
     191            END DO 
     192         END DO 
    185193      ENDIF  
    186194      ! 
    … …  
    189197      CALL tke_avn      ! now avt, avm, avmu, avmv 
    190198      ! 
    191       avt_k (:,:,:) = avt (:,:,:)  
    192       avm_k (:,:,:) = avm (:,:,:)  
    193       avmu_k(:,:,:) = avmu(:,:,:)  
    194       avmv_k(:,:,:) = avmv(:,:,:)  
     199!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     200         DO jk = 1, jpk 
     201            DO jj = 1, jpj 
     202               DO ji = 1, jpi 
     203                  avt_k (ji,jj,jk) = avt (ji,jj,jk)  
     204                  avm_k (ji,jj,jk) = avm (ji,jj,jk)  
     205                  avmu_k(ji,jj,jk) = avmu(ji,jj,jk)  
     206                  avmv_k(ji,jj,jk) = avmv(ji,jj,jk)  
     207               END DO 
     208            END DO 
     209         END DO 
    195210      ! 
    196211#if defined key_agrif 
    … …  
    253268      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    254269      IF ( ln_isfcav ) THEN 
     270!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    255271         DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin 
    256272            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    259275         END DO 
    260276      END IF 
     277!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    261278      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    262279         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    293310         ! 
    294311         !                        !* total energy produce by LC : cumulative sum over jk 
    295          zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1) 
     312!$OMP PARALLEL 
     313!$OMP DO schedule(static) private(jj, ji) 
     314         DO jj =1, jpj 
     315            DO ji=1, jpi 
     316               zpelc(ji,jj,1) =  MAX( rn2b(ji,jj,1), 0._wp ) * gdepw_n(ji,jj,1) * e3w_n(ji,jj,1) 
     317            END DO 
     318         END DO 
    296319         DO jk = 2, jpk 
    297             zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk) 
     320!$OMP DO schedule(static) private(jj, ji) 
     321            DO jj =1, jpj 
     322               DO ji=1, jpi 
     323                  zpelc(ji,jj,jk)  = zpelc(ji,jj,jk-1) + MAX( rn2b(ji,jj,jk), 0._wp ) * gdepw_n(ji,jj,jk) * e3w_n(ji,jj,jk) 
     324               END DO 
     325            END DO 
    298326         END DO 
    299327         !                        !* finite Langmuir Circulation depth 
    300328         zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 
    301          imlc(:,:) = mbkt(:,:) + 1       ! Initialization to the number of w ocean point (=2 over land) 
     329!$OMP DO schedule(static) private(jj,ji) 
     330            DO jj = 1, jpj 
     331               DO ji = 1, jpi 
     332                  imlc(ji,jj) = mbkt(ji,jj) + 1       ! Initialization to the number of w ocean point (=2 over land) 
     333               END DO 
     334            END DO 
    302335         DO jk = jpkm1, 2, -1 
     336!$OMP DO schedule(static) private(jj, ji, zus) 
    303337            DO jj = 1, jpj               ! Last w-level at which zpelc>=0.5*us*us  
    304338               DO ji = 1, jpi            !      with us=0.016*wind(starting from jpk-1) 
    … …  
    309343         END DO 
    310344         !                               ! finite LC depth 
     345!$OMP DO schedule(static) private(jj, ji) 
    311346         DO jj = 1, jpj  
    312347            DO ji = 1, jpi 
    … …  
    315350         END DO 
    316351         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
     352!$OMP DO schedule(static) private(jk, jj, ji, zus, zind, zwlc) 
    317353         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    318354            DO jj = 2, jpjm1 
    … …  
    328364            END DO 
    329365         END DO 
     366!$OMP END PARALLEL 
    330367         ! 
    331368      ENDIF 
    … …  
    338375      !                     ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 
    339376      ! 
     377!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    340378      DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
    341379         DO jj = 1, jpjm1 
    … …  
    356394         ! Note that zesh2 is also computed in the next loop. 
    357395         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 
     396!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zesh2, zri) 
    358397         DO jk = 2, jpkm1 
    359398            DO jj = 2, jpjm1 
    … …  
    372411      ENDIF 
    373412      !          
     413!$OMP PARALLEL 
     414!$OMP DO schedule(static) private(jk, jj, ji, zcof, zzd_up, zzd_lw, zesh2) 
    374415      DO jk = 2, jpkm1           !* Matrix and right hand side in en 
    375416         DO jj = 2, jpjm1 
    … …  
    405446      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    406447      DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     448!$OMP DO schedule(static) private(jj, ji) 
    407449         DO jj = 2, jpjm1 
    408450            DO ji = fs_2, fs_jpim1    ! vector opt. 
    … …  
    411453         END DO 
    412454      END DO 
     455!$OMP DO schedule(static) private(jj, ji) 
    413456      DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    414457         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    417460      END DO 
    418461      DO jk = 3, jpkm1 
     462!$OMP DO schedule(static) private(jj, ji) 
    419463         DO jj = 2, jpjm1 
    420464            DO ji = fs_2, fs_jpim1    ! vector opt. 
    … …  
    423467         END DO 
    424468      END DO 
     469!$OMP DO schedule(static) private(jj, ji) 
    425470      DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    426471         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    429474      END DO 
    430475      DO jk = jpk-2, 2, -1 
     476!$OMP DO schedule(static) private(jj, ji) 
    431477         DO jj = 2, jpjm1 
    432478            DO ji = fs_2, fs_jpim1    ! vector opt. 
    … …  
    435481         END DO 
    436482      END DO 
     483!$OMP DO schedule(static) private(jk,jj, ji) 
    437484      DO jk = 2, jpkm1                             ! set the minimum value of tke 
    438485         DO jj = 2, jpjm1 
    … …  
    442489         END DO 
    443490      END DO 
     491!$OMP END PARALLEL 
    444492 
    445493      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    … …  
    450498       
    451499      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
     500!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    452501         DO jk = 2, jpkm1 
    453502            DO jj = 2, jpjm1 
    … …  
    459508         END DO 
    460509      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
     510!$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    461511         DO jj = 2, jpjm1 
    462512            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    467517         END DO 
    468518      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
     519!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztx2, zty2, ztau, zdif) 
    469520         DO jk = 2, jpkm1 
    470521            DO jj = 2, jpjm1 
    … …  
    545596      ! 
    546597      ! initialisation of interior minimum value (avoid a 2d loop with mikt) 
    547       zmxlm(:,:,:)  = rmxl_min     
    548       zmxld(:,:,:)  = rmxl_min 
     598!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     599      DO jk = 1, jpk 
     600         DO jj = 1, jpj 
     601            DO ji = 1, jpi 
     602               zmxlm(ji,jj,jk)  = rmxl_min     
     603               zmxld(ji,jj,jk)  = rmxl_min 
     604            END DO 
     605         END DO 
     606      END DO 
    549607      ! 
    550608      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 
     609!$OMP PARALLEL DO schedule(static) private(jj, ji, zraug) 
    551610         DO jj = 2, jpjm1 
    552611            DO ji = fs_2, fs_jpim1 
    … …  
    556615         END DO 
    557616      ELSE  
    558          zmxlm(:,:,1) = rn_mxl0 
     617!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     618         DO jj = 1, jpj 
     619            DO ji = 1, jpi 
     620               zmxlm(ji,jj,1) = rn_mxl0 
     621            END DO 
     622         END DO 
    559623      ENDIF 
    560624      ! 
     625!$OMP PARALLEL 
     626!$OMP DO schedule(static) private(jk, jj, ji, zrn2) 
    561627      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2) 
    562628         DO jj = 2, jpjm1 
    … …  
    570636      !                     !* Physical limits for the mixing length 
    571637      ! 
    572       zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value  
    573       zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value 
     638!$OMP DO schedule(static) private(jj,ji) 
     639      DO jj = 1, jpj 
     640         DO ji = 1, jpi 
     641            zmxld(ji,jj, 1 ) = zmxlm(ji,jj,1)   ! surface set to the minimum value  
     642            zmxld(ji,jj,jpk) = rmxl_min       ! last level  set to the minimum value 
     643         END DO 
     644      END DO 
     645!$OMP END PARALLEL 
    574646      ! 
    575647      SELECT CASE ( nn_mxl ) 
    … …  
    578650      ! where wmask = 0 set zmxlm == e3w_n 
    579651      CASE ( 0 )           ! bounded by the distance to surface and bottom 
     652!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 
    580653         DO jk = 2, jpkm1 
    581654            DO jj = 2, jpjm1 
    … …  
    591664         ! 
    592665      CASE ( 1 )           ! bounded by the vertical scale factor 
     666!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 
    593667         DO jk = 2, jpkm1 
    594668            DO jj = 2, jpjm1 
    … …  
    602676         ! 
    603677      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
     678!$OMP PARALLEL 
    604679         DO jk = 2, jpkm1         ! from the surface to the bottom : 
     680!$OMP DO schedule(static) private(jj, ji) 
    605681            DO jj = 2, jpjm1 
    606682               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    610686         END DO 
    611687         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : 
     688!$OMP DO schedule(static) private(jj, ji, zemxl) 
    612689            DO jj = 2, jpjm1 
    613690               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    618695            END DO 
    619696         END DO 
     697!$OMP END PARALLEL 
    620698         ! 
    621699      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
     700!$OMP PARALLEL 
    622701         DO jk = 2, jpkm1         ! from the surface to the bottom : lup 
     702!$OMP DO schedule(static) private(jj, ji) 
    623703            DO jj = 2, jpjm1 
    624704               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    628708         END DO 
    629709         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown 
     710!$OMP DO schedule(static) private(jj, ji) 
    630711            DO jj = 2, jpjm1 
    631712               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    634715            END DO 
    635716         END DO 
     717!$OMP DO schedule(static) private(jk, jj, ji, zemlm, zemlp) 
    636718         DO jk = 2, jpkm1 
    637719            DO jj = 2, jpjm1 
    … …  
    644726            END DO 
    645727         END DO 
     728!$OMP END PARALLEL 
    646729         ! 
    647730      END SELECT 
    648731      ! 
    649732# if defined key_c1d 
    650       e_dis(:,:,:) = zmxld(:,:,:)      ! c1d configuration : save mixing and dissipation turbulent length scales 
    651       e_mix(:,:,:) = zmxlm(:,:,:) 
     733!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     734      DO jk = 1, jpk 
     735         DO jj = 1, jpj 
     736            DO ji = 1, jpi 
     737               e_dis(ji,jj,jk) = zmxld(ji,jj,jk)      ! c1d configuration : save mixing and dissipation turbulent length scales 
     738               e_mix(ji,jj,jk) = zmxlm(ji,jj,jk) 
     739            END DO 
     740         END DO 
     741      END DO 
    652742# endif 
    653743 
    … …  
    655745      !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt) 
    656746      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     747!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zsqen, zav) 
    657748      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points 
    658749         DO jj = 2, jpjm1 
    … …  
    668759      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
    669760      ! 
     761!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    670762      DO jk = 2, jpkm1            !* vertical eddy viscosity at wu- and wv-points 
    671763         DO jj = 2, jpjm1 
    … …  
    679771      ! 
    680772      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt 
     773!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    681774         DO jk = 2, jpkm1 
    682775            DO jj = 2, jpjm1 
    … …  
    798891         SELECT CASE( nn_htau )             ! Choice of the depth of penetration 
    799892         CASE( 0 )                                 ! constant depth penetration (here 10 meters) 
    800             htau(:,:) = 10._wp 
     893!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     894            DO jj = 1, jpj 
     895               DO ji = 1, jpi 
     896                  htau(ji,jj) = 10._wp 
     897               END DO 
     898            END DO 
    801899         CASE( 1 )                                 ! F(latitude) : 0.5m to 30m poleward of 40 degrees 
    802             htau(:,:) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(:,:) ) ) )   )             
     900!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     901            DO jj = 1, jpj 
     902               DO ji = 1, jpi 
     903                  htau(ji,jj) = MAX(  0.5_wp, MIN( 30._wp, 45._wp* ABS( SIN( rpi/180._wp * gphit(ji,jj) ) ) )   )             
     904               END DO 
     905            END DO 
    803906         END SELECT 
    804907      ENDIF 
    805908      !                               !* set vertical eddy coef. to the background value 
     909!$OMP PARALLEL 
     910!$OMP DO schedule(static) private(jk,jj,ji) 
    806911      DO jk = 1, jpk 
    807          avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
    808          avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 
    809          avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 
    810          avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 
    811       END DO 
    812       dissl(:,:,:) = 1.e-12_wp 
     912         DO jj = 1, jpj 
     913            DO ji = 1, jpi 
     914               avt (ji,jj,jk) = avtb(jk) * wmask (ji,jj,jk) 
     915               avm (ji,jj,jk) = avmb(jk) * wmask (ji,jj,jk) 
     916               avmu(ji,jj,jk) = avmb(jk) * wumask(ji,jj,jk) 
     917               avmv(ji,jj,jk) = avmb(jk) * wvmask(ji,jj,jk) 
     918            END DO 
     919         END DO 
     920      END DO 
     921!$OMP END DO NOWAIT 
     922!$OMP DO schedule(static) private(jk,jj,ji) 
     923      DO jk = 1, jpk 
     924         DO jj = 1, jpj 
     925            DO ji = 1, jpi 
     926               dissl(ji,jj,jk) = 1.e-12_wp 
     927            END DO 
     928         END DO 
     929      END DO 
     930!$OMP END PARALLEL 
    813931      !                               
    814932      CALL tke_rst( nit000, 'READ' )  !* read or initialize all required files 
    … …  
    830948     CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    831949     ! 
    832      INTEGER ::   jit, jk   ! dummy loop indices 
     950     INTEGER ::   jit, jk, jj, ji   ! dummy loop indices 
    833951     INTEGER ::   id1, id2, id3, id4, id5, id6   ! local integers 
    834952     !!---------------------------------------------------------------------- 
    … …  
    857975           ELSE                                     ! No TKE array found: initialisation 
    858976              IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without tke scheme, en computed by iterative loop' 
    859               en (:,:,:) = rn_emin * tmask(:,:,:) 
     977!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     978              DO jk = 1, jpk 
     979                 DO jj = 1, jpj 
     980                    DO ji = 1, jpi 
     981                       en (ji,jj,jk) = rn_emin * tmask(ji,jj,jk) 
     982                    END DO 
     983                 END DO 
     984              END DO 
    860985              CALL tke_avn                               ! recompute avt, avm, avmu, avmv and dissl (approximation) 
    861986              ! 
    862               avt_k (:,:,:) = avt (:,:,:) 
    863               avm_k (:,:,:) = avm (:,:,:) 
    864               avmu_k(:,:,:) = avmu(:,:,:) 
    865               avmv_k(:,:,:) = avmv(:,:,:) 
     987!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
     988              DO jk = 1, jpk 
     989                 DO jj = 1, jpj 
     990                    DO ji = 1, jpi 
     991                       avt_k (ji,jj,jk) = avt (ji,jj,jk) 
     992                       avm_k (ji,jj,jk) = avm (ji,jj,jk) 
     993                       avmu_k(ji,jj,jk) = avmu(ji,jj,jk) 
     994                       avmv_k(ji,jj,jk) = avmv(ji,jj,jk) 
     995                    END DO 
     996                 END DO 
     997              END DO 
    866998              ! 
    867999              DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_tke( jit )   ;   END DO 
    8681000           ENDIF 
    8691001        ELSE                                   !* Start from rest 
    870            en(:,:,:) = rn_emin * tmask(:,:,:) 
     1002!$OMP PARALLEL 
     1003!$OMP DO schedule(static) private(jk,jj,ji) 
     1004           DO jk = 1, jpk 
     1005              DO jj = 1, jpj 
     1006                 DO ji = 1, jpi 
     1007                    en(ji,jj,jk) = rn_emin * tmask(ji,jj,jk) 
     1008                 END DO 
     1009              END DO 
     1010           END DO 
     1011!$OMP END DO NOWAIT 
     1012!$OMP DO schedule(static) private(jk) 
    8711013           DO jk = 1, jpk                           ! set the Kz to the background value 
    872               avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
    873               avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 
    874               avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 
    875               avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 
     1014              DO jj = 1, jpj 
     1015                 DO ji = 1, jpi 
     1016                    avt (ji,jj,jk) = avtb(jk) * wmask (ji,jj,jk) 
     1017                    avm (ji,jj,jk) = avmb(jk) * wmask (ji,jj,jk) 
     1018                    avmu(ji,jj,jk) = avmb(jk) * wumask(ji,jj,jk) 
     1019                    avmv(ji,jj,jk) = avmb(jk) * wvmask(ji,jj,jk) 
     1020                 END DO 
     1021              END DO 
    8761022           END DO 
     1023!$OMP END PARALLEL 
    8771024        ENDIF 
    8781025        ! 

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

    r6497 r7698  
    121121      !                          ! ----------------------- ! 
    122122      !                             !* First estimation (with n2 bound by rn_n2min) bounded by 60 cm2/s 
    123       zav_tide(:,:,:) = MIN(  60.e-4, az_tmx(:,:,:) / MAX( rn_n2min, rn2(:,:,:) )  ) 
    124  
    125       zkz(:,:) = 0.e0               !* Associated potential energy consummed over the whole water column 
     123!$OMP PARALLEL 
     124!$OMP DO schedule(static) private(jk,jj,ji)  
     125      DO jk = 1, jpk 
     126         DO jj = 1, jpj 
     127            DO ji = 1, jpi 
     128               zav_tide(ji,jj,jk) = MIN(  60.e-4, az_tmx(ji,jj,jk) / MAX( rn_n2min, rn2(ji,jj,jk) )  ) 
     129            END DO 
     130         END DO 
     131      END DO 
     132!$OMP END DO NOWAIT 
     133 
     134!$OMP DO schedule(static) private(jj, ji)  
     135      DO jj = 1, jpj 
     136         DO ji = 1, jpi 
     137            zkz(ji,jj) = 0.e0               !* Associated potential energy consummed over the whole water column 
     138         END DO 
     139      END DO 
    126140      DO jk = 2, jpkm1 
    127          zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
    128       END DO 
    129  
     141!$OMP DO schedule(static) private(jj, ji)  
     142         DO jj = 1, jpj 
     143            DO ji = 1, jpi 
     144               zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
     145            END DO 
     146         END DO 
     147      END DO 
     148 
     149!$OMP DO schedule(static) private(jj, ji)  
    130150      DO jj = 1, jpj                !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    131151         DO ji = 1, jpi 
    … …  
    135155 
    136156      DO jk = 2, jpkm1     !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 
    137          zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s 
    138       END DO 
     157!$OMP DO schedule(static) private(jj, ji)  
     158         DO jj = 1, jpj 
     159            DO ji = 1, jpi 
     160               zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s 
     161            END DO 
     162         END DO 
     163      END DO 
     164!$OMP END PARALLEL 
    139165 
    140166      IF( kt == nit000 ) THEN       !* check at first time-step: diagnose the energy consumed by zav_tide 
    141167         ztpc = 0._wp 
     168!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc)  
    142169         DO jk= 1, jpk 
    143170            DO jj= 1, jpj 
    … …  
    162189      !                          !   Update  mixing coefs  !                           
    163190      !                          ! ----------------------- ! 
     191!$OMP PARALLEL DO schedule(static) private(jk,jj,ji)  
    164192      DO jk = 2, jpkm1              !* update momentum & tracer diffusivity with tidal mixing 
    165          avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 
    166          avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 
     193         DO jj = 1, jpj 
     194            DO ji = 1, jpi  ! vector opt. 
     195               avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
     196               avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
     197            END DO 
     198         END DO 
    167199         DO jj = 2, jpjm1 
    168200            DO ji = fs_2, fs_jpim1  ! vector opt. 
    … …  
    225257 
    226258      !                             ! compute the form function using N2 at each time step 
    227       zempba_3d_1(:,:,jpk) = 0.e0 
    228       zempba_3d_2(:,:,jpk) = 0.e0 
     259!$OMP PARALLEL  
     260!$OMP DO schedule(static) private(jj, ji)  
     261      DO jj = 1, jpj 
     262         DO ji = 1, jpi 
     263            zempba_3d_1(ji,jj,jpk) = 0.e0 
     264            zempba_3d_2(ji,jj,jpk) = 0.e0 
     265         END DO 
     266      END DO 
     267!$OMP DO schedule(static) private(jk,jj,ji)  
    229268      DO jk = 1, jpkm1              
    230          zdn2dz     (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1)           ! Vertical profile of dN2/dz 
    231          zempba_3d_1(:,:,jk) = SQRT(  MAX( 0.e0, rn2(:,:,jk) )  )    !    -        -    of N 
    232          zempba_3d_2(:,:,jk) =        MAX( 0.e0, rn2(:,:,jk) )       !    -        -    of N^2 
    233       END DO 
    234       ! 
    235       zsum (:,:) = 0.e0 
    236       zsum1(:,:) = 0.e0 
    237       zsum2(:,:) = 0.e0 
     269         DO jj = 1, jpj 
     270            DO ji = 1, jpi 
     271               zdn2dz     (ji,jj,jk) = rn2(ji,jj,jk) - rn2(ji,jj,jk+1)           ! Vertical profile of dN2/dz 
     272               zempba_3d_1(ji,jj,jk) = SQRT(  MAX( 0.e0, rn2(ji,jj,jk) )  )    !    -        -    of N 
     273               zempba_3d_2(ji,jj,jk) =        MAX( 0.e0, rn2(ji,jj,jk) )       !    -        -    of N^2 
     274            END DO 
     275         END DO 
     276      END DO 
     277!$OMP END DO NOWAIT 
     278      ! 
     279!$OMP DO schedule(static) private(jj, ji)  
     280      DO jj = 1, jpj 
     281         DO ji = 1, jpi 
     282            zsum (ji,jj) = 0.e0 
     283            zsum1(ji,jj) = 0.e0 
     284            zsum2(ji,jj) = 0.e0 
     285         END DO 
     286      END DO 
    238287      DO jk= 2, jpk 
    239          zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk) 
    240          zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * e3w_n(:,:,jk) * wmask(:,:,jk)                
    241       END DO 
     288!$OMP DO schedule(static) private(jj,ji)  
     289         DO jj= 1, jpj 
     290            DO ji= 1, jpi 
     291               zsum1(ji,jj) = zsum1(ji,jj) + zempba_3d_1(ji,jj,jk) * e3w_n(ji,jj,jk) * wmask(ji,jj,jk) 
     292               zsum2(ji,jj) = zsum2(ji,jj) + zempba_3d_2(ji,jj,jk) * e3w_n(ji,jj,jk) * wmask(ji,jj,jk)               
     293            END DO 
     294        END DO  
     295      END DO 
     296!$OMP DO schedule(static) private(jj,ji)  
    242297      DO jj = 1, jpj 
    243298         DO ji = 1, jpi 
    … …  
    248303 
    249304      DO jk= 1, jpk 
     305!$OMP DO schedule(static) private(jj,ji,zcoef,ztpc)  
    250306         DO jj = 1, jpj 
    251307            DO ji = 1, jpi 
    … …  
    259315         END DO 
    260316       END DO 
     317!$OMP DO schedule(static) private(jj,ji)  
    261318       DO jj = 1, jpj 
    262319          DO ji = 1, jpi 
    … …  
    267324      !                             ! first estimation bounded by 10 cm2/s (with n2 bounded by rn_n2min)  
    268325      zcoef = rn_tfe_itf / ( rn_tfe * rau0 ) 
     326!$OMP DO schedule(static) private(jk,jj,ji)  
    269327      DO jk = 1, jpk 
    270          zavt_itf(:,:,jk) = MIN(  10.e-4, zcoef * en_tmx(:,:) * zsum(:,:) * zempba_3d(:,:,jk)   & 
    271             &                                      / MAX( rn_n2min, rn2(:,:,jk) ) * tmask(:,:,jk)  ) 
    272       END DO            
    273  
    274       zkz(:,:) = 0.e0               ! Associated potential energy consummed over the whole water column 
     328         DO jj = 1, jpj 
     329            DO ji = 1, jpi 
     330               zavt_itf(ji,jj,jk) = MIN(  10.e-4, zcoef * en_tmx(ji,jj) * zsum(ji,jj) * zempba_3d(ji,jj,jk)   & 
     331            &                                      / MAX( rn_n2min, rn2(ji,jj,jk) ) * tmask(ji,jj,jk)  ) 
     332            END DO 
     333         END DO 
     334      END DO                
     335 
     336!$OMP DO schedule(static) private(jj, ji)  
     337      DO jj = 1, jpj 
     338         DO ji = 1, jpi 
     339            zkz(ji,jj) = 0.e0               ! Associated potential energy consummed over the whole water column 
     340         END DO 
     341      END DO 
    275342      DO jk = 2, jpkm1 
    276          zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 
    277       END DO 
    278  
     343!$OMP DO schedule(static) private(jj,ji)  
     344         DO jj = 1, jpj 
     345            DO ji = 1, jpi 
     346               zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zavt_itf(ji,jj,jk) * wmask(ji,jj,jk) 
     347            END DO 
     348         END DO 
     349      END DO 
     350 
     351!$OMP DO schedule(static) private(jj,ji)  
    279352      DO jj = 1, jpj                ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 
    280353         DO ji = 1, jpi 
    … …  
    283356      END DO 
    284357 
     358!$OMP DO schedule(static) private(jk,jj,ji)  
    285359      DO jk = 2, jpkm1              ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s 
    286          zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk)   ! kz max = 120 cm2/s 
    287       END DO 
     360         DO jj = 1, jpj 
     361            DO ji = 1, jpi 
     362               zavt_itf(ji,jj,jk) = zavt_itf(ji,jj,jk) * MIN( zkz(ji,jj), 120./10. ) * wmask(ji,jj,jk)   ! kz max = 120 cm2/s 
     363            END DO 
     364         END DO 
     365      END DO 
     366!$OMP END PARALLEL 
    288367 
    289368      IF( kt == nit000 ) THEN       ! diagnose the nergy consumed by zavt_itf 
    290369         ztpc = 0.e0 
     370!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc)  
    291371         DO jk= 1, jpk 
    292372            DO jj= 1, jpj 
    … …  
    303383 
    304384      !                             ! Update pav with the ITF mixing coefficient 
     385!$OMP PARALLEL DO schedule(static) private(jk,jj,ji)  
    305386      DO jk = 2, jpkm1 
    306          pav(:,:,jk) = pav     (:,:,jk) * ( 1.e0 - mask_itf(:,:) )   & 
    307             &        + zavt_itf(:,:,jk) *          mask_itf(:,:)  
     387         DO jj= 1, jpj 
     388            DO ji= 1, jpi 
     389               pav(ji,jj,jk) = pav     (ji,jj,jk) * ( 1.e0 - mask_itf(ji,jj) )   & 
     390                  &        + zavt_itf(ji,jj,jk) *          mask_itf(ji,jj)  
     391            END DO 
     392         END DO 
    308393      END DO 
    309394      ! 
    … …  
    409494      !                                ! only the energy available for mixing is taken into account, 
    410495      !                                ! (mixing efficiency tidal dissipation efficiency) 
    411       en_tmx(:,:) = - rn_tfe * rn_me * ( zem2(:,:) * 1.25 + zek1(:,:) ) * ssmask(:,:) 
     496!$OMP PARALLEL 
     497 
     498!$OMP DO schedule(static) private(jj, ji)  
     499      DO jj = 1, jpj 
     500         DO ji = 1, jpi 
     501            en_tmx(ji,jj) = - rn_tfe * rn_me * ( zem2(ji,jj) * 1.25 + zek1(ji,jj) ) * ssmask(ji,jj) 
     502         END DO 
     503      END DO 
    412504 
    413505!============ 
    … …  
    416508!!     the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation. 
    417509      !                                ! Vertical structure (az_tmx) 
     510!$OMP DO schedule(static) private(jj, ji) 
    418511      DO jj = 1, jpj                         ! part independent of the level 
    419512         DO ji = 1, jpi 
    … …  
    423516         END DO 
    424517      END DO 
     518!$OMP DO schedule(static) private(jk, jj, ji) 
    425519      DO jk= 1, jpk                          ! complete with the level-dependent part 
    426520         DO jj = 1, jpj 
    … …  
    430524         END DO 
    431525      END DO 
     526!$OMP END PARALLEL 
    432527!=========== 
    433528      ! 
    … …  
    436531         ! Total power consumption due to vertical mixing 
    437532         ! zpc = rau0 * 1/rn_me * rn2 * zav_tide 
    438          zav_tide(:,:,:) = 0.e0 
     533         ztpc = 0._wp 
     534!$OMP PARALLEL 
     535!$OMP DO schedule(static) private(jk, jj, ji)  
     536         DO jk = 1, jpk 
     537            DO jj = 1, jpj 
     538               DO ji = 1, jpi 
     539                  zav_tide(ji,jj,jk) = 0.e0 
     540               END DO 
     541            END DO 
     542         END DO 
     543!$OMP DO schedule(static) private(jk,jj,ji) 
    439544         DO jk = 2, jpkm1 
    440             zav_tide(:,:,jk) = az_tmx(:,:,jk) / MAX( rn_n2min, rn2(:,:,jk) ) 
     545            DO jj = 1, jpj 
     546               DO ji = 1, jpi 
     547                  zav_tide(ji,jj,jk) = az_tmx(ji,jj,jk) / MAX( rn_n2min, rn2(ji,jj,jk) ) 
     548               END DO 
     549            END DO 
    441550         END DO 
    442551         ! 
    443          ztpc = 0._wp 
    444          zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:) 
     552!$OMP DO schedule(static) private(jk, jj, ji) 
     553         DO jk= 1, jpk 
     554            DO jj = 1, jpj 
     555               DO ji = 1, jpi 
     556                  zpc(ji,jj,jk) = MAX(rn_n2min,rn2(ji,jj,jk)) * zav_tide(ji,jj,jk) 
     557               END DO 
     558            END DO 
     559         END DO 
     560!$OMP DO schedule(static) private(jk, jj, ji, ztpc) 
    445561         DO jk= 2, jpkm1 
    446562            DO jj = 1, jpj 
    … …  
    450566            END DO 
    451567         END DO 
     568!$OMP END PARALLEL 
    452569         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    453570         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    … …  
    457574         ! 
    458575         ! control print 2 
    459          zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 )    
    460          zkz(:,:) = 0._wp 
     576!$OMP PARALLEL 
     577!$OMP DO schedule(static) private(jk, jj, ji) 
     578         DO jk= 1, jpk 
     579            DO jj = 1, jpj 
     580               DO ji = 1, jpi 
     581                  zav_tide(ji,jj,jk) = MIN( zav_tide(ji,jj,jk), 60.e-4 )    
     582                  zkz(ji,jj) = 0._wp 
     583               END DO 
     584            END DO 
     585         END DO 
     586 
    461587         DO jk = 2, jpkm1 
    462                zkz(:,:) = zkz(:,:) + e3w_n(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 
     588!$OMP DO schedule(static) private(jj, ji) 
     589            DO jj = 1, jpj 
     590               DO ji = 1, jpi 
     591                  zkz(ji,jj) = zkz(ji,jj) + e3w_n(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 
     592               END DO 
     593            END DO 
    463594         END DO 
    464595         ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz 
     596!$OMP DO schedule(static) private(jj, ji) 
    465597         DO jj = 1, jpj 
    466598            DO ji = 1, jpi 
    … …  
    471603         END DO 
    472604         ztpc = 1.e50 
     605!$OMP DO schedule(static) private(jj, ji, ztpc) 
    473606         DO jj = 1, jpj 
    474607            DO ji = 1, jpi 
    … …  
    478611            END DO 
    479612         END DO 
     613!$OMP END PARALLEL 
    480614         WRITE(numout,*) '          Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) ) 
     615!$OMP PARALLEL  
    481616         ! 
     617!$OMP DO schedule(static) private(jk,jj,ji) 
    482618         DO jk = 2, jpkm1 
    483             zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk)  !kz max = 300 cm2/s 
     619            DO jj = 1, jpj 
     620               DO ji = 1, jpi 
     621                  zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk)  !kz max = 300 cm2/s 
     622               END DO 
     623            END DO 
    484624         END DO 
    485625         ztpc = 0._wp 
    486          zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:) 
     626!$OMP DO schedule(static) private(jk, jj, ji) 
    487627         DO jk= 1, jpk 
    488628            DO jj = 1, jpj 
    489629               DO ji = 1, jpi 
     630                  zpc(ji,jj,jk) = Max(0.e0,rn2(ji,jj,jk)) * zav_tide(ji,jj,jk) 
     631               END DO 
     632            END DO 
     633         END DO 
     634!$OMP DO schedule(static) private(jk, jj, ji, ztpc) 
     635         DO jk= 1, jpk 
     636            DO jj = 1, jpj 
     637               DO ji = 1, jpi 
    490638                  ztpc = ztpc + e3w_n(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    491639               END DO 
    492640            END DO 
    493641         END DO 
     642!$OMP END PARALLEL 
    494643         IF( lk_mpp )   CALL mpp_sum( ztpc ) 
    495644         ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 
    … …  
    500649               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask   (:,:,jk) * tmask_i(:,:) ) ) 
    501650            ztpc = 1.e50 
     651!$OMP PARALLEL DO schedule(static) private(ztpc, jj, ji) 
    502652            DO jj = 1, jpj 
    503653               DO ji = 1, jpi 
    … …  
    513663         WRITE(numout,*) '          Initial profile of tidal vertical mixing' 
    514664         DO jk = 1, jpk 
     665!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    515666            DO jj = 1,jpj 
    516667               DO ji = 1,jpi 
    … …  
    523674         END DO 
    524675         DO jk = 1, jpk 
    525             zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 
     676!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     677            DO jj = 1,jpj 
     678               DO ji = 1,jpi 
     679                  zkz(ji,jj) = az_tmx(ji,jj,jk) /rn_n2min 
     680               END DO 
     681            END DO 
    526682            ze_z =                  SUM( e1e2t(:,:) * zkz  (:,:)    * tmask_i(:,:) )   & 
    527683               &     / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) 
    … …  
    689845      !                        !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    690846      !                                                 using an exponential decay from the seafloor. 
     847!$OMP PARALLEL 
     848!$OMP DO schedule(static) private(jj,ji) 
    691849      DO jj = 1, jpj                ! part independent of the level 
    692850         DO ji = 1, jpi 
    … …  
    697855      END DO 
    698856 
     857!$OMP DO schedule(static) private(jk,jj,ji) 
    699858      DO jk = 2, jpkm1              ! complete with the level-dependent part 
    700          emix_tmx(:,:,jk) = zfact(:,:) * (  EXP( ( gde3w_n(:,:,jk  ) - zhdep(:,:) ) / hcri_tmx(:,:) )                      & 
    701             &                             - EXP( ( gde3w_n(:,:,jk-1) - zhdep(:,:) ) / hcri_tmx(:,:) )  ) * wmask(:,:,jk)   & 
    702             &                          / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 
    703       END DO 
     859         DO jj = 1, jpj 
     860            DO ji = 1, jpi 
     861               emix_tmx(ji,jj,jk) = zfact(ji,jj) * (  EXP( ( gde3w_n(ji,jj,jk  ) - zhdep(ji,jj) ) / hcri_tmx(:,:) )                      & 
     862                  &                             - EXP( ( gde3w_n(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_tmx(ji,jj) )  ) * wmask(ji,jj,jk)   & 
     863                  &                          / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 
     864            END DO 
     865         END DO 
     866      END DO 
     867!$OMP END PARALLEL 
    704868 
    705869      !                        !* Pycnocline-intensified mixing: distribute energy over the time-varying  
    … …  
    710874      CASE ( 1 )               ! Dissipation scales as N (recommended) 
    711875 
    712          zfact(:,:) = 0._wp 
     876!$OMP PARALLEL 
     877!$OMP DO schedule(static) private(jj, ji)  
     878         DO jj = 1, jpj 
     879            DO ji = 1, jpi 
     880               zfact(ji,jj) = 0._wp 
     881            END DO 
     882         END DO 
    713883         DO jk = 2, jpkm1              ! part independent of the level 
    714             zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
    715          END DO 
    716  
     884!$OMP DO schedule(static) private(jj,ji) 
     885            DO jj = 1, jpj                ! part independent of the level 
     886               DO ji = 1, jpi 
     887                  zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
     888               END DO 
     889            END DO 
     890         END DO 
     891 
     892!$OMP DO schedule(static) private(jj,ji) 
    717893         DO jj = 1, jpj 
    718894            DO ji = 1, jpi 
    … …  
    721897         END DO 
    722898 
     899!$OMP DO schedule(static) private(jk,jj,ji) 
    723900         DO jk = 2, jpkm1              ! complete with the level-dependent part 
    724             emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
    725          END DO 
     901            DO jj = 1, jpj 
     902               DO ji = 1, jpi 
     903                  emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,ji,jk) 
     904               END DO 
     905            END DO 
     906         END DO 
     907!$OMP END PARALLEL 
    726908 
    727909      CASE ( 2 )               ! Dissipation scales as N^2 
    728910 
    729          zfact(:,:) = 0._wp 
    730          DO jk = 2, jpkm1              ! part independent of the level 
    731             zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
    732          END DO 
    733  
     911!$OMP PARALLEL 
     912!$OMP DO schedule(static) private(jj, ji)  
     913         DO jj = 1, jpj 
     914            DO ji = 1, jpi 
     915               zfact(ji,jj) = 0._wp 
     916            END DO 
     917         END DO 
     918 
     919         DO jk = 2, jpkm1             
     920!$OMP DO schedule(static) private(jj,ji) 
     921            DO jj = 1, jpj            
     922               DO ji = 1, jpi 
     923                  zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
     924               END DO 
     925            END DO 
     926         END DO 
     927 
     928!$OMP DO schedule(static) private(jj,ji) 
    734929         DO jj= 1, jpj 
    735930            DO ji = 1, jpi 
    … …  
    738933         END DO 
    739934 
     935!$OMP DO schedule(static) private(jk,jj,ji) 
    740936         DO jk = 2, jpkm1              ! complete with the level-dependent part 
    741             emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
    742          END DO 
     937            DO jj = 1, jpj 
     938               DO ji = 1, jpi 
     939                  emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,ji,jk) 
     940               END DO 
     941            END DO 
     942         END DO 
     943!$OMP END PARALLEL 
    743944 
    744945      END SELECT 
    … …  
    747948      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
    748949       
    749       zwkb(:,:,:) = 0._wp 
    750       zfact(:,:) = 0._wp 
     950!$OMP PARALLEL 
     951!$OMP DO schedule(static) private(jk,jj,ji)  
     952      DO jk = 1, jpk 
     953         DO jj = 1, jpj 
     954            DO ji = 1, jpi 
     955               zwkb(ji,jj,jk) = 0._wp 
     956            END DO 
     957         END DO 
     958      END DO 
     959!$OMP DO schedule(static) private(jj,ji) 
     960      DO jj = 1, jpj 
     961         DO ji = 1, jpi 
     962            zfact(ji,jj) = 0._wp 
     963         END DO 
     964      END DO 
    751965      DO jk = 2, jpkm1 
    752          zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
    753          zwkb(:,:,jk) = zfact(:,:) 
    754       END DO 
    755  
     966!$OMP DO schedule(static) private(jj,ji) 
     967         DO jj = 1, jpj            
     968            DO ji = 1, jpi 
     969               zfact(ji,jj) = zfact(ji,jj) + e3w_n(ji,jj,jk) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
     970               zwkb(ji,jj,jk) = zfact(ji,jj) 
     971            END DO 
     972         END DO 
     973      END DO 
     974 
     975!$OMP DO schedule(static) private(jk,jj,ji) 
    756976      DO jk = 2, jpkm1 
    757977         DO jj = 1, jpj 
    … …  
    762982         END DO 
    763983      END DO 
    764       zwkb(:,:,1) = zhdep(:,:) * tmask(:,:,1) 
    765  
    766       zweight(:,:,:) = 0._wp 
     984 
     985!$OMP DO schedule(static) private(jj, ji)  
     986      DO jj = 1, jpj 
     987         DO ji = 1, jpi 
     988            zwkb(ji,jj,1) = zhdep(ji,jj) * tmask(ji,jj,1) 
     989         END DO 
     990      END DO 
     991!$OMP END DO NOWAIT 
     992!$OMP DO schedule(static) private(jk,jj,ji)  
     993      DO jk = 1, jpk 
     994         DO jj = 1, jpj 
     995            DO ji = 1, jpi 
     996               zweight(ji,jj,jk) = 0._wp 
     997            END DO 
     998         END DO 
     999      END DO 
     1000 
     1001!$OMP DO schedule(static) private(jk,jj,ji) 
    7671002      DO jk = 2, jpkm1 
    768          zweight(:,:,jk) = MAX( 0._wp, rn2(:,:,jk) ) * hbot_tmx(:,:) * wmask(:,:,jk)                    & 
    769             &   * (  EXP( -zwkb(:,:,jk) / hbot_tmx(:,:) ) - EXP( -zwkb(:,:,jk-1) / hbot_tmx(:,:) )  ) 
    770       END DO 
    771  
    772       zfact(:,:) = 0._wp 
     1003         DO jj = 1, jpj 
     1004            DO ji = 1, jpi 
     1005               zweight(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * hbot_tmx(ji,jj) * wmask(ji,jj,jk)                    & 
     1006                &   * (  EXP( -zwkb(ji,jj,jk) / hbot_tmx(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_tmx(ji,jj) )  ) 
     1007            END DO 
     1008         END DO 
     1009      END DO 
     1010 
     1011!$OMP DO schedule(static) private(jj, ji)  
     1012      DO jj = 1, jpj 
     1013         DO ji = 1, jpi 
     1014            zfact(ji,jj) = 0._wp 
     1015         END DO 
     1016      END DO 
     1017 
    7731018      DO jk = 2, jpkm1              ! part independent of the level 
    774          zfact(:,:) = zfact(:,:) + zweight(:,:,jk) 
    775       END DO 
    776  
     1019!$OMP DO schedule(static) private(jj,ji) 
     1020         DO jj = 1, jpj            
     1021            DO ji = 1, jpi 
     1022               zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 
     1023            END DO 
     1024         END DO 
     1025      END DO 
     1026 
     1027!$OMP DO schedule(static) private(jj,ji) 
    7771028      DO jj = 1, jpj 
    7781029         DO ji = 1, jpi 
    … …  
    7811032      END DO 
    7821033 
     1034!$OMP DO schedule(static) private(jk,jj,ji) 
    7831035      DO jk = 2, jpkm1              ! complete with the level-dependent part 
    784          emix_tmx(:,:,jk) = emix_tmx(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk)   & 
    785             &                                / ( gde3w_n(:,:,jk) - gde3w_n(:,:,jk-1) ) 
    786       END DO 
     1036         DO jj = 1, jpj 
     1037            DO ji = 1, jpi 
     1038               emix_tmx(ji,jj,jk) = emix_tmx(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,ji,jk) 
     1039                  &                                / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 
     1040            END DO 
     1041         END DO 
     1042      END DO 
     1043!$OMP END DO NOWAIT 
    7871044 
    7881045 
    7891046      ! Calculate molecular kinematic viscosity 
    790       znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem)  & 
    791          &                                  + 0.02305_wp * tsn(:,:,:,jp_sal)  ) * tmask(:,:,:) * r1_rau0 
     1047!$OMP DO schedule(static) private(jj, ji)  
     1048      DO jj = 1, jpj 
     1049         DO ji = 1, jpi 
     1050            znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * tsn(ji,jj,jk,jp_tem) & 
     1051         &                                  + 0.00694_wp * tsn(ji,jj,jk,jp_tem) * tsn(ji,jj,jk,jp_tem)  & 
     1052         &                                  + 0.02305_wp * tsn(ji,jj,jk,jp_sal)  ) * tmask(ji,jj,jk) * r1_rau0 
     1053         END DO 
     1054      END DO 
     1055!$OMP DO schedule(static) private(jk,jj,ji) 
    7921056      DO jk = 2, jpkm1 
    793          znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 
     1057         DO jj = 1, jpj 
     1058            DO ji = 1, jpi 
     1059               znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 
     1060            END DO 
     1061         END DO 
    7941062      END DO 
    7951063 
    7961064      ! Calculate turbulence intensity parameter Reb 
     1065!$OMP DO schedule(static) private(jk,jj,ji) 
    7971066      DO jk = 2, jpkm1 
    798          zReb(:,:,jk) = emix_tmx(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) ) 
     1067         DO jj = 1, jpj 
     1068            DO ji = 1, jpi 
     1069               zReb(ji,jj,jk) = emix_tmx(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 
     1070            END DO 
     1071         END DO 
    7991072      END DO 
    8001073 
    8011074      ! Define internal wave-induced diffusivity 
     1075!$OMP DO schedule(static) private(jk,jj,ji) 
    8021076      DO jk = 2, jpkm1 
    803          zav_wave(:,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
    804       END DO 
     1077         DO jj = 1, jpj 
     1078            DO ji = 1, jpi 
     1079               zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
     1080            END DO 
     1081         END DO 
     1082      END DO 
     1083!$OMP END PARALLEL 
    8051084 
    8061085      IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the 
     1086!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    8071087         DO jk = 2, jpkm1              ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 
    8081088            DO jj = 1, jpj 
    … …  
    8181098      ENDIF 
    8191099 
     1100!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    8201101      DO jk = 2, jpkm1                 ! Bound diffusivity by molecular value and 100 cm2/s 
    821          zav_wave(:,:,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp  ) * wmask(:,:,jk) 
     1102         DO jj = 1, jpj 
     1103            DO ji = 1, jpi 
     1104               zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk) 
     1105            END DO 
     1106         END DO 
    8221107      END DO 
    8231108 
    8241109      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave 
    8251110         ztpc = 0._wp 
     1111!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,ztpc) 
    8261112         DO jk = 2, jpkm1 
    8271113            DO jj = 1, jpj 
    … …  
    8491135      !       
    8501136      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature 
     1137!$OMP PARALLEL 
     1138!$OMP DO schedule(static) private(jk,jj,ji) 
    8511139         DO jk = 2, jpkm1              ! Calculate S/T diffusivity ratio as a function of Reb 
    8521140            DO jj = 1, jpj 
    … …  
    8581146            END DO 
    8591147         END DO 
     1148!$OMP DO schedule(static) private(jk,jj,ji) 
     1149         DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing 
     1150            DO jj = 1, jpj 
     1151               DO ji = 1, jpi 
     1152                  fsavs(ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 
     1153                  avt  (ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     1154                  avm  (ji,jj,jk) = avm(ji,jj,jk) + zav_wave(ji,jj,jk) 
     1155               END DO 
     1156            END DO 
     1157         END DO 
     1158!$OMP END PARALLEL 
    8601159         CALL iom_put( "av_ratio", zav_ratio ) 
    861          DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing 
    862             fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) * zav_ratio(:,:,jk) 
    863             avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
    864             avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk) 
    865          END DO 
    8661160         ! 
    8671161      ELSE                          !* update momentum & tracer diffusivity with wave-driven mixing 
     1162!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    8681163         DO jk = 2, jpkm1 
    869             fsavs(:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
    870             avt  (:,:,jk) = avt(:,:,jk) + zav_wave(:,:,jk) 
    871             avm  (:,:,jk) = avm(:,:,jk) + zav_wave(:,:,jk) 
     1164            DO jj = 1, jpj 
     1165               DO ji = 1, jpi 
     1166                  fsavs(ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     1167                  avt  (ji,jj,jk) = avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     1168                  avm  (ji,jj,jk) = avm(ji,jj,jk) + zav_wave(ji,jj,jk) 
     1169               END DO 
     1170            END DO 
    8721171         END DO 
    8731172      ENDIF 
    8741173 
     1174!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    8751175      DO jk = 2, jpkm1              !* update momentum diffusivity at wu and wv points 
    8761176         DO jj = 2, jpjm1 
    … …  
    8881188                                    !  vertical integral of rau0 * Kz * N^2 (pcmap_tmx), energy density (emix_tmx) 
    8891189      IF( iom_use("bflx_tmx") .OR. iom_use("pcmap_tmx") ) THEN 
    890          bflx_tmx(:,:,:) = MAX( 0._wp, rn2(:,:,:) ) * zav_wave(:,:,:) 
    891          pcmap_tmx(:,:) = 0._wp 
    892          DO jk = 2, jpkm1 
    893             pcmap_tmx(:,:) = pcmap_tmx(:,:) + e3w_n(:,:,jk) * bflx_tmx(:,:,jk) * wmask(:,:,jk) 
    894          END DO 
    895          pcmap_tmx(:,:) = rau0 * pcmap_tmx(:,:) 
     1190!$OMP PARALLEL 
     1191!$OMP DO schedule(static) private(jk,jj,ji) 
     1192      DO jk = 1, jpk 
     1193         DO jj = 1, jpj 
     1194            DO ji = 1, jpi 
     1195               bflx_tmx(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) 
     1196            END DO 
     1197         END DO 
     1198      END DO 
     1199!$OMP END DO NOWAIT 
     1200!$OMP DO schedule(static) private(jj, ji)  
     1201      DO jj = 1, jpj 
     1202         DO ji = 1, jpi 
     1203            pcmap_tmx(ji,jj) = 0._wp 
     1204         END DO 
     1205      END DO 
     1206      DO jk = 2, jpkm1 
     1207!$OMP DO schedule(static) private(jj, ji)  
     1208         DO jj = 1, jpj 
     1209            DO ji = 1, jpi 
     1210               pcmap_tmx(ji,jj) = pcmap_tmx(ji,jj) + e3w_n(ji,jj,jk) * bflx_tmx(ji,jj,jk) * wmask(ji,jj,jk) 
     1211            END DO 
     1212         END DO 
     1213      END DO 
     1214!$OMP DO schedule(static) private(jj, ji)  
     1215      DO jj = 1, jpj 
     1216         DO ji = 1, jpi 
     1217            pcmap_tmx(ji,jj) = rau0 * pcmap_tmx(ji,jj) 
     1218         END DO 
     1219      END DO 
     1220!$OMP END PARALLEL 
    8961221         CALL iom_put( "bflx_tmx", bflx_tmx ) 
    8971222         CALL iom_put( "pcmap_tmx", pcmap_tmx ) 
    … …  
    9701295      avmb(:) = 1.4e-6_wp        ! viscous molecular value 
    9711296      avtb(:) = 1.e-10_wp        ! very small diffusive minimum (background avt is specified in zdf_tmx)     
    972       avtb_2d(:,:) = 1.e0_wp     ! uniform  
     1297!$OMP PARALLEL DO schedule(static) private(jj, ji)  
     1298      DO jj = 1, jpj 
     1299         DO ji = 1, jpi 
     1300            avtb_2d(ji,jj) = 1.e0_wp     ! uniform  
     1301         END DO 
     1302      END DO 
    9731303      IF(lwp) THEN                  ! Control print 
    9741304         WRITE(numout,*) 
    … …  
    10031333      CALL iom_close(inum) 
    10041334 
    1005       ebot_tmx(:,:) = ebot_tmx(:,:) * ssmask(:,:) 
    1006       epyc_tmx(:,:) = epyc_tmx(:,:) * ssmask(:,:) 
    1007       ecri_tmx(:,:) = ecri_tmx(:,:) * ssmask(:,:) 
    1008  
    1009       ! Set once for all to zero the first and last vertical levels of appropriate variables 
    1010       emix_tmx (:,:, 1 ) = 0._wp 
    1011       emix_tmx (:,:,jpk) = 0._wp 
    1012       zav_ratio(:,:, 1 ) = 0._wp 
    1013       zav_ratio(:,:,jpk) = 0._wp 
    1014       zav_wave (:,:, 1 ) = 0._wp 
    1015       zav_wave (:,:,jpk) = 0._wp 
     1335!$OMP PARALLEL DO schedule(static) private(jj, ji)  
     1336      DO jj = 1, jpj 
     1337         DO ji = 1, jpi 
     1338            ebot_tmx(ji,jj) = ebot_tmx(ji,jj) * ssmask(ji,jj) 
     1339            epyc_tmx(ji,jj) = epyc_tmx(ji,jj) * ssmask(ji,jj) 
     1340            ecri_tmx(ji,jj) = ecri_tmx(ji,jj) * ssmask(ji,jj) 
     1341             
     1342            ! Set once for all to zero the first and last vertical levels of appropriate variables 
     1343            emix_tmx (ji,jj, 1 ) = 0._wp 
     1344            emix_tmx (ji,jj,jpk) = 0._wp 
     1345            zav_ratio(ji,jj, 1 ) = 0._wp 
     1346            zav_ratio(ji,jj,jpk) = 0._wp 
     1347            zav_wave (ji,jj, 1 ) = 0._wp 
     1348            zav_wave (ji,jj,jpk) = 0._wp 
     1349         END DO 
     1350      END DO 
    10161351 
    10171352      zbot = glob_sum( e1e2t(:,:) * ebot_tmx(:,:) ) 

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

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