Changeset 6748


Ignore:
Timestamp:
2016-06-28T11:53:56+02:00 (4 years ago)
Author:
mocavero
Message:

GYRE hybrid parallelization

Location:
branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC
Files:
51 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90

    r6140 r6748  
    134134      ! ------------------------- ! 
    135135      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!$OMP PARALLEL WORKSHARE 
    136137      tn_25h(:,:,:) = tsb(:,:,:,jp_tem) 
    137138      sn_25h(:,:,:) = tsb(:,:,:,jp_sal) 
     
    148149         rmxln_25h(:,:,:) = mxln(:,:,:) 
    149150#endif 
     151!$OMP END PARALLEL WORKSHARE 
    150152#if defined key_lim3 || defined key_lim2 
    151153         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90

    r6140 r6748  
    181181 
    182182         ALLOCATE( zcu_cfl(jpi, jpj, jpk), zcv_cfl(jpi, jpj, jpk), zcw_cfl(jpi, jpj, jpk) ) 
    183  
     183!$OMP PARALLEL WORKSHARE 
    184184         zcu_cfl(:,:,:)=0.0 
    185185         zcv_cfl(:,:,:)=0.0 
    186186         zcw_cfl(:,:,:)=0.0 
    187  
     187!$OMP END PARALLEL WORKSHARE 
    188188         IF( lwp ) THEN 
    189189            WRITE(numout,*) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r6140 r6748  
    7575         IF( lk_mpp )   CALL mpp_sum( a_sshb )      ! sum over the global domain 
    7676 
     77!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zwei,a_salb) 
    7778         DO jk = 1, jpkm1 
    7879            DO jj = 2, jpjm1 
     
    101102         IF( lk_mpp )   CALL mpp_sum( zarea  )      ! sum over the global domain 
    102103          
     104!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zwei,a_saln,zvol) 
    103105         DO jk = 1, jpkm1    
    104106            DO jj = 2, jpjm1 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6387 r6748  
    157157      CALL iom_put(  "sst", tsn(:,:,1,jp_tem) )    ! surface temperature 
    158158      IF ( iom_use("sbt") ) THEN 
     159!$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    159160         DO jj = 1, jpj 
    160161            DO ji = 1, jpi 
     
    169170      CALL iom_put(  "sss", tsn(:,:,1,jp_sal) )    ! surface salinity 
    170171      IF ( iom_use("sbs") ) THEN 
     172!$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    171173         DO jj = 1, jpj 
    172174            DO ji = 1, jpi 
     
    180182      IF ( iom_use("taubot") ) THEN                ! bottom stress 
    181183         z2d(:,:) = 0._wp 
     184!$OMP PARALLEL DO schedule(static) private(jj, ji, zztmpx,zztmpy) 
    182185         DO jj = 2, jpjm1 
    183186            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    197200      CALL iom_put(  "ssu", un(:,:,1)         )    ! surface i-current 
    198201      IF ( iom_use("sbu") ) THEN 
     202!$OMP PARALLEL DO schedule(static) private(jj, ji, jkbot) 
    199203         DO jj = 1, jpj 
    200204            DO ji = 1, jpi 
     
    209213      CALL iom_put(  "ssv", vn(:,:,1)         )    ! surface j-current 
    210214      IF ( iom_use("sbv") ) THEN 
     215!$OMP PARALLEL DO schedule(static) private(jj, ji,jkbot) 
    211216         DO jj = 1, jpj 
    212217            DO ji = 1, jpi 
     
    222227         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
    223228         z2d(:,:) = rau0 * e1e2t(:,:) 
     229!$OMP PARALLEL DO schedule(static) private(jk) 
    224230         DO jk = 1, jpk 
    225             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     231            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)  
    226232         END DO 
    227233         CALL iom_put( "w_masstr" , z3d )   
     
    237243 
    238244      IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 
     245!$OMP PARALLEL DO schedule(static) private(jj, ji, zztmp, zztmpx, zztmpy) 
    239246         DO jj = 2, jpjm1                                    ! sst gradient 
    240247            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    255262      IF( iom_use("heatc") ) THEN 
    256263         z2d(:,:)  = 0._wp  
     264!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    257265         DO jk = 1, jpkm1 
    258266            DO jj = 1, jpj 
     
    267275      IF( iom_use("saltc") ) THEN 
    268276         z2d(:,:)  = 0._wp  
     277!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    269278         DO jk = 1, jpkm1 
    270279            DO jj = 1, jpj 
     
    279288      IF ( iom_use("eken") ) THEN 
    280289         rke(:,:,jk) = 0._wp                               !      kinetic energy  
     290!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zztmp, zztmpx, zztmpy) 
    281291         DO jk = 1, jpkm1 
    282292            DO jj = 2, jpjm1 
     
    304314      IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    305315         z3d(:,:,jpk) = 0.e0 
     316!$OMP PARALLEL DO schedule(static) private(jk) 
    306317         DO jk = 1, jpkm1 
    307318            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * e3u_n(:,:,jk) * umask(:,:,jk) 
     
    312323      IF( iom_use("u_heattr") ) THEN 
    313324         z2d(:,:) = 0.e0  
     325!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    314326         DO jk = 1, jpkm1 
    315327            DO jj = 2, jpjm1 
     
    325337      IF( iom_use("u_salttr") ) THEN 
    326338         z2d(:,:) = 0.e0  
     339!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    327340         DO jk = 1, jpkm1 
    328341            DO jj = 2, jpjm1 
     
    339352      IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 
    340353         z3d(:,:,jpk) = 0.e0 
     354!$OMP PARALLEL DO schedule(static) private(jk) 
    341355         DO jk = 1, jpkm1 
    342356            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * e3v_n(:,:,jk) * vmask(:,:,jk) 
     
    347361      IF( iom_use("v_heattr") ) THEN 
    348362         z2d(:,:) = 0.e0  
     363!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    349364         DO jk = 1, jpkm1 
    350365            DO jj = 2, jpjm1 
     
    360375      IF( iom_use("v_salttr") ) THEN 
    361376         z2d(:,:) = 0.e0  
     377!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    362378         DO jk = 1, jpkm1 
    363379            DO jj = 2, jpjm1 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90

    r5836 r6748  
    446446      ! 
    447447      DO jc = 1, jpncs 
     448!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    448449         DO jj = ncsj1(jc), ncsj2(jc) 
    449450            DO ji = ncsi1(jc), ncsi2(jc) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r6140 r6748  
    7070      !!              - 1D configuration, move Coriolis, u and v at T-point 
    7171      !!---------------------------------------------------------------------- 
    72       INTEGER ::   jk          ! dummy loop indices 
     72      INTEGER ::   jk, jj, ji          ! dummy loop indices 
    7373      INTEGER ::   iconf = 0   ! local integers 
    7474      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_hu_0, z1_hv_0 
     
    9292      IF( ln_sco )   CALL dom_stiff             ! Maximum stiffness ratio/hydrostatic consistency 
    9393      ! 
     94!$OMP PARALLEL WORKSHARE 
    9495      ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness 
    9596      hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1) 
    9697      hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1) 
     98!$OMP END PARALLEL WORKSHARE 
    9799      DO jk = 2, jpk 
    98          ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk) 
    99          hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk) 
    100          hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk) 
     100!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     101         DO jj =1, jpj 
     102            DO ji=1, jpi 
     103                ht_0(ji,jj) = ht_0(ji,jj) + e3t_0(ji,jj,jk) * tmask(ji,jj,jk) 
     104                hu_0(ji,jj) = hu_0(ji,jj) + e3u_0(ji,jj,jk) * umask(ji,jj,jk) 
     105                hv_0(ji,jj) = hv_0(ji,jj) + e3v_0(ji,jj,jk) * vmask(ji,jj,jk) 
     106            END DO 
     107         END DO 
    101108      END DO 
    102109      ! 
     
    119126         CALL wrk_alloc( jpi,jpj,   z1_hu_0, z1_hv_0 ) 
    120127         ! 
     128!$OMP PARALLEL WORKSHARE 
    121129         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF 
    122130         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) ) 
     131!$OMP END PARALLEL WORKSHARE 
    123132         ! 
    124133         !        before       !          now          !       after         ! 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r6140 r6748  
    140140         IF( ie1e2u_v == 0 ) THEN      ! e1e2u and e1e2v have not been read: compute them 
    141141            !                          ! e2u and e1v does not include a reduction in some strait: apply reduction 
     142!$OMP PARALLEL WORKSHARE 
    142143            e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
    143144            e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
     145!$OMP END PARALLEL WORKSHARE 
    144146         ENDIF 
    145147         ! 
     
    150152         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg'  
    151153         ! 
     154!$OMP PARALLEL DO schedule(static) private(jj, ji, zti, zui, zvi, zfi, ztj, zuj, zvj, zfj) 
    152155         DO jj = 1, jpj 
    153156            DO ji = 1, jpi 
     
    200203         ENDIF 
    201204#endif          
     205!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    202206         DO jj = 1, jpj 
    203207            DO ji = 1, jpi 
     
    216220         ! Horizontal scale factors (in meters) 
    217221         !                              ====== 
     222!$OMP PARALLEL WORKSHARE 
    218223         e1t(:,:) = ppe1_m      ;      e2t(:,:) = ppe2_m 
    219224         e1u(:,:) = ppe1_m      ;      e2u(:,:) = ppe2_m 
    220225         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m 
    221226         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m 
     227!$OMP END PARALLEL WORKSHARE 
    222228         ! 
    223229      CASE ( 4 )                     !==  geographical mesh on the sphere, isotropic MERCATOR type  ==! 
     
    238244         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq 
    239245         ! 
     246!$OMP PARALLEL DO schedule(static) private(jj, ji, zti, zui, zvi, zfi, ztj, zuj, zvj, zfj) 
    240247         DO jj = 1, jpj 
    241248            DO ji = 1, jpi 
     
    296303         ENDIF 
    297304         ! 
     305!$OMP PARALLEL DO schedule(static) private(jj, ji, zim1, zjm1) 
    298306         DO jj = 1, jpj 
    299307            DO ji = 1, jpi 
     
    317325         ! Horizontal scale factors (in meters) 
    318326         !                              ====== 
     327!$OMP PARALLEL WORKSHARE 
    319328         e1t(:,:) =  ze1     ;      e2t(:,:) = ze1 
    320329         e1u(:,:) =  ze1     ;      e2u(:,:) = ze1 
    321330         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1 
    322331         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1 
     332!$OMP END PARALLEL WORKSHARE 
    323333         ! 
    324334      CASE DEFAULT 
     
    331341      ! ----------------------------- 
    332342      ! 
     343!$OMP PARALLEL WORKSHARE 
    333344      r1_e1t(:,:) = 1._wp / e1t(:,:)   ;   r1_e2t (:,:) = 1._wp / e2t(:,:) 
    334345      r1_e1u(:,:) = 1._wp / e1u(:,:)   ;   r1_e2u (:,:) = 1._wp / e2u(:,:) 
     
    338349      e1e2t (:,:) = e1t(:,:) * e2t(:,:)   ;   r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 
    339350      e1e2f (:,:) = e1f(:,:) * e2f(:,:)   ;   r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 
     351!$OMP END PARALLEL WORKSHARE 
    340352      IF( jphgr_msh /= 0 ) THEN               ! e1e2u and e1e2v have not been set: compute them 
     353!$OMP PARALLEL WORKSHARE 
    341354         e1e2u (:,:) = e1u(:,:) * e2u(:,:)    
    342355         e1e2v (:,:) = e1v(:,:) * e2v(:,:)  
     356!$OMP END PARALLEL WORKSHARE 
    343357      ENDIF 
     358!$OMP PARALLEL WORKSHARE 
    344359      r1_e1e2u(:,:) = 1._wp / e1e2u(:,:)     ! compute their invert in both cases 
    345360      r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 
     
    347362      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    348363      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     364!$OMP END PARALLEL WORKSHARE 
    349365 
    350366      IF( lwp .AND. nn_print >=1 .AND. .NOT.ln_rstart ) THEN      ! Control print : Grid informations (if not restart) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r6140 r6748  
    146146      ! N.B. tmask has already the right boundary conditions since mbathy is ok 
    147147      ! 
    148       tmask(:,:,:) = 0._wp 
     148!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    149149      DO jk = 1, jpk 
    150150         DO jj = 1, jpj 
    151151            DO ji = 1, jpi 
     152               tmask(ji,jj,jk) = 0._wp 
    152153               IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp 
    153154            END DO   
     
    156157       
    157158      ! (ISF) define barotropic mask and mask the ice shelf point 
     159!$OMP PARALLEL WORKSHARE 
    158160      ssmask(:,:)=tmask(:,:,1) ! at this stage ice shelf is not masked 
    159        
     161!$OMP END PARALLEL WORKSHARE       
     162!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    160163      DO jk = 1, jpk 
    161164         DO jj = 1, jpj 
     
    170173      ! Interior domain mask (used for global sum) 
    171174      ! -------------------- 
     175!$OMP PARALLEL WORKSHARE 
    172176      tmask_i(:,:) = ssmask(:,:)            ! (ISH) tmask_i = 1 even on the ice shelf 
    173177 
    174178      tmask_h(:,:) = 1._wp                 ! 0 on the halo and 1 elsewhere 
     179!$OMP END PARALLEL WORKSHARE 
    175180      iif = jpreci                         ! ??? 
    176181      iil = nlci - jpreci + 1 
     
    206211      ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask) 
    207212      ! ------------------------------------------- 
     213!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    208214      DO jk = 1, jpk 
    209215         DO jj = 1, jpjm1 
     
    219225      END DO 
    220226      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point 
     227!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    221228      DO jj = 1, jpjm1 
    222229         DO ji = 1, fs_jpim1   ! vector loop 
     
    241248      wumask(:,:,1) = umask(:,:,1) 
    242249      wvmask(:,:,1) = vmask(:,:,1) 
     250!$OMP PARALLEL DO schedule(static) private(jk) 
    243251      DO jk = 2, jpk                   ! interior values 
    244252         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
     
    249257      ! Lateral boundary conditions on velocity (modify fmask) 
    250258      ! ---------------------------------------      
     259!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    251260      DO jk = 1, jpk 
    252261         zwf(:,:) = fmask(:,:,jk)          
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r6140 r6748  
    5656      IF ( PRESENT(kkk) ) ik=kkk 
    5757      SELECT CASE( cdgrid ) 
    58       CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik) 
    59       CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik) 
    60       CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik) 
    61       CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik) 
     58      CASE( 'U' ) 
     59!$OMP PARALLEL WORKSHARE 
     60      zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik) 
     61!$OMP END PARALLEL WORKSHARE 
     62      CASE( 'V' )   
     63!$OMP PARALLEL WORKSHARE 
     64      zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik) 
     65!$OMP END PARALLEL WORKSHARE 
     66      CASE( 'F' )   
     67!$OMP PARALLEL WORKSHARE 
     68      zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik) 
     69!$OMP END PARALLEL WORKSHARE 
     70      CASE DEFAULT  
     71!$OMP PARALLEL WORKSHARE 
     72      zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik) 
     73!$OMP END PARALLEL WORKSHARE 
    6274      END SELECT 
    6375 
     
    7183         zglam(:,:) = zglam(:,:) - plon 
    7284      END IF 
    73  
     85!$OMP PARALLEL WORKSHARE 
    7486      zgphi(:,:) = zgphi(:,:) - plat 
    7587      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:) 
    76        
     88!$OMP END PARALLEL WORKSHARE 
    7789      IF( lk_mpp ) THEN   
    7890         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r5836 r6748  
    196196       
    197197      CALL dom_uniq( zprw, 'T' ) 
     198!$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    198199      DO jj = 1, jpj 
    199200         DO ji = 1, jpi 
     
    204205      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )   
    205206      CALL dom_uniq( zprw, 'U' ) 
     207!$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    206208      DO jj = 1, jpj 
    207209         DO ji = 1, jpi 
     
    212214      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )   
    213215      CALL dom_uniq( zprw, 'V' ) 
     216!$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    214217      DO jj = 1, jpj 
    215218         DO ji = 1, jpi 
     
    220223      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )   
    221224      CALL dom_uniq( zprw, 'F' ) 
     225!$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    222226      DO jj = 1, jpj 
    223227         DO ji = 1, jpi 
     
    303307         IF( nmsh <= 3 ) THEN                                   !    ! 3D depth 
    304308            CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r4 )      
     309!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    305310            DO jk = 1,jpk    
    306311               DO jj = 1, jpjm1    
     
    316321            CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 ) 
    317322         ELSE                                                   !    ! 2D bottom depth 
     323!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    318324            DO jj = 1,jpj    
    319325               DO ji = 1,jpi 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r6492 r6748  
    325325! need to be like this to compute the pressure gradient with ISF. If not, level beneath the ISF are not aligned (sum(e3t) /= depth) 
    326326! define e3t_0 and e3w_0 as the differences between gdept and gdepw respectively 
     327!$OMP PARALLEL DO schedule(static) private(jk) 
    327328         DO jk = 1, jpkm1 
    328329            e3t_1d(jk) = gdepw_1d(jk+1)-gdepw_1d(jk)  
    329330         END DO 
    330331         e3t_1d(jpk) = e3t_1d(jpk-1)   ! we don't care because this level is masked in NEMO 
    331  
     332!$OMP PARALLEL DO schedule(static) private(jk) 
    332333         DO jk = 2, jpk 
    333334            e3w_1d(jk) = gdept_1d(jk) - gdept_1d(jk-1)  
     
    420421            IF( rn_bathy > 0.01 ) THEN  
    421422               IF(lwp) WRITE(numout,*) '         Depth = rn_bathy read in namelist' 
     423!$OMP PARALLEL WORKSHARE 
    422424               zdta(:,:) = rn_bathy 
     425!$OMP END PARALLEL WORKSHARE 
    423426               IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk 
     427!$OMP PARALLEL WORKSHARE 
    424428                  idta(:,:) = jpkm1 
     429!$OMP END PARALLEL WORKSHARE 
    425430               ELSE                                                ! z-coordinate (zco or zps): step-like topography 
     431!$OMP PARALLEL WORKSHARE 
    426432                  idta(:,:) = jpkm1 
     433!$OMP END PARALLEL WORKSHARE 
    427434                  DO jk = 1, jpkm1 
    428435                     WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk 
     
    431438            ELSE 
    432439               IF(lwp) WRITE(numout,*) '         Depth = depthw(jpkm1)' 
     440!$OMP PARALLEL WORKSHARE 
    433441               idta(:,:) = jpkm1                            ! before last level 
    434442               zdta(:,:) = gdepw_1d(jpk)                     ! last w-point depth 
     443!$OMP END PARALLEL WORKSHARE 
    435444               h_oce     = gdepw_1d(jpk) 
    436445            ENDIF 
     
    449458            IF(lwp) WRITE(numout,*) '            background ocean depth = ', h_oce  , ' meters' 
    450459            !                                         
     460!$OMP PARALLEL DO schedule(static) private(jj, ji, zi, zj) 
    451461            DO jj = 1, jpjdta                              ! zdta : 
    452462               DO ji = 1, jpidta 
     
    458468            !                                              ! idta : 
    459469            IF( ln_sco ) THEN                                   ! s-coordinate (zsc       ): idta()=jpk 
     470!$OMP PARALLEL WORKSHARE 
    460471               idta(:,:) = jpkm1 
     472!$OMP END PARALLEL WORKSHARE 
    461473            ELSE                                                ! z-coordinate (zco or zps): step-like topography 
     474!$OMP PARALLEL WORKSHARE 
    462475               idta(:,:) = jpkm1 
     476!$OMP END PARALLEL WORKSHARE 
    463477               DO jk = 1, jpkm1 
    464478                  WHERE( gdept_1d(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_1d(jk+1) )   idta(:,:) = jk 
     
    469483         !                                            ! Caution : idta on the global domain: use of jperio, not nperio 
    470484         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN 
     485!$OMP PARALLEL WORKSHARE 
    471486            idta( :    , 1    ) = -1                ;      zdta( :    , 1    ) = -1._wp 
    472487            idta( :    ,jpjdta) =  0                ;      zdta( :    ,jpjdta) =  0._wp 
     488!$OMP END PARALLEL WORKSHARE 
    473489         ELSEIF( jperio == 2 ) THEN 
     490!$OMP PARALLEL WORKSHARE 
    474491            idta( :    , 1    ) = idta( : ,  3  )   ;      zdta( :    , 1    ) = zdta( : ,  3  ) 
    475492            idta( :    ,jpjdta) = 0                 ;      zdta( :    ,jpjdta) =  0._wp 
    476493            idta( 1    , :    ) = 0                 ;      zdta( 1    , :    ) =  0._wp 
    477494            idta(jpidta, :    ) = 0                 ;      zdta(jpidta, :    ) =  0._wp 
     495!$OMP END PARALLEL WORKSHARE 
    478496         ELSE 
    479497            ih = 0                                  ;      zh = 0._wp 
    480498            IF( ln_sco )   ih = jpkm1               ;      IF( ln_sco )   zh = h_oce 
     499!$OMP PARALLEL WORKSHARE 
    481500            idta( :    , 1    ) = ih                ;      zdta( :    , 1    ) =  zh 
    482501            idta( :    ,jpjdta) = ih                ;      zdta( :    ,jpjdta) =  zh 
    483502            idta( 1    , :    ) = ih                ;      zdta( 1    , :    ) =  zh 
    484503            idta(jpidta, :    ) = ih                ;      zdta(jpidta, :    ) =  zh 
     504!$OMP END PARALLEL WORKSHARE 
    485505         ENDIF 
    486506 
    487507         !                                            ! local domain level and meter bathymetries (mbathy,bathy) 
     508!$OMP PARALLEL WORKSHARE 
    488509         mbathy(:,:) = 0                                   ! set to zero extra halo points 
    489510         bathy (:,:) = 0._wp                               ! (require for mpp case) 
     511!$OMP END PARALLEL WORKSHARE 
     512!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    490513         DO jj = 1, nlcj                                   ! interior values 
    491514            DO ji = 1, nlci 
     
    494517            END DO 
    495518         END DO 
     519!$OMP PARALLEL WORKSHARE 
    496520         risfdep(:,:)=0.e0 
    497521         misfdep(:,:)=1 
     522!$OMP END PARALLEL WORKSHARE 
    498523         ! 
    499524         DEALLOCATE( idta, zdta ) 
     
    507532            CALL iom_get  ( inum, jpdom_data, 'Bathy_level', bathy ) 
    508533            CALL iom_close( inum ) 
     534!$OMP PARALLEL WORKSHARE 
    509535            mbathy(:,:) = INT( bathy(:,:) ) 
    510536            ! initialisation isf variables 
    511537            risfdep(:,:)=0._wp ; misfdep(:,:)=1              
     538!$OMP END PARALLEL WORKSHARE 
    512539            !                                                ! ===================== 
    513540            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
     
    547574            !                                                 
    548575            ! initialisation isf variables 
     576!$OMP PARALLEL WORKSHARE 
    549577            risfdep(:,:)=0._wp ; misfdep(:,:)=1              
     578!$OMP END PARALLEL WORKSHARE 
    550579            ! 
    551580            IF ( ln_isfcav ) THEN 
     
    864893      mikt(:,:) = MAX( misfdep(:,:) , 1 )    ! top k-index of T-level (=1) 
    865894      !                                      ! top k-index of W-level (=mikt) 
     895!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    866896      DO jj = 1, jpjm1                       ! top k-index of U- (U-) level 
    867897         DO ji = 1, jpim1 
     
    897927      IF( nn_timing == 1 )  CALL timing_start('zgr_zco') 
    898928      ! 
     929!$OMP PARALLEL DO schedule(static) private(jk) 
    899930      DO jk = 1, jpk 
    900931         gdept_0(:,:,jk) = gdept_1d(jk) 
     
    9961027 
    9971028      ! Scale factors and depth at T- and W-points 
     1029!$OMP PARALLEL DO schedule(static) private(jk) 
    9981030      DO jk = 1, jpk                        ! intitialization to the reference z-coordinate 
    9991031         gdept_0(:,:,jk) = gdept_1d(jk) 
     
    10691101      ! 
    10701102      ! Scale factors and depth at U-, V-, UW and VW-points 
     1103!$OMP PARALLEL DO schedule(static) private(jk) 
    10711104      DO jk = 1, jpk                        ! initialisation to z-scale factors 
    10721105         e3u_0 (:,:,jk) = e3t_1d(jk) 
     
    10761109      END DO 
    10771110 
     1111!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    10781112      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors 
    10791113         DO jj = 1, jpjm1 
     
    11141148       
    11151149      ! Scale factor at F-point 
     1150!$OMP PARALLEL DO schedule(static) private(jk) 
    11161151      DO jk = 1, jpk                        ! initialisation to z-scale factors 
    11171152         e3f_0(:,:,jk) = e3t_1d(jk) 
    11181153      END DO 
     1154!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    11191155      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors 
    11201156         DO jj = 1, jpjm1 
     
    11311167!!gm  bug ? :  must be a do loop with mj0,mj1 
    11321168      !  
     1169!$OMP PARALLEL WORKSHARE 
    11331170      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2 
    11341171      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:)  
     
    11361173      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:)  
    11371174      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:)  
    1138  
     1175!$OMP END PARALLEL WORKSHARE 
    11391176      ! Control of the sign 
    11401177      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' ) 
     
    11611198         gde3w_0(:,:,1) = 0.5_wp * e3w_0(:,:,1) 
    11621199         DO jk = 2, jpk 
    1163             gde3w_0(:,:,jk) = gde3w_0(:,:,jk-1) + e3w_0(:,:,jk) 
     1200!$OMP PARALLEL DO schedule(static) private(jj, ji)  
     1201             DO jj =1, jpj  
     1202                DO ji=1, jpi 
     1203                   gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 
     1204                END DO 
     1205             END DO 
    11641206         END DO 
    11651207      END IF 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r6140 r6748  
    7878      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
    7979 
     80!$OMP PARALLEL WORKSHARE 
    8081      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    8182      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk 
    8283      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk 
    8384      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk 
     85!$OMP END PARALLEL WORKSHARE 
    8486 
    8587      IF( ln_rstart ) THEN                    ! Restart from a file 
     
    9698         !                                       ! Initialization of ocean to zero 
    9799         !   before fields      !       now fields      
     100!$OMP PARALLEL WORKSHARE 
    98101         sshb (:,:)   = 0._wp   ;   sshn (:,:)   = 0._wp 
    99102         ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp 
    100103         vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp   
     104!$OMP END PARALLEL WORKSHARE 
    101105                                    hdivn(:,:,:) = 0._wp 
    102106         ! 
     
    108112            IF ( ln_tsd_init ) THEN              ! read 3D T and S data at nit000 
    109113               CALL dta_tsd( nit000, tsb )   
     114!$OMP PARALLEL WORKSHARE 
    110115               tsn(:,:,:,:) = tsb(:,:,:,:) 
     116!$OMP END PARALLEL WORKSHARE 
    111117               ! 
    112118            ELSE                                 ! Initial T-S fields defined analytically 
     
    116122               CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd ) 
    117123               CALL dta_uvd( nit000, zuvd ) 
     124!$OMP PARALLEL WORKSHARE 
    118125               ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    119126               vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
     127!$OMP END PARALLEL WORKSHARE 
    120128               CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd ) 
    121129            ENDIF 
     
    125133         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
    126134         IF( .NOT.ln_linssh ) THEN 
     135!$OMP PARALLEL DO schedule(static) private(jk) 
    127136            DO jk = 1, jpk 
    128137               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     
    136145      ! Do it whatever the free surface method, these arrays being eventually used 
    137146      ! 
     147!$OMP PARALLEL WORKSHARE 
    138148      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp 
    139149      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp 
     150!$OMP END PARALLEL WORKSHARE 
    140151      ! 
    141152!!gm  the use of umsak & vmask is not necessary belox as un, vn, ub, vb are always masked 
     153!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    142154      DO jk = 1, jpkm1 
    143155         DO jj = 1, jpj 
     
    152164      END DO 
    153165      ! 
     166!$OMP PARALLEL WORKSHARE 
    154167      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 
    155168      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 
     
    157170      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    158171      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     172!$OMP END PARALLEL WORKSHARE 
    159173      ! 
    160174      IF( nn_timing == 1 )   CALL timing_stop('istate_init') 
     
    352366         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    353367         ! 
     368!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    354369         DO jk = 1, jpk 
    355370            DO jj = 1, jpj 
     
    389404         CALL iom_close( inum ) 
    390405 
     406!$OMP PARALLEL WORKSHARE 
    391407         tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)  
    392408         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 
     409!$OMP END PARALLEL WORKSHARE 
    393410 
    394411         ! Read salinity field 
     
    398415         CALL iom_close( inum ) 
    399416 
     417!$OMP PARALLEL WORKSHARE 
    400418         tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)  
    401419         tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
     420!$OMP END PARALLEL WORKSHARE 
    402421         ! 
    403422      END SELECT 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r6140 r6748  
    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 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90

    r6140 r6748  
    6565        IF( l_trddyn ) THEN      ! trends: store the input trends 
    6666           CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     67!$OMP PARALLEL WORKSHARE 
    6768           ztrdu(:,:,:) = ua(:,:,:) 
    6869           ztrdv(:,:,:) = va(:,:,:) 
     70!$OMP END PARALLEL WORKSHARE 
    6971        ENDIF 
    7072 
    71  
     73!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    7274        DO jj = 2, jpjm1 
    7375           DO ji = 2, jpim1 
     
    8284        ! 
    8385        IF( ln_isfcav ) THEN        ! ocean cavities 
     86!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    8487           DO jj = 2, jpjm1 
    8588              DO ji = 2, jpim1 
     
    99102        ! 
    100103        IF( l_trddyn ) THEN      ! trends: send trends to trddyn for further diagnostics 
     104!$OMP PARALLEL WORKSHARE 
    101105           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    102106           ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     107!$OMP END PARALLEL WORKSHARE 
    103108           CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt ) 
    104109           CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r6152 r6748  
    9191      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
    9292         CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     93!$OMP PARALLEL WORKSHARE 
    9394         ztrdu(:,:,:) = ua(:,:,:) 
    9495         ztrdv(:,:,:) = va(:,:,:) 
     96!$OMP END PARALLEL WORKSHARE 
    9597      ENDIF 
    9698      ! 
     
    105107      ! 
    106108      IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 
     109!$OMP PARALLEL WORKSHARE 
    107110         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    108111         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     112!$OMP END PARALLEL WORKSHARE 
    109113         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 
    110114         CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 
     
    238242            END DO 
    239243         END DO 
     244!$OMP PARALLEL WORKSHARE 
    240245         riceload(:,:)=ziceload(:,:)  ! need to be saved for diaar5 
     246!$OMP END PARALLEL WORKSHARE 
    241247 
    242248         CALL wrk_dealloc( jpi,jpj, 2,  ztstop)  
     
    282288 
    283289      ! Surface value 
     290!$OMP PARALLEL DO private(ji,jj, zcoef1) 
    284291      DO jj = 2, jpjm1 
    285292         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    297304      ! interior value (2=<jk=<jpkm1) 
    298305      DO jk = 2, jpkm1 
     306!$OMP PARALLEL DO private(ji,jj, zcoef1) 
    299307         DO jj = 2, jpjm1 
    300308            DO ji = fs_2, fs_jpim1   ! vector opt. 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r5328 r6748  
    9292      IF( l_trddyn ) THEN           ! Save ua and va trends 
    9393         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     94!$OMP PARALLEL WORKSHARE 
    9495         ztrdu(:,:,:) = ua(:,:,:)  
    9596         ztrdv(:,:,:) = va(:,:,:)  
     97!$OMP END PARALLEL WORKSHARE 
    9698      ENDIF 
    9799       
    98       zhke(:,:,jpk) = 0._wp 
     100         zhke(:,:,jpk) = 0._wp 
    99101       
    100102      SELECT CASE ( kscheme )             !== Horizontal kinetic energy at T-point  ==! 
    101103      ! 
    102104      CASE ( nkeg_C2 )                          !--  Standard scheme  --! 
     105!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 
    103106         DO jk = 1, jpkm1 
    104107            DO jj = 2, jpj 
     
    114117         ! 
    115118      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
     119!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zu, zv) 
    116120         DO jk = 1, jpkm1 
    117121            DO jj = 2, jpjm1        
     
    134138      END SELECT 
    135139      ! 
     140!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    136141      DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
    137142         DO jj = 2, jpjm1 
     
    144149      ! 
    145150      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
     151!$OMP PARALLEL WORKSHARE 
    146152         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    147153         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     154!$OMP END PARALLEL WORKSHARE 
    148155         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    149156         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90

    r6140 r6748  
    6969      IF( l_trddyn )   THEN                      ! temporary save of momentum trends 
    7070         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
     71!$OMP PARALLEL WORKSHARE 
    7172         ztrdu(:,:,:) = ua(:,:,:)  
    7273         ztrdv(:,:,:) = va(:,:,:)  
     74!$OMP END PARALLEL WORKSHARE 
    7375      ENDIF 
    7476 
     
    8284 
    8385      IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics 
     86!$OMP PARALLEL WORKSHARE 
    8487         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    8588         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     89!$OMP END PARALLEL WORKSHARE 
    8690         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 
    8791         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv ) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap_blp.F90

    r6140 r6748  
    7777      DO jk = 1, jpkm1                                 ! Horizontal slab 
    7878         !                                             ! =============== 
     79!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    7980         DO jj = 2, jpj 
    8081            DO ji = fs_2, jpi   ! vector opt. 
     
    9394         END DO   
    9495         ! 
     96!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    9597         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div ) 
    9698            DO ji = fs_2, fs_jpim1   ! vector opt. 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r6140 r6748  
    115115         ! Ensure below that barotropic velocities match time splitting estimate 
    116116         ! Compute actual transport and replace it with ts estimate at "after" time step 
     117!$OMP PARALLEL WORKSHARE 
    117118         zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
    118119         zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
     120!$OMP END PARALLEL WORKSHARE 
    119121         DO jk = 2, jpkm1 
    120122            zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    121123            zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
    122124         END DO 
     125!$OMP PARALLEL DO schedule(static) private(jk) 
    123126         DO jk = 1, jpkm1 
    124127            ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
     
    131134            ! In the forward case, this is done below after asselin filtering    
    132135            ! so that asselin contribution is removed at the same time  
     136!$OMP PARALLEL DO schedule(static) private(jk) 
    133137            DO jk = 1, jpkm1 
    134138               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk) 
     
    164168         ! 
    165169         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends 
     170!$OMP PARALLEL WORKSHARE 
    166171            zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 
    167172            zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 
     173!$OMP END PARALLEL WORKSHARE 
    168174            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter 
    169175            CALL iom_put( "vtrd_tot", zva ) 
    170176         ENDIF 
    171177         ! 
     178!$OMP PARALLEL WORKSHARE 
    172179         zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter 
    173180         zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the 
     181!$OMP END PARALLEL WORKSHARE 
    174182         !                                  !  computation of the asselin filter trends) 
    175183      ENDIF 
     
    178186      ! ------------------------------------------ 
    179187      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap 
     188!$OMP PARALLEL DO schedule(static) private(jk) 
    180189         DO jk = 1, jpkm1 
    181190            un(:,:,jk) = ua(:,:,jk)                          ! un <-- ua 
     
    183192         END DO 
    184193         IF(.NOT.ln_linssh ) THEN 
     194!$OMP PARALLEL DO schedule(static) private(jk) 
    185195            DO jk = 1, jpkm1 
    186196               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     
    193203         IF( ln_linssh ) THEN             ! Fixed volume ! 
    194204            !                             ! =============! 
     205!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 
    195206            DO jk = 1, jpkm1                               
    196207               DO jj = 1, jpj 
     
    215226               e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1) 
    216227            ELSE 
     228!$OMP PARALLEL DO schedule(static) private(jk) 
    217229               DO jk = 1, jpkm1 
    218230                  e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
     
    240252               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
    241253               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
     254!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zuf, zvf) 
    242255               DO jk = 1, jpkm1 
    243256                  DO jj = 1, jpj 
     
    260273               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
    261274               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 
     275!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zue3a, zve3a, zue3n, zve3n, zue3b, zve3b, zuf, zvf) 
    262276               DO jk = 1, jpkm1 
    263277                  DO jj = 1, jpj 
     
    297311               zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
    298312            END DO 
     313!$OMP PARALLEL DO schedule(static) private(jk) 
    299314            DO jk = 1, jpkm1 
    300315               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 
     
    321336      ENDIF 
    322337      ! 
     338!$OMP PARALLEL WORKSHARE 
    323339      un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1) 
    324340      ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
    325341      vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1) 
    326342      vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 
     343!$OMP END PARALLEL WORKSHARE 
    327344      DO jk = 2, jpkm1 
    328345         un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 
     
    331348         vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 
    332349      END DO 
     350!$OMP PARALLEL WORKSHARE 
    333351      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 
    334352      vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 
    335353      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    336354      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     355!$OMP END PARALLEL WORKSHARE 
    337356      ! 
    338357      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents 
     
    341360      ENDIF 
    342361      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
     362!$OMP PARALLEL WORKSHARE 
    343363         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
    344364         zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 
     365!$OMP END PARALLEL WORKSHARE 
    345366         CALL trd_dyn( zua, zva, jpdyn_atf, kt ) 
    346367      ENDIF 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r6140 r6748  
    8383      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    8484         CALL wrk_alloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
     85!$OMP PARALLEL WORKSHARE 
    8586         ztrdu(:,:,:) = ua(:,:,:) 
    8687         ztrdv(:,:,:) = va(:,:,:) 
     88!$OMP END PARALLEL WORKSHARE 
    8789      ENDIF 
    8890      ! 
     
    9193         .OR.  nn_ice_embd == 2  ) THEN                                      ! embedded sea-ice 
    9294         ! 
     95!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    9396         DO jj = 2, jpjm1 
    9497            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    100103         IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==! 
    101104            zg_2 = grav * 0.5 
     105!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    102106            DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh 
    103107               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    115119            CALL upd_tide( kt )                      ! update tide potential 
    116120            ! 
     121!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    117122            DO jj = 2, jpjm1                         ! add tide potential forcing 
    118123               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    129134            zgrau0r     = - grav * r1_rau0 
    130135            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
     136!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    131137            DO jj = 2, jpjm1 
    132138               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    139145         ENDIF 
    140146         ! 
     147!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    141148         DO jk = 1, jpkm1                    !== Add all terms to the general trend 
    142149            DO jj = 2, jpjm1 
     
    158165      !                     
    159166      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics 
     167!$OMP PARALLEL WORKSHARE 
    160168         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    161169         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     170!$OMP END PARALLEL WORKSHARE 
    162171         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
    163172         CALL wrk_dealloc( jpi,jpj,jpk,   ztrdu, ztrdv )  
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r6152 r6748  
    222222            SELECT CASE( nn_een_e3f )              !* ff/e3 at F-point 
    223223            CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
     224!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    224225               DO jj = 1, jpjm1 
    225226                  DO ji = 1, jpim1 
     
    230231               END DO 
    231232            CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
     233!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    232234               DO jj = 1, jpjm1 
    233235                  DO ji = 1, jpim1 
     
    243245            ! 
    244246            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
     247 
     248!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    245249            DO jj = 2, jpj 
    246250               DO ji = 2, jpi 
     
    253257            ! 
    254258         ELSE                                !== all other schemes (ENE, ENS, MIX) 
     259!$OMP PARALLEL WORKSHARE 
    255260            zwz(:,:) = 0._wp 
    256261            zhf(:,:) = 0._wp 
     262!$OMP END PARALLEL WORKSHARE 
    257263            IF ( .not. ln_sco ) THEN 
    258264 
     
    269275            END IF 
    270276 
     277!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    271278            DO jj = 1, jpjm1 
    272                zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 
     279               DO ji = 1, jpi 
     280                  zhf(ji,jj) = zhf(ji,jj) * (1._wp- umask(ji,jj,1) * umask(ji,jj+1,1)) 
     281               END DO 
    273282            END DO 
    274283 
    275284            DO jk = 1, jpkm1 
     285!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    276286               DO jj = 1, jpjm1 
    277                   zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
     287                  DO ji = 1, jpi 
     288                     zhf(ji,jj) = zhf(ji,jj) + e3f_n(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj+1,jk) 
     289                  END DO 
    278290               END DO 
    279291            END DO 
    280292            CALL lbc_lnk( zhf, 'F', 1._wp ) 
    281293            ! JC: TBC. hf should be greater than 0  
     294!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    282295            DO jj = 1, jpj 
    283296               DO ji = 1, jpi 
     
    285298               END DO 
    286299            END DO 
     300!$OMP PARALLEL WORKSHARE 
    287301            zwz(:,:) = ff(:,:) * zwz(:,:) 
     302!$OMP END PARALLEL WORKSHARE 
    288303         ENDIF 
    289304      ENDIF 
     
    303318      !                                   !* e3*d/dt(Ua) (Vertically integrated) 
    304319      !                                   ! -------------------------------------------------- 
     320!$OMP PARALLEL WORKSHARE 
    305321      zu_frc(:,:) = 0._wp 
    306322      zv_frc(:,:) = 0._wp 
     323!$OMP END PARALLEL WORKSHARE 
    307324      ! 
    308325      DO jk = 1, jpkm1 
    309          zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    310          zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)          
     326!$OMP PARALLEL DO schedule(static) private(jj,ji) 
     327      DO jj=1,jpj 
     328         DO ji=1,jpi 
     329         zu_frc(ji,jj) = zu_frc(ji,jj) + e3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 
     330         zv_frc(ji,jj) = zv_frc(ji,jj) + e3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 
     331         END DO 
     332      END DO  
    311333      END DO 
    312334      ! 
     335!$OMP PARALLEL WORKSHARE 
    313336      zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 
    314337      zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 
     338!$OMP END PARALLEL WORKSHARE 
    315339      ! 
    316340      ! 
    317341      !                                   !* baroclinic momentum trend (remove the vertical mean trend) 
     342!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    318343      DO jk = 1, jpkm1                    ! ----------------------------------------------------------- 
    319344         DO jj = 2, jpjm1 
     
    326351      !                                   !* barotropic Coriolis trends (vorticity scheme dependent) 
    327352      !                                   ! -------------------------------------------------------- 
     353!$OMP PARALLEL WORKSHARE 
    328354      zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
    329355      zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 
     356!$OMP END PARALLEL WORKSHARE 
    330357      ! 
    331358      IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN      ! energy conserving or mixed scheme 
     359!$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 
    332360         DO jj = 2, jpjm1 
    333361            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    343371         ! 
    344372      ELSEIF ( ln_dynvor_ens ) THEN                    ! enstrophy conserving scheme 
     373!$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zx1) 
    345374         DO jj = 2, jpjm1 
    346375            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    355384         ! 
    356385      ELSEIF ( ln_dynvor_een ) THEN  ! enstrophy and energy conserving scheme 
     386!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    357387         DO jj = 2, jpjm1 
    358388            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    376406          wduflt1(:,:) = 1.0_wp 
    377407          wdvflt1(:,:) = 1.0_wp 
     408!$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 
    378409          DO jj = 2, jpjm1 
    379410             DO ji = 2, jpim1 
     
    415446           CALL lbc_lnk( zcpx, 'U', 1._wp )    ;   CALL lbc_lnk( zcpy, 'V', 1._wp ) 
    416447 
     448!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    417449           DO jj = 2, jpjm1 
    418450              DO ji = 2, jpim1 
     
    426458         ELSE 
    427459 
     460!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    428461           DO jj = 2, jpjm1 
    429462              DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    436469      ENDIF 
    437470 
     471!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    438472      DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend 
    439473         DO ji = fs_2, fs_jpim1 
     
    445479      !                 ! Add bottom stress contribution from baroclinic velocities:       
    446480      IF (ln_bt_fw) THEN 
     481!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 
    447482         DO jj = 2, jpjm1                           
    448483            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    454489         END DO 
    455490      ELSE 
     491!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 
    456492         DO jj = 2, jpjm1 
    457493            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    475511      !                                         ! Add top stress contribution from baroclinic velocities:       
    476512      IF (ln_bt_fw) THEN 
     513!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 
    477514         DO jj = 2, jpjm1 
    478515            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    484521         END DO 
    485522      ELSE 
     523!$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv) 
    486524         DO jj = 2, jpjm1 
    487525            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    495533      ! 
    496534      ! Note that the "unclipped" top friction parameter is used even with explicit drag 
     535!$OMP PARALLEL WORKSHARE 
    497536      zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 
    498537      zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 
     538!$OMP END PARALLEL WORKSHARE 
    499539      !        
    500540      IF (ln_bt_fw) THEN                        ! Add wind forcing 
     541!$OMP PARALLEL WORKSHARE 
    501542         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 
    502543         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 
     544!$OMP END PARALLEL WORKSHARE 
    503545      ELSE 
     546!$OMP PARALLEL WORKSHARE 
    504547         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 
    505548         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 
     549!$OMP END PARALLEL WORKSHARE 
    506550      ENDIF   
    507551      ! 
    508552      IF ( ln_apr_dyn ) THEN                    ! Add atm pressure forcing 
    509553         IF (ln_bt_fw) THEN 
     554!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    510555            DO jj = 2, jpjm1               
    511556               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    517562            END DO 
    518563         ELSE 
     564!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    519565            DO jj = 2, jpjm1               
    520566               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    559605      ! Initialize barotropic variables:       
    560606      IF( ll_init )THEN 
     607!$OMP PARALLEL WORKSHARE 
    561608         sshbb_e(:,:) = 0._wp 
    562609         ubb_e  (:,:) = 0._wp 
     
    565612         ub_e   (:,:) = 0._wp 
    566613         vb_e   (:,:) = 0._wp 
     614!$OMP END PARALLEL WORKSHARE 
    567615      ENDIF 
    568616 
    569617      IF( ln_wd ) THEN      !preserve the positivity of water depth 
    570618                          !ssh[b,n,a] should have already been processed for this 
     619!$OMP PARALLEL WORKSHARE 
    571620         sshbb_e(:,:) = MAX(sshbb_e(:,:), rn_wdmin1 - bathy(:,:)) 
    572621         sshb_e(:,:)  = MAX(sshb_e(:,:) , rn_wdmin1 - bathy(:,:)) 
     622!$OMP END PARALLEL WORKSHARE 
    573623      ENDIF 
    574624      ! 
    575625      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
     626!$OMP PARALLEL WORKSHARE 
    576627         sshn_e(:,:) =    sshn(:,:)             
    577628         un_e  (:,:) =    un_b(:,:)             
     
    582633         hur_e (:,:) = r1_hu_n(:,:)     
    583634         hvr_e (:,:) = r1_hv_n(:,:) 
     635!$OMP END PARALLEL WORKSHARE 
    584636      ELSE                                ! CENTRED integration: start from BEFORE fields 
     637!$OMP PARALLEL WORKSHARE 
    585638         sshn_e(:,:) =    sshb(:,:) 
    586639         un_e  (:,:) =    ub_b(:,:)          
     
    591644         hur_e (:,:) = r1_hu_b(:,:)     
    592645         hvr_e (:,:) = r1_hv_b(:,:) 
     646!$OMP END PARALLEL WORKSHARE 
    593647      ENDIF 
    594648      ! 
     
    596650      ! 
    597651      ! Initialize sums: 
     652!$OMP PARALLEL WORKSHARE 
    598653      ua_b  (:,:) = 0._wp       ! After barotropic velocities (or transport if flux form)           
    599654      va_b  (:,:) = 0._wp 
     
    601656      un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop 
    602657      vn_adv(:,:) = 0._wp 
     658!$OMP END PARALLEL WORKSHARE 
    603659      !                                             ! ==================== ! 
    604660      DO jn = 1, icycle                             !  sub-time-step loop  ! 
     
    624680 
    625681         ! Extrapolate barotropic velocities at step jit+0.5: 
     682!$OMP PARALLEL WORKSHARE 
    626683         ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 
    627684         va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 
     685!$OMP END PARALLEL WORKSHARE 
    628686 
    629687         IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only) 
     
    632690            zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 
    633691            ! 
     692!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    634693            DO jj = 2, jpjm1                                    ! Sea Surface Height at u- & v-points 
    635694               DO ji = 2, fs_jpim1   ! Vector opt. 
     
    644703            CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 
    645704            ! 
     705!$OMP PARALLEL WORKSHARE 
    646706            zhup2_e (:,:) = hu_0(:,:) + zwx(:,:)                ! Ocean depth at U- and V-points 
    647707            zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 
     708!$OMP END PARALLEL WORKSHARE 
    648709            IF( ln_wd ) THEN 
    649710              zhup2_e(:,:) = MAX(zhup2_e (:,:), rn_wdmin1) 
     
    651712            END IF 
    652713         ELSE 
     714!$OMP PARALLEL WORKSHARE 
    653715            zhup2_e (:,:) = hu_n(:,:) 
    654716            zhvp2_e (:,:) = hv_n(:,:) 
     717!$OMP END PARALLEL WORKSHARE 
    655718         ENDIF 
    656719         !                                                !* after ssh 
     
    659722         ! considering fluxes below: 
    660723         ! 
     724!$OMP PARALLEL WORKSHARE 
    661725         zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:)         ! fluxes at jn+0.5 
    662726         zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 
     727!$OMP END PARALLEL WORKSHARE 
    663728         ! 
    664729#if defined key_agrif 
     
    691756         ! Sum over sub-time-steps to compute advective velocities 
    692757         za2 = wgtbtp2(jn) 
     758!$OMP PARALLEL WORKSHARE 
    693759         un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 
    694760         vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 
     761!$OMP END PARALLEL WORKSHARE 
    695762         ! 
    696763         ! Set next sea level: 
     764!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    697765         DO jj = 2, jpjm1                                  
    698766            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    701769            END DO 
    702770         END DO 
     771!$OMP PARALLEL WORKSHARE 
    703772         ssha_e(:,:) = (  sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) )  ) * ssmask(:,:) 
     773!$OMP END PARALLEL WORKSHARE 
    704774         IF( ln_wd ) ssha_e(:,:) = MAX(ssha_e(:,:), rn_wdmin1 - bathy(:,:))  
    705775         CALL lbc_lnk( ssha_e, 'T',  1._wp ) 
     
    715785         ! Sea Surface Height at u-,v-points (vvl case only) 
    716786         IF( .NOT.ln_linssh ) THEN                                 
     787!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    717788            DO jj = 2, jpjm1 
    718789               DO ji = 2, jpim1      ! NO Vector Opt. 
     
    752823           wduflt1(:,:) = 1._wp 
    753824           wdvflt1(:,:) = 1._wp 
     825!$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2) 
    754826           DO jj = 2, jpjm1 
    755827              DO ji = 2, jpim1 
     
    793865         IF( .NOT.ln_linssh  .AND. .NOT.ln_dynadv_vec ) THEN   !* Vector form 
    794866            !                                         
     867!$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 
    795868            DO jj = 2, jpjm1                             
    796869               DO ji = 2, jpim1 
     
    821894         ! 
    822895         IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN     !==  energy conserving or mixed scheme  ==! 
     896!$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2) 
    823897            DO jj = 2, jpjm1 
    824898               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    833907            ! 
    834908         ELSEIF ( ln_dynvor_ens ) THEN                   !==  enstrophy conserving scheme  ==! 
     909!$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1) 
    835910            DO jj = 2, jpjm1 
    836911               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    845920            ! 
    846921         ELSEIF ( ln_dynvor_een ) THEN                   !==  energy and enstrophy conserving scheme  ==! 
     922!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    847923            DO jj = 2, jpjm1 
    848924               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    862938         ! Add tidal astronomical forcing if defined 
    863939         IF ( lk_tide.AND.ln_tide_pot ) THEN 
     940!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    864941            DO jj = 2, jpjm1 
    865942               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    873950         ! 
    874951         ! Add bottom stresses: 
     952!$OMP PARALLEL WORKSHARE 
    875953         zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 
    876954         zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
     955!$OMP END PARALLEL WORKSHARE 
    877956         ! 
    878957         ! Add top stresses: 
     958!$OMP PARALLEL WORKSHARE 
    879959         zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 
    880960         zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 
     961!$OMP END PARALLEL WORKSHARE 
    881962         ! 
    882963         ! Surface pressure trend: 
    883964 
    884965         IF( ln_wd ) THEN 
     966!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    885967           DO jj = 2, jpjm1 
    886968              DO ji = 2, jpim1  
     
    893975           END DO 
    894976         ELSE 
     977!$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg) 
    895978           DO jj = 2, jpjm1 
    896979              DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    907990         ! Set next velocities: 
    908991         IF( ln_dynadv_vec .OR. ln_linssh ) THEN   !* Vector form 
     992!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    909993            DO jj = 2, jpjm1 
    910994               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    9241008            ! 
    9251009         ELSE                                      !* Flux form 
     1010!$OMP PARALLEL DO schedule(static) private(jj,ji,zhura,zhvra) 
    9261011            DO jj = 2, jpjm1 
    9271012               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    9571042              hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1) 
    9581043            ELSE 
     1044!$OMP PARALLEL WORKSHARE 
    9591045              hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 
    9601046              hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 
     1047!$OMP END PARALLEL WORKSHARE 
    9611048            END IF 
     1049!$OMP PARALLEL WORKSHARE 
    9621050            hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 
    9631051            hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 
     1052!$OMP END PARALLEL WORKSHARE 
    9641053            ! 
    9651054         ENDIF 
     
    9761065         !                                             !* Swap 
    9771066         !                                             !  ---- 
     1067!$OMP PARALLEL WORKSHARE 
    9781068         ubb_e  (:,:) = ub_e  (:,:) 
    9791069         ub_e   (:,:) = un_e  (:,:) 
     
    9871077         sshb_e (:,:) = sshn_e(:,:) 
    9881078         sshn_e (:,:) = ssha_e(:,:) 
     1079!$OMP END PARALLEL WORKSHARE 
    9891080 
    9901081         !                                             !* Sum over whole bt loop 
     
    9921083         za1 = wgtbtp1(jn)                                     
    9931084         IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities 
     1085!$OMP PARALLEL WORKSHARE 
    9941086            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:)  
    9951087            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:)  
     1088!$OMP END PARALLEL WORKSHARE 
    9961089         ELSE                                              ! Sum transports 
     1090!$OMP PARALLEL WORKSHARE 
    9971091            ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) 
    9981092            va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) 
     1093!$OMP END PARALLEL WORKSHARE 
    9991094         ENDIF 
    10001095         !                                   ! Sum sea level 
     1096!$OMP PARALLEL WORKSHARE 
    10011097         ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 
     1098!$OMP END PARALLEL WORKSHARE 
    10021099         !                                                 ! ==================== ! 
    10031100      END DO                                               !        end loop      ! 
     
    10081105      ! 
    10091106      ! Set advection velocity correction: 
     1107!$OMP PARALLEL WORKSHARE 
    10101108      zwx(:,:) = un_adv(:,:) 
    10111109      zwy(:,:) = vn_adv(:,:) 
     1110!$OMP END PARALLEL WORKSHARE 
    10121111      IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN      
     1112!$OMP PARALLEL WORKSHARE 
    10131113         un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 
    10141114         vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 
     1115!$OMP END PARALLEL WORKSHARE 
    10151116      ELSE 
     1117!$OMP PARALLEL WORKSHARE 
    10161118         un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 
    10171119         vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 
     1120!$OMP END PARALLEL WORKSHARE 
    10181121      END IF 
    10191122 
    10201123      IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 
     1124!$OMP PARALLEL WORKSHARE 
    10211125         ub2_b(:,:) = zwx(:,:) 
    10221126         vb2_b(:,:) = zwy(:,:) 
     1127!$OMP END PARALLEL WORKSHARE 
    10231128      ENDIF 
    10241129      ! 
    10251130      ! Update barotropic trend: 
    10261131      IF( ln_dynadv_vec .OR. ln_linssh ) THEN 
     1132!$OMP PARALLEL DO schedule(static) private(jk) 
    10271133         DO jk=1,jpkm1 
    10281134            ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 
     
    10311137      ELSE 
    10321138         ! At this stage, ssha has been corrected: compute new depths at velocity points 
     1139!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    10331140         DO jj = 1, jpjm1 
    10341141            DO ji = 1, jpim1      ! NO Vector Opt. 
     
    10431150         CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    10441151         ! 
     1152!$OMP PARALLEL DO schedule(static) private(jk) 
    10451153         DO jk=1,jpkm1 
    10461154            ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 
     
    10481156         END DO 
    10491157         ! Save barotropic velocities not transport: 
     1158!$OMP PARALLEL WORKSHARE 
    10501159         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 
    10511160         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    1052       ENDIF 
    1053       ! 
     1161!$OMP END PARALLEL WORKSHARE 
     1162      ENDIF 
     1163      ! 
     1164!$OMP PARALLEL DO schedule(static) private(jk) 
    10541165      DO jk = 1, jpkm1 
    10551166         ! Correct velocities: 
     
    12441355      CALL wrk_alloc( jpi,jpj,   zcu ) 
    12451356      ! 
     1357!$OMP PARALLEL DO schedule(static) private(jj, ji, zxr2, zyr2) 
    12461358      DO jj = 1, jpj 
    12471359         DO ji =1, jpi 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r6140 r6748  
    106106      CASE ( np_ENE )                                 !* energy conserving scheme 
    107107         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
     108!$OMP PARALLEL WORKSHARE 
    108109            ztrdu(:,:,:) = ua(:,:,:) 
    109110            ztrdv(:,:,:) = va(:,:,:) 
     111!$OMP END PARALLEL WORKSHARE 
    110112            CALL vor_ene( kt, nrvm, ua, va )                      ! relative vorticity or metric trend 
     113!$OMP PARALLEL WORKSHARE 
    111114            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    112115            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     116!$OMP END PARALLEL WORKSHARE 
    113117            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
     118!$OMP PARALLEL WORKSHARE 
    114119            ztrdu(:,:,:) = ua(:,:,:) 
    115120            ztrdv(:,:,:) = va(:,:,:) 
     121!$OMP END PARALLEL WORKSHARE 
    116122            CALL vor_ene( kt, ncor, ua, va )                      ! planetary vorticity trend 
     123!$OMP PARALLEL WORKSHARE 
    117124            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    118125            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     126!$OMP END PARALLEL WORKSHARE 
    119127            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    120128         ELSE 
     
    124132      CASE ( np_ENS )                                 !* enstrophy conserving scheme 
    125133         IF( l_trddyn ) THEN                                ! trend diagnostics: splitthe trend in two     
     134!$OMP PARALLEL WORKSHARE 
    126135            ztrdu(:,:,:) = ua(:,:,:) 
    127136            ztrdv(:,:,:) = va(:,:,:) 
     137!$OMP END PARALLEL WORKSHARE 
    128138            CALL vor_ens( kt, nrvm, ua, va )                      ! relative vorticity or metric trend 
     139!$OMP PARALLEL WORKSHARE 
    129140            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    130141            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     142!$OMP END PARALLEL WORKSHARE 
    131143            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
     144!$OMP PARALLEL WORKSHARE 
    132145            ztrdu(:,:,:) = ua(:,:,:) 
    133146            ztrdv(:,:,:) = va(:,:,:) 
     147!$OMP END PARALLEL WORKSHARE 
    134148            CALL vor_ens( kt, ncor, ua, va )                      ! planetary vorticity trend 
     149!$OMP PARALLEL WORKSHARE 
    135150            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    136151            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     152!$OMP END PARALLEL WORKSHARE 
    137153            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    138154         ELSE 
     
    142158      CASE ( np_MIX )                                 !* mixed ene-ens scheme 
    143159         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
     160!$OMP PARALLEL WORKSHARE 
    144161            ztrdu(:,:,:) = ua(:,:,:) 
    145162            ztrdv(:,:,:) = va(:,:,:) 
     163!$OMP END PARALLEL WORKSHARE 
    146164            CALL vor_ens( kt, nrvm, ua, va )                      ! relative vorticity or metric trend (ens) 
     165!$OMP PARALLEL WORKSHARE 
    147166            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    148167            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     168!$OMP END PARALLEL WORKSHARE 
    149169            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
     170!$OMP PARALLEL WORKSHARE 
    150171            ztrdu(:,:,:) = ua(:,:,:) 
    151172            ztrdv(:,:,:) = va(:,:,:) 
     173!$OMP END PARALLEL WORKSHARE 
    152174            CALL vor_ene( kt, ncor, ua, va )                      ! planetary vorticity trend (ene) 
     175!$OMP PARALLEL WORKSHARE 
    153176            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    154177            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     178!$OMP END PARALLEL WORKSHARE 
    155179            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    156180         ELSE 
     
    161185      CASE ( np_EEN )                                 !* energy and enstrophy conserving scheme 
    162186         IF( l_trddyn ) THEN                                ! trend diagnostics: split the trend in two 
     187!$OMP PARALLEL WORKSHARE 
    163188            ztrdu(:,:,:) = ua(:,:,:) 
    164189            ztrdv(:,:,:) = va(:,:,:) 
     190!$OMP END PARALLEL WORKSHARE 
    165191            CALL vor_een( kt, nrvm, ua, va )                      ! relative vorticity or metric trend 
     192!$OMP PARALLEL WORKSHARE 
    166193            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    167194            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     195!$OMP END PARALLEL WORKSHARE 
    168196            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
     197!$OMP PARALLEL WORKSHARE 
    169198            ztrdu(:,:,:) = ua(:,:,:) 
    170199            ztrdv(:,:,:) = va(:,:,:) 
     200!$OMP END PARALLEL WORKSHARE 
    171201            CALL vor_een( kt, ncor, ua, va )                      ! planetary vorticity trend 
     202!$OMP PARALLEL WORKSHARE 
    172203            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    173204            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     205!$OMP END PARALLEL WORKSHARE 
    174206            CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    175207         ELSE 
     
    237269         SELECT CASE( kvor )                 !==  vorticity considered  ==! 
    238270         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
     271!$OMP PARALLEL WORKSHARE 
    239272            zwz(:,:) = ff(:,:)  
     273!$OMP END PARALLEL WORKSHARE 
    240274         CASE ( np_RVO )                           !* relative vorticity 
     275!$OMP PARALLEL DO private(jj,ji) 
    241276            DO jj = 1, jpjm1 
    242277               DO ji = 1, fs_jpim1   ! vector opt. 
     
    246281            END DO 
    247282         CASE ( np_MET )                           !* metric term 
     283!$OMP PARALLEL DO private(jj,ji) 
    248284            DO jj = 1, jpjm1 
    249285               DO ji = 1, fs_jpim1   ! vector opt. 
     
    254290            END DO 
    255291         CASE ( np_CRV )                           !* Coriolis + relative vorticity 
     292!$OMP PARALLEL DO private(jj,ji) 
    256293            DO jj = 1, jpjm1 
    257294               DO ji = 1, fs_jpim1   ! vector opt. 
     
    262299            END DO 
    263300         CASE ( np_CME )                           !* Coriolis + metric 
     301!$OMP PARALLEL DO private(jj,ji) 
    264302            DO jj = 1, jpjm1 
    265303               DO ji = 1, fs_jpim1   ! vector opt. 
     
    275313         ! 
    276314         IF( ln_dynvor_msk ) THEN          !==  mask/unmask vorticity ==! 
     315!$OMP PARALLEL DO private(jj,ji) 
    277316            DO jj = 1, jpjm1 
    278317               DO ji = 1, fs_jpim1   ! vector opt. 
     
    287326            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    288327         ELSE 
     328!$OMP PARALLEL WORKSHARE 
    289329            zwx(:,:) = e2u(:,:) * un(:,:,jk) 
    290330            zwy(:,:) = e1v(:,:) * vn(:,:,jk) 
     331!$OMP END PARALLEL WORKSHARE 
    291332         ENDIF 
    292333         !                                   !==  compute and add the vorticity term trend  =! 
     334!$OMP PARALLEL DO private(jj, ji, zy1, zy2, zx1, zx2) 
    293335         DO jj = 2, jpjm1 
    294336            DO ji = fs_2, fs_jpim1   ! vector opt. 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r6140 r6748  
    7777      IF( l_trddyn )   THEN         ! Save ua and va trends 
    7878         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     79!$OMP PARALLEL WORKSHARE  
    7980         ztrdu(:,:,:) = ua(:,:,:)  
    8081         ztrdv(:,:,:) = va(:,:,:)  
     82!$OMP END PARALLEL WORKSHARE  
    8183      ENDIF 
    8284       
    8385      DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical 
     86!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    8487         DO jj = 2, jpj                   ! vertical fluxes  
    8588            DO ji = fs_2, jpi             ! vector opt. 
     
    8790            END DO 
    8891         END DO 
     92!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    8993         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point 
    9094            DO ji = fs_2, fs_jpim1        ! vector opt. 
     
    97101      ! Surface and bottom advective fluxes set to zero 
    98102      IF ( ln_isfcav ) THEN 
     103!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    99104         DO jj = 2, jpjm1 
    100105            DO ji = fs_2, fs_jpim1           ! vector opt. 
     
    106111         END DO 
    107112      ELSE 
     113!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    108114         DO jj = 2, jpjm1         
    109115            DO ji = fs_2, fs_jpim1           ! vector opt. 
     
    116122      END IF 
    117123 
     124!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zua, zva) 
    118125      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points 
    119126         DO jj = 2, jpjm1 
     
    130137 
    131138      IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
     139!$OMP PARALLEL WORKSHARE  
    132140         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    133141         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
     142!$OMP END PARALLEL WORKSHARE  
    134143         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    135144         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90

    r6140 r6748  
    6666      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    6767         CALL wrk_alloc( jpi, jpj, jpk, ztrdu, ztrdv )  
     68!$OMP PARALLEL WORKSHARE 
    6869         ztrdu(:,:,:) = ua(:,:,:) 
    6970         ztrdv(:,:,:) = va(:,:,:) 
     71!$OMP END PARALLEL WORKSHARE 
    7072      ENDIF 
    7173 
     
    7880 
    7981      IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
     82!$OMP PARALLEL WORKSHARE 
    8083         ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 
    8184         ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 
     85!$OMP END PARALLEL WORKSHARE 
    8286         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 
    8387         CALL wrk_dealloc( jpi, jpj, jpk, ztrdu, ztrdv )  
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r6140 r6748  
    112112      ! 
    113113      IF( ln_bfrimp ) THEN 
     114!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    114115         DO jj = 2, jpjm1 
    115116            DO ji = 2, jpim1 
     
    121122         END DO 
    122123         IF ( ln_isfcav ) THEN 
     124!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    123125            DO jj = 2, jpjm1 
    124126               DO ji = 2, jpim1 
     
    172174      ! non zero value at the ocean bottom depending on the bottom friction used. 
    173175      ! 
     176!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3ua, zzwi, zzws) 
    174177      DO jk = 1, jpkm1        ! Matrix 
    175178         DO jj = 2, jpjm1  
     
    207210      ! 
    208211      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
     212!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    209213         DO jj = 2, jpjm1    
    210214            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    214218      END DO 
    215219      ! 
     220!$OMP PARALLEL DO schedule(static) private(jj, ji, ze3ua) 
    216221      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    217222         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    222227      END DO 
    223228      DO jk = 2, jpkm1 
     229!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    224230         DO jj = 2, jpjm1 
    225231            DO ji = fs_2, fs_jpim1 
     
    229235      END DO 
    230236      ! 
    231       DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==! 
     237!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     238        DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==! 
    232239         DO ji = fs_2, fs_jpim1   ! vector opt. 
    233240            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
     
    235242      END DO 
    236243      DO jk = jpk-2, 1, -1 
    237          DO jj = 2, jpjm1 
     244!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     245        DO jj = 2, jpjm1 
    238246            DO ji = fs_2, fs_jpim1 
    239247               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
     
    248256      ! non zero value at the ocean bottom depending on the bottom friction used 
    249257      ! 
     258!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3va, zzwi, zzws) 
    250259      DO jk = 1, jpkm1        ! Matrix 
    251260         DO jj = 2, jpjm1    
     
    260269         END DO 
    261270      END DO 
     271!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    262272      DO jj = 2, jpjm1        ! Surface boundary conditions 
    263273         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    283293      ! 
    284294      DO jk = 2, jpkm1        !==  First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1   (increasing k)  == 
     295!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    285296         DO jj = 2, jpjm1    
    286297            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    290301      END DO 
    291302      ! 
     303!$OMP PARALLEL DO schedule(static) private(jj, ji, ze3va) 
    292304      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    293305         DO ji = fs_2, fs_jpim1   ! vector opt.           
     
    298310      END DO 
    299311      DO jk = 2, jpkm1 
     312!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    300313         DO jj = 2, jpjm1 
    301314            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    305318      END DO 
    306319      ! 
     320!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    307321      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==! 
    308322         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    311325      END DO 
    312326      DO jk = jpk-2, 1, -1 
     327!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    313328         DO jj = 2, jpjm1 
    314329            DO ji = fs_2, fs_jpim1 
     
    322337      !!gm  I almost sure it is !!!! 
    323338      IF( ln_bfrimp ) THEN 
     339!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    324340        DO jj = 2, jpjm1 
    325341           DO ji = 2, jpim1 
     
    331347        END DO 
    332348        IF (ln_isfcav) THEN 
     349!$OMP PARALLEL DO schedule(static) private(jj, ji, ikbu, ikbv) 
    333350           DO jj = 2, jpjm1 
    334351              DO ji = 2, jpim1 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r6152 r6748  
    7373      INTEGER, INTENT(in) ::   kt   ! time step 
    7474      !  
    75       INTEGER  ::   jk            ! dummy loop indice 
     75      INTEGER  ::   jk, jj, ji            ! dummy loop indice 
    7676      REAL(wp) ::   z2dt, zcoef   ! local scalars 
    7777      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace 
     
    9696      !                                           !   After Sea Surface Height   ! 
    9797      !                                           !------------------------------! 
     98!$OMP PARALLEL WORKSHARE 
    9899      zhdiv(:,:) = 0._wp 
     100!$OMP END PARALLEL WORKSHARE 
    99101      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    100         zhdiv(:,:) = zhdiv(:,:) + e3t_n(:,:,jk) * hdivn(:,:,jk) 
     102!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     103            DO jj = 1, jpj 
     104               DO ji = 1, jpi   ! vector opt. 
     105        zhdiv(ji,jj) = zhdiv(ji,jj) + e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) 
     106               END DO 
     107            END DO            
    101108      END DO 
    102109      !                                                ! Sea surface elevation time stepping 
     
    107114 
    108115      IF(ln_wd) CALL wad_lmt(sshb, zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 
    109  
     116!$OMP PARALLEL WORKSHARE 
    110117      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
    111  
     118!$OMP END PARALLEL WORKSHARE 
    112119      IF ( .NOT.ln_dynspg_ts ) THEN 
    113120         ! These lines are not necessary with time splitting since 
     
    127134      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN     ! Include the IAU weighted SSH increment 
    128135         CALL ssh_asm_inc( kt ) 
     136!$OMP PARALLEL WORKSHARE 
    129137         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
     138!$OMP END PARALLEL WORKSHARE 
    130139      ENDIF 
    131140#endif 
     
    183192      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN      ! z_tilde and layer cases 
    184193         CALL wrk_alloc( jpi, jpj, jpk, zhdiv )  
    185          ! 
     194!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    186195         DO jk = 1, jpkm1 
    187196            ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t) 
     
    198207         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
    199208            ! computation of w 
    200             wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk) + zhdiv(:,:,jk)    & 
    201                &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )     ) * tmask(:,:,jk) 
     209!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     210            DO jj = 1, jpj 
     211               DO ji = 1, jpi   ! vector opt. 
     212            wn(ji,jj,jk) = wn(ji,jj,jk+1) - ( e3t_n(ji,jj,jk) * hdivn(ji,jj,jk) + zhdiv(ji,jj,jk)    & 
     213               &                         + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) )     ) * tmask(ji,jj,jk) 
     214               END DO 
     215            END DO 
    202216         END DO 
    203217         !          IF( ln_vvl_layer ) wn(:,:,:) = 0.e0 
     
    205219      ELSE   ! z_star and linear free surface cases 
    206220         DO jk = jpkm1, 1, -1                       ! integrate from the bottom the hor. divergence 
     221!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     222            DO jj = 1, jpj 
     223               DO ji = 1, jpi   ! vector opt. 
    207224            ! computation of w 
    208             wn(:,:,jk) = wn(:,:,jk+1) - (  e3t_n(:,:,jk) * hdivn(:,:,jk)                 & 
    209                &                         + z1_2dt * ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )  ) * tmask(:,:,jk) 
     225            wn(ji,jj,jk) = wn(ji,jj,jk+1) - (  e3t_n(ji,jj,jk) * hdivn(ji,jj,jk)                 & 
     226               &                         + z1_2dt * ( e3t_a(ji,jj,jk) - e3t_b(ji,jj,jk) )  ) * tmask(ji,jj,jk) 
     227                END DO 
     228            END DO 
    210229         END DO 
    211230      ENDIF 
     
    213232#if defined key_bdy 
    214233      IF( lk_bdy ) THEN 
     234!$OMP PARALLEL DO schedule(static) private(jk) 
    215235         DO jk = 1, jpkm1 
    216236            wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
     
    258278      IF(  ( neuler == 0 .AND. kt == nit000 ) .OR.    & 
    259279         & ( ln_bt_fw    .AND. ln_dynspg_ts )      ) THEN  
     280!$OMP PARALLEL WORKSHARE 
    260281         sshb(:,:) = sshn(:,:)                              ! before <-- now 
    261282         sshn(:,:) = ssha(:,:)                              ! now    <-- after  (before already = now) 
     283!$OMP END PARALLEL WORKSHARE 
    262284         ! 
    263285      ELSE           !==  Leap-Frog time-stepping: Asselin filter + swap  ==! 
    264286         !                                                  ! before <-- now filtered 
     287!$OMP PARALLEL WORKSHARE 
    265288         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) ) 
     289!$OMP END PARALLEL WORKSHARE 
    266290         IF( .NOT.ln_linssh ) THEN                          ! before <-- with forcing removed 
    267291            zcoef = atfp * rdt * r1_rau0 
     292!$OMP PARALLEL WORKSHARE 
    268293            sshb(:,:) = sshb(:,:) - zcoef * (     emp_b(:,:) - emp   (:,:)   & 
    269294               &                             -    rnf_b(:,:) + rnf   (:,:)   & 
    270295               &                             + fwfisf_b(:,:) - fwfisf(:,:)   ) * ssmask(:,:) 
     296!$OMP END PARALLEL WORKSHARE 
    271297         ENDIF 
     298!$OMP PARALLEL WORKSHARE 
    272299         sshn(:,:) = ssha(:,:)                              ! now <-- after 
     300!$OMP END PARALLEL WORKSHARE 
    273301      ENDIF 
    274302      ! 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r5215 r6748  
    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  
     87!$OMP PARALLEL WORKSHARE 
    8888      berg_grid%calving      (:,:)   = 0._wp 
    8989      berg_grid%calving_hflx (:,:)   = 0._wp 
     
    9595      src_calving            (:,:)   = 0._wp 
    9696      src_calving_hflx       (:,:)   = 0._wp 
    97  
     97!$OMP END PARALLEL WORKSHARE 
    9898      !                          ! domain for icebergs 
    9999      IF( lk_mpp .AND. jpni == 1 )   CALL ctl_stop( 'icbinit: having ONE processor in x currently does not work' ) 
     
    108108      nicbfldproc(:) = -1 
    109109 
     110!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    110111      DO jj = 1, jpj 
    111112         DO ji = 1, jpi 
     
    218219         CALL flush(numicb) 
    219220      ENDIF 
    220        
     221!$OMP PARALLEL WORKSHARE       
    221222      src_calving     (:,:) = 0._wp 
    222223      src_calving_hflx(:,:) = 0._wp 
    223  
     224!$OMP END PARALLEL WORKSHARE 
    224225      ! assign each new iceberg with a unique number constructed from the processor number 
    225226      ! and incremented by the total number of processors 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r6490 r6748  
    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) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r6412 r6748  
    155155      ! The last line of blocks (west) will have fewer points 
    156156 
     157!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    157158      DO jj = 1, jpnj 
    158159         DO ji=1, jpni-1 
     
    164165#else 
    165166 
     167!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    166168      DO jj = 1, jpnj 
    167169         DO ji = 1, iresti 
     
    174176       
    175177#endif 
     178!$OMP PARALLEL WORKSHARE 
    176179      nfilcit(:,:) = ilcit(:,:) 
     180!$OMP END PARALLEL WORKSHARE 
    177181      IF( irestj == 0 )   irestj = jpnj 
    178182 
     
    202206      ! ------------------------------- 
    203207       
     208!$OMP PARALLEL WORKSHARE 
    204209      iimppt(:,:) = 1 
    205210      ijmppt(:,:) = 1 
     211!$OMP END PARALLEL WORKSHARE 
    206212       
    207213      IF( jpni > 1 ) THEN 
     214!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    208215         DO jj = 1, jpnj 
    209216            DO ji = 2, jpni 
     
    212219         END DO 
    213220      ENDIF 
     221!$OMP PARALLEL WORKSHARE 
    214222      nfiimpp(:,:)=iimppt(:,:) 
     223!$OMP END PARALLEL WORKSHARE 
    215224 
    216225      IF( jpnj > 1 ) THEN 
     226!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    217227         DO jj = 2, jpnj 
    218228            DO ji = 1, jpni 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r6140 r6748  
    136136      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays') 
    137137      ! 
     138!$OMP PARALLEL WORKSHARE 
    138139      ahmt(:,:,jpk) = 0._wp                           ! last level always 0   
    139140      ahmf(:,:,jpk) = 0._wp 
     141!$OMP END PARALLEL WORKSHARE 
    140142      ! 
    141143      !                                               ! value of eddy mixing coef. 
     
    154156         CASE(   0  )      !==  constant  ==! 
    155157            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant ' 
     158!$OMP PARALLEL WORKSHARE 
    156159            ahmt(:,:,:) = zah0 * tmask(:,:,:) 
    157160            ahmf(:,:,:) = zah0 * fmask(:,:,:) 
     161!$OMP END PARALLEL WORKSHARE 
    158162            ! 
    159163         CASE(  10  )      !==  fixed profile  ==! 
    160164            IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )' 
     165!$OMP PARALLEL WORKSHARE 
    161166            ahmt(:,:,1) = zah0 * tmask(:,:,1)                      ! constant surface value 
    162167            ahmf(:,:,1) = zah0 * fmask(:,:,1) 
     168!$OMP END PARALLEL WORKSHARE 
    163169            CALL ldf_c1d( 'DYN', r1_4, ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf ) 
    164170            ! 
     
    172178!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 
    173179!!              better:  check that the max is <=1  i.e. it is a shape from 0 to 1, not a coef that has physical dimension 
     180!$OMP PARALLEL DO schedule(static) private(jk) 
    174181            DO jk = 2, jpkm1 
    175182               ahmt(:,:,jk) = ahmt(:,:,1) * tmask(:,:,jk) 
     
    190197!!gm Question : info for LAP or BLP case  to take into account the SQRT in the bilaplacian case ???? 
    191198!!              do we introduce a scaling by the max value of the array, and then multiply by zah0 ???? 
     199!$OMP PARALLEL DO schedule(static) private(jk) 
    192200            DO jk = 1, jpkm1 
    193201               ahmt(:,:,jk) = ahmt(:,:,jk) * tmask(:,:,jk) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r6352 r6748  
    135135      z1_slpmax = 1._wp / rn_slpmax 
    136136      ! 
     137 
     138!$OMP PARALLEL WORKSHARE 
    137139      zww(:,:,:) = 0._wp 
    138140      zwz(:,:,:) = 0._wp 
    139       ! 
     141!$OMP END PARALLEL WORKSHARE 
     142      ! 
     143!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    140144      DO jk = 1, jpk             !==   i- & j-gradient of density   ==! 
    141145         DO jj = 1, jpjm1 
     
    147151      END DO 
    148152      IF( ln_zps ) THEN                           ! partial steps correction at the bottom ocean level 
     153!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    149154         DO jj = 1, jpjm1 
    150155            DO ji = 1, jpim1 
     
    155160      ENDIF 
    156161      IF( ln_zps .AND. ln_isfcav ) THEN           ! partial steps correction at the bottom ocean level 
     162!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    157163         DO jj = 1, jpjm1 
    158164            DO ji = 1, jpim1 
     
    164170      ! 
    165171      zdzr(:,:,1) = 0._wp        !==   Local vertical density gradient at T-point   == !   (evaluated from N^2) 
     172!$OMP PARALLEL DO schedule(static) private(jk) 
    166173      DO jk = 2, jpkm1 
    167174         !                                ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 
     
    182189      ! 
    183190      IF ( ln_isfcav ) THEN 
     191!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    184192         DO jj = 2, jpjm1 
    185193            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    191199         END DO 
    192200      ELSE 
     201!$OMP PARALLEL DO schedule(static) private(jj,ji) 
    193202         DO jj = 2, jpjm1 
    194203            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    198207         END DO 
    199208      END IF 
    200  
     209!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zau, zav, zbu, zbv, zfj, zfi, zdepu, zdepv) 
    201210      DO jk = 2, jpkm1                            !* Slopes at u and v points 
    202211         DO jj = 2, jpjm1 
     
    239248      ! 
    240249      !                                            !* horizontal Shapiro filter 
     250!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    241251      DO jk = 2, jpkm1 
    242252         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     
    283293      ! ===========================      | wslpj = mij( d/dj( prd ) / d/dz( prd ) 
    284294      ! 
     295!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbw, zfk, zck, zbi, zbj, zai, zaj, zci, zcj) 
    285296      DO jk = 2, jpkm1 
    286297         DO jj = 2, jpjm1 
     
    321332      ! 
    322333      !                                           !* horizontal Shapiro filter 
     334!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcofw, zck) 
    323335      DO jk = 2, jpkm1 
    324336         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only 
     
    429441         ! 
    430442         ip = jl   ;   jp = jl                ! guaranteed nonzero gradients ( absolute value larger than repsln) 
     443!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zdit,zdis,zdjt,zdjs,zdxrho_raw,zdyrho_raw) 
    431444         DO jk = 1, jpkm1                     ! done each pair of triad 
    432445            DO jj = 1, jpjm1                  ! NB: not masked ==>  a minimum value is set 
     
    445458         ! 
    446459         IF( ln_zps .AND. l_grad_zps ) THEN     ! partial steps: correction of i- & j-grad on bottom 
     460!$OMP PARALLEL DO schedule(static) private(jj,ji,iku,zdit,zdis,zdxrho_raw,zdyrho_raw) 
    447461            DO jj = 1, jpjm1 
    448462               DO ji = 1, jpim1 
     
    676690      ! 
    677691      !                                            !==   surface mixed layer mask   ! 
     692!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ik) 
    678693      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise 
    679694         DO jj = 1, jpj 
     
    698713      !----------------------------------------------------------------------- 
    699714      ! 
     715!$OMP PARALLEL DO schedule(static) private(jj, ji, iku, ikv, zbu, zbv, zau, zav, ik, ikm1, zbw, zci, zcj, zai, zaj, zbi, zbj)  
    700716      DO jj = 2, jpjm1 
    701717         DO ji = 2, jpim1 
     
    791807         ! Direction of lateral diffusion (tracers and/or momentum) 
    792808         ! ------------------------------ 
    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  
     809 
     810!$OMP PARALLEL DO schedule(static) private(jk, jj, ji)    
     811        DO jk = 1, jpk 
     812           DO jj = 1, jpj 
     813              DO ji = 1, jpi 
     814                 uslp (ji,jj,jk) = 0._wp 
     815                 vslp (ji,jj,jk) = 0._wp 
     816                 wslpi(ji,jj,jk) = 0._wp 
     817                 wslpj(ji,jj,jk) = 0._wp 
     818              END DO 
     819           END DO 
     820        END DO 
     821!$OMP PARALLEL DO schedule(static) private(jj, ji)        
     822        DO jj = 1, jpj 
     823            DO ji = 1, jpi 
     824               uslpml (ji,jj) = 0._wp 
     825               vslpml (ji,jj) = 0._wp 
     826               wslpiml(ji,jj) = 0._wp 
     827               wslpjml(ji,jj) = 0._wp 
     828             END DO 
     829        END DO 
     830          
    798831         !!gm I no longer understand this..... 
    799832!!gm         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (.NOT.ln_linssh .AND. ln_rstart) ) THEN 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90

    r6140 r6748  
    185185      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 
    186186      ! 
     187!$OMP PARALLEL WORKSHARE 
    187188      ahtu(:,:,jpk) = 0._wp                           ! last level always 0   
    188189      ahtv(:,:,jpk) = 0._wp 
     190!$OMP END PARALLEL WORKSHARE 
    189191      ! 
    190192      !                                               ! value of eddy mixing coef. 
     
    201203         CASE(   0  )      !==  constant  ==! 
    202204            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant = ', rn_aht_0 
     205!$OMP PARALLEL WORKSHARE 
    203206            ahtu(:,:,:) = zah0 * umask(:,:,:) 
    204207            ahtv(:,:,:) = zah0 * vmask(:,:,:) 
     208!$OMP END PARALLEL WORKSHARE 
    205209            ! 
    206210         CASE(  10  )      !==  fixed profile  ==! 
    207211            IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
     212!$OMP PARALLEL WORKSHARE 
    208213            ahtu(:,:,1) = zah0 * umask(:,:,1)                      ! constant surface value 
    209214            ahtv(:,:,1) = zah0 * vmask(:,:,1) 
     215!$OMP END PARALLEL WORKSHARE 
    210216            CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 
    211217            ! 
     
    216222            CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 
    217223            CALL iom_close( inum ) 
     224!$OMP PARALLEL DO schedule(static) private(jk) 
    218225            DO jk = 2, jpkm1 
    219226               ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 
     
    245252            CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 
    246253            CALL iom_close( inum ) 
     254!$OMP PARALLEL DO schedule(static) private(jk) 
    247255            DO jk = 1, jpkm1 
    248256               ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 
     
    268276         ! 
    269277         IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 
     278!$OMP PARALLEL WORKSHARE 
    270279            ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 
    271280            ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 
     281!$OMP END PARALLEL WORKSHARE 
    272282         ENDIF 
    273283         ! 
     
    422432         CASE(   0  )      !==  constant  ==! 
    423433            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = constant = ', rn_aeiv_0 
     434!$OMP PARALLEL WORKSHARE 
    424435            aeiu(:,:,:) = rn_aeiv_0 
    425436            aeiv(:,:,:) = rn_aeiv_0 
     437!$OMP END PARALLEL WORKSHARE 
    426438            ! 
    427439         CASE(  10  )      !==  fixed profile  ==! 
    428440            IF(lwp) WRITE(numout,*) '          eddy induced velocity coef. = F( depth )' 
     441!$OMP PARALLEL WORKSHARE 
    429442            aeiu(:,:,1) = rn_aeiv_0                                ! constant surface value 
    430443            aeiv(:,:,1) = rn_aeiv_0 
     444!$OMP END PARALLEL WORKSHARE 
    431445            CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 
    432446            ! 
     
    437451            CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 
    438452            CALL iom_close( inum ) 
     453!$OMP PARALLEL DO schedule(static) private(jk) 
    439454            DO jk = 2, jpk 
    440455               aeiu(:,:,jk) = aeiu(:,:,1) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r6140 r6748  
    203203      ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K) 
    204204      zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s 
     205!$OMP PARALLEL DO schedule(static) private(jj, ji, t_star) 
    205206      DO jj = 1, jpj 
    206207         DO ji = 1, jpi 
     
    238239 
    239240      ! freshwater (mass flux) and update of qns with heat content of emp 
     241!$OMP PARALLEL WORKSHARE 
    240242      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average) 
    241243      sfx (:,:) = 0.0_wp                                   ! no salt flux 
    242244      qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST 
    243  
     245!$OMP END PARALLEL WORKSHARE 
    244246 
    245247      ! ---------------------------- ! 
     
    267269      ztau_sais = 0.015 
    268270      ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 
     271!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    269272      DO jj = 1, jpj 
    270273         DO ji = 1, jpi 
     
    278281      ! module of wind stress and wind speed at T-point 
    279282      zcoef = 1. / ( zrhoa * zcdrag )  
     283!$OMP PARALLEL DO schedule(static) private(jj, ji, ztx, zty, zmod) 
    280284      DO jj = 2, jpjm1 
    281285         DO ji = fs_2, fs_jpim1   ! vect. opt. 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r6460 r6748  
    187187      IF( .NOT. ln_isf ) THEN                      ! variable initialisation if no ice shelf  
    188188         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' ) 
     189!$OMP PARALLEL WORKSHARE 
    189190         fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp 
    190191         risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp 
     192!$OMP END PARALLEL WORKSHARE 
    191193      END IF 
    192194      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! no ice in the domain, ice fraction is always zero 
    193  
     195!$OMP PARALLEL WORKSHARE 
    194196      sfx(:,:) = 0._wp                             ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)  
    195197                                                   ! only if sea-ice is present 
     
    198200       
    199201      taum(:,:) = 0._wp                            ! Initialise taum for use in gls in case of reduced restart 
    200  
     202!$OMP END PARALLEL WORKSHARE 
    201203      !                                            ! restartability    
    202204      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   & 
     
    318320      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          ! 
    319321         !                                         ! ---------------------------------------- ! 
     322!$OMP PARALLEL WORKSHARE 
    320323         utau_b(:,:) = utau(:,:)                         ! Swap the ocean forcing fields 
    321324         vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields 
     
    323326         emp_b (:,:) = emp (:,:) 
    324327         sfx_b (:,:) = sfx (:,:) 
     328!$OMP END PARALLEL WORKSHARE 
    325329         IF ( ln_rnf ) THEN 
     330!$OMP PARALLEL WORKSHARE 
    326331            rnf_b    (:,:  ) = rnf    (:,:  ) 
    327332            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:) 
     333!$OMP END PARALLEL WORKSHARE 
    328334         ENDIF 
    329335      ENDIF 
     
    404410               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point) 
    405411            ELSE 
     412!$OMP PARALLEL WORKSHARE 
    406413               sfx_b (:,:) = sfx(:,:) 
     414!$OMP END PARALLEL WORKSHARE 
    407415            ENDIF 
    408416         ELSE                                                   !* no restart: set from nit000 values 
    409417            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000' 
     418!$OMP PARALLEL WORKSHARE 
    410419            utau_b(:,:) = utau(:,:)  
    411420            vtau_b(:,:) = vtau(:,:) 
     
    413422            emp_b (:,:) = emp(:,:) 
    414423            sfx_b (:,:) = sfx(:,:) 
     424!$OMP END PARALLEL WORKSHARE 
    415425         ENDIF 
    416426      ENDIF 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r6489 r6748  
    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         !                                                ! ---------------------------------------- ! 
     71!$OMP PARALLEL WORKSHARE 
    7072         ssu_m(:,:) = ub(:,:,1) 
    7173         ssv_m(:,:) = vb(:,:,1) 
     74!$OMP END PARALLEL WORKSHARE 
    7275         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    7376         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
    7477         ENDIF 
     78!$OMP PARALLEL WORKSHARE 
    7579         sss_m(:,:) = zts(:,:,jp_sal) 
     80!$OMP END PARALLEL WORKSHARE 
    7681         !                          ! 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          ! 
     82         IF( ln_apr_dyn ) THEN   
     83!$OMP PARALLEL WORKSHARE 
     84   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     85!$OMP END PARALLEL WORKSHARE 
     86         ELSE                     
     87!$OMP PARALLEL WORKSHARE 
     88   ssh_m(:,:) = sshn(:,:) 
     89!$OMP END PARALLEL WORKSHARE 
     90         ENDIF 
     91         ! 
     92!$OMP PARALLEL WORKSHARE 
    8193         e3t_m(:,:) = e3t_n(:,:,1) 
    8294         ! 
    8395         frq_m(:,:) = fraqsr_1lev(:,:) 
     96!$OMP END PARALLEL WORKSHARE 
    8497         ! 
    8598      ELSE 
     
    90103            IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values' 
    91104            zcoef = REAL( nn_fsbc - 1, wp ) 
     105!$OMP PARALLEL WORKSHARE 
    92106            ssu_m(:,:) = zcoef * ub(:,:,1) 
    93107            ssv_m(:,:) = zcoef * vb(:,:,1) 
     108!$OMP END PARALLEL WORKSHARE 
    94109            IF( l_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    95110            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
    96111            ENDIF 
     112!$OMP PARALLEL WORKSHARE 
    97113            sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
     114!$OMP END PARALLEL WORKSHARE 
    98115            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    99             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    100             ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
     116            IF( ln_apr_dyn ) THEN    
     117!$OMP PARALLEL WORKSHARE 
     118   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
     119!$OMP END PARALLEL WORKSHARE 
     120            ELSE                     
     121!$OMP PARALLEL WORKSHARE 
     122   ssh_m(:,:) = zcoef * sshn(:,:) 
     123!$OMP END PARALLEL WORKSHARE 
    101124            ENDIF 
    102125            ! 
     126!$OMP PARALLEL WORKSHARE 
    103127            e3t_m(:,:) = zcoef * e3t_n(:,:,1) 
    104128            ! 
    105129            frq_m(:,:) = zcoef * fraqsr_1lev(:,:) 
     130!$OMP END PARALLEL WORKSHARE 
    106131            !                                             ! ---------------------------------------- ! 
    107132         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
    108133            !                                             ! ---------------------------------------- ! 
     134!$OMP PARALLEL WORKSHARE 
    109135            ssu_m(:,:) = 0._wp     ! reset to zero ocean mean sbc fields 
    110136            ssv_m(:,:) = 0._wp 
     
    114140            e3t_m(:,:) = 0._wp 
    115141            frq_m(:,:) = 0._wp 
     142!$OMP END PARALLEL WORKSHARE 
    116143         ENDIF 
    117144         !                                                ! ---------------------------------------- ! 
    118145         !                                                !        Cumulate at each time step        ! 
    119146         !                                                ! ---------------------------------------- ! 
     147!$OMP PARALLEL WORKSHARE 
    120148         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
    121149         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
     150!$OMP END PARALLEL WORKSHARE 
    122151         IF( l_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    123152         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
    124153         ENDIF 
     154!$OMP PARALLEL WORKSHARE 
    125155         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
     156!$OMP END PARALLEL WORKSHARE 
    126157         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    127          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    128          ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
    129          ENDIF 
    130          ! 
     158         IF( ln_apr_dyn ) THEN    
     159!$OMP PARALLEL WORKSHARE 
     160   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     161!$OMP END PARALLEL WORKSHARE 
     162         ELSE                     
     163!$OMP PARALLEL WORKSHARE 
     164   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
     165!$OMP END PARALLEL WORKSHARE 
     166         ENDIF 
     167         ! 
     168!$OMP PARALLEL WORKSHARE 
    131169         e3t_m(:,:) = e3t_m(:,:) + e3t_n(:,:,1) 
    132170         ! 
    133171         frq_m(:,:) = frq_m(:,:) + fraqsr_1lev(:,:) 
     172!$OMP END PARALLEL WORKSHARE 
    134173 
    135174         !                                                ! ---------------------------------------- ! 
     
    137176            !                                             ! ---------------------------------------- ! 
    138177            zcoef = 1. / REAL( nn_fsbc, wp ) 
     178!$OMP PARALLEL WORKSHARE 
    139179            sst_m(:,:) = sst_m(:,:) * zcoef     ! mean SST             [Celcius] 
    140180            sss_m(:,:) = sss_m(:,:) * zcoef     ! mean SSS             [psu] 
     
    144184            e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m] 
    145185            frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
     186!$OMP END PARALLEL WORKSHARE 
    146187            ! 
    147188         ENDIF 
     
    223264                  &                    'from ', zf_sbc, ' to ', nn_fsbc  
    224265               zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc  
     266!$OMP PARALLEL WORKSHARE 
    225267               ssu_m(:,:) = zcoef * ssu_m(:,:)  
    226268               ssv_m(:,:) = zcoef * ssv_m(:,:) 
     
    230272               e3t_m(:,:) = zcoef * e3t_m(:,:) 
    231273               frq_m(:,:) = zcoef * frq_m(:,:) 
     274!$OMP END PARALLEL WORKSHARE 
    232275            ELSE 
    233276               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file' 
     
    239282         ! 
    240283         IF(lwp) WRITE(numout,*) '          default initialisation of ss?_m arrays' 
     284!$OMP PARALLEL WORKSHARE 
    241285         ssu_m(:,:) = ub(:,:,1) 
    242286         ssv_m(:,:) = vb(:,:,1) 
     287!$OMP END PARALLEL WORKSHARE 
    243288         IF( l_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 
    244289         ELSE                    ;   sst_m(:,:) = tsn(:,:,1,jp_tem) 
    245290         ENDIF 
     291!$OMP PARALLEL WORKSHARE 
    246292         sss_m(:,:) = tsn  (:,:,1,jp_sal) 
    247293         ssh_m(:,:) = sshn (:,:) 
    248294         e3t_m(:,:) = e3t_n(:,:,1) 
    249295         frq_m(:,:) = 1._wp 
     296!$OMP END PARALLEL WORKSHARE 
    250297         ! 
    251298      ENDIF 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90

    r6505 r6748  
    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 
     
    589594      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    590595         ! 
     596!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn3, zn2, zn1, zn0, zn) 
    591597         DO jk = 1, jpkm1 
    592598            DO jj = 1, jpj 
     
    646652      CASE( np_seos )                  !==  simplified EOS  ==! 
    647653         ! 
     654!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    648655         DO jk = 1, jpkm1 
    649656            DO jj = 1, jpj 
     
    917924      IF( nn_timing == 1 ) CALL timing_start('bn2') 
    918925      ! 
     926!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrw, zaw, zbw) 
    919927      DO jk = 2, jpkm1           ! interior points only (2=< jk =< jpkm1 ) 
    920928         DO jj = 1, jpj          ! surface and bottom value set to zero one for all in istate.F90 
     
    11341142      CASE( np_teos10, np_eos80 )                !==  polynomial TEOS-10 / EOS-80 ==! 
    11351143         ! 
     1144!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn2, zn1, zn0, zn) 
    11361145         DO jk = 1, jpkm1 
    11371146            DO jj = 1, jpj 
     
    11971206      CASE( np_seos )                !==  Vallis (2006) simplified EOS  ==! 
    11981207         ! 
     1208!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zh, zt, zs, ztm, zn) 
    11991209         DO jk = 1, jpkm1 
    12001210            DO jj = 1, jpj 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r6140 r6748  
    100100      ! 
    101101      !                                         !==  effective transport  ==! 
     102!$OMP PARALLEL DO schedule(static) private(jk) 
    102103      DO jk = 1, jpkm1 
    103104         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

    r6140 r6748  
    9898      IF( l_trd )  THEN 
    9999         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     100!$OMP PARALLEL WORKSHARE 
    100101         ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp 
     102!$OMP END PARALLEL WORKSHARE 
    101103      ENDIF 
    102104      ! 
    103105      !                          ! surface & bottom value : flux set to zero one for all 
     106!$OMP PARALLEL WORKSHARE 
    104107      zwz(:,:, 1 ) = 0._wp             
    105108      zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp 
    106109      ! 
    107110      zwi(:,:,:) = 0._wp         
     111!$OMP END PARALLEL WORKSHARE 
    108112      ! 
    109113      DO jn = 1, kjpt            !==  loop over the tracers  ==! 
     
    111115         !        !==  upstream advection with initial mass fluxes & intermediate update  ==! 
    112116         !                    !* upstream tracer flux in the i and j direction  
     117!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui,zfm_ui) 
    113118         DO jk = 1, jpkm1 
    114119            DO jj = 1, jpjm1 
     
    125130         END DO 
    126131         !                    !* upstream tracer flux in the k direction *! 
     132!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk) 
    127133         DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask) 
    128134            DO jj = 1, jpj 
     
    146152         ENDIF 
    147153         !                
     154!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztra) 
    148155         DO jk = 1, jpkm1     !* trend and after field with monotonic scheme 
    149156            DO jj = 2, jpjm1 
     
    163170         !                 
    164171         IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes) 
     172!$OMP PARALLEL WORKSHARE 
    165173            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
     174!$OMP END PARALLEL WORKSHARE 
    166175         END IF 
    167176         !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     
    176185         ! 
    177186         CASE(  2  )                   !- 2nd order centered 
     187!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    178188            DO jk = 1, jpkm1 
    179189               DO jj = 1, jpjm1 
     
    186196            ! 
    187197         CASE(  4  )                   !- 4th order centered 
     198!$OMP PARALLEL WORKSHARE 
    188199            zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero 
    189200            zltv(:,:,jpk) = 0._wp 
     201!$OMP END PARALLEL WORKSHARE 
     202!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    190203            DO jk = 1, jpkm1                 ! Laplacian 
    191204               DO jj = 1, jpjm1                    ! 1st derivative (gradient) 
     
    204217            CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn) 
    205218            ! 
     219!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v) 
    206220            DO jk = 1, jpkm1                 ! Horizontal advective fluxes 
    207221               DO jj = 1, jpjm1 
     
    217231            ! 
    218232         CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested 
     233!$OMP PARALLEL WORKSHARE 
    219234            ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero 
    220235            ztv(:,:,jpk) = 0._wp 
     236!$OMP END PARALLEL WORKSHARE 
     237!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    221238            DO jk = 1, jpkm1                 ! 1st derivative (gradient) 
    222239               DO jj = 1, jpjm1 
     
    229246            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn) 
    230247            ! 
     248!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v, zC4t_u, zC4t_v) 
    231249            DO jk = 1, jpkm1                 ! Horizontal advective fluxes 
    232250               DO jj = 2, jpjm1 
     
    249267         ! 
    250268         CASE(  2  )                   !- 2nd order centered 
     269!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    251270            DO jk = 2, jpkm1     
    252271               DO jj = 2, jpjm1 
     
    260279         CASE(  4  )                   !- 4th order COMPACT 
    261280            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
     281!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    262282            DO jk = 2, jpkm1 
    263283               DO jj = 2, jpjm1 
     
    282302         !        !==  final trend with corrected fluxes  ==! 
    283303         ! 
     304!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    284305         DO jk = 1, jpkm1 
    285306            DO jj = 2, jpjm1 
     
    294315         ! 
    295316         IF( l_trd ) THEN     ! trend diagnostics (contribution of upstream fluxes) 
     317!$OMP PARALLEL WORKSHARE 
    296318            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    297319            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    298320            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
     321!$OMP END PARALLEL WORKSHARE 
    299322            ! 
    300323            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     
    626649      zbig  = 1.e+40_wp 
    627650      zrtrn = 1.e-15_wp 
     651!$OMP PARALLEL WORKSHARE 
    628652      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
     653!$OMP END PARALLEL WORKSHARE 
    629654 
    630655      ! Search local extrema 
     
    636661         &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    637662 
     663!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ikm1, zup, zdo, zpos, zneg, zbt) 
    638664      DO jk = 1, jpkm1 
    639665         ikm1 = MAX(jk-1,1) 
     
    674700      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    675701      ! ---------------------------------------- 
     702!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu) 
    676703      DO jk = 1, jpkm1 
    677704         DO jj = 2, jpjm1 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90

    r6140 r6748  
    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 ) 
     350!$OMP PARALLEL WORKSHARE 
    349351         r1_ft(:,:) = 2._wp * omega * SIN( rad * gphit(:,:) ) 
    350352         r1_ft(:,:) = 1._wp / SQRT(  r1_ft(:,:) * r1_ft(:,:) + z1_t2 ) 
     353!$OMP END PARALLEL WORKSHARE 
    351354         ! 
    352355      ENDIF 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r6352 r6748  
    6565      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    6666         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt, ztrds )  
     67!$OMP PARALLEL WORKSHARE 
    6768         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
    6869         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     70!$OMP END PARALLEL WORKSHARE 
    6971      ENDIF 
    7072      ! 
     
    8183      ! 
    8284      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
     85!$OMP PARALLEL WORKSHARE 
    8386         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    8487         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
     88!$OMP END PARALLEL WORKSHARE 
    8589         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    8690         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r6140 r6748  
    143143      IF( kpass == 1 ) THEN                  !==  first pass only  ==! 
    144144         ! 
     145!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w) 
    145146         DO jk = 2, jpkm1 
    146147            DO jj = 2, jpjm1 
     
    164165         ! 
    165166         IF( ln_traldf_msc ) THEN                ! stabilizing vertical diffusivity coefficient 
     167!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    166168            DO jk = 2, jpkm1 
    167169               DO jj = 2, jpjm1 
     
    177179            ! 
    178180            IF( ln_traldf_blp ) THEN                ! bilaplacian operator 
     181!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    179182               DO jk = 2, jpkm1 
    180183                  DO jj = 1, jpjm1 
     
    186189               END DO 
    187190            ELSEIF( ln_traldf_lap ) THEN              ! laplacian operator 
     191!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ze3w_2, zcoef0) 
    188192               DO jk = 2, jpkm1 
    189193                  DO jj = 1, jpjm1 
     
    198202           ! 
    199203         ELSE                                    ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 
     204!$OMP PARALLEL WORKSHARE 
    200205            akz(:,:,:) = ah_wslp2(:,:,:)       
     206!$OMP END PARALLEL WORKSHARE 
    201207         ENDIF 
    202208      ENDIF 
     
    210216         !!---------------------------------------------------------------------- 
    211217!!gm : bug.... why (x,:,:)?   (1,jpj,:) and (jpi,1,:) should be sufficient.... 
     218!$OMP PARALLEL WORKSHARE 
    212219         zdit (1,:,:) = 0._wp     ;     zdit (jpi,:,:) = 0._wp 
    213220         zdjt (1,:,:) = 0._wp     ;     zdjt (jpi,:,:) = 0._wp 
     221!$OMP END PARALLEL WORKSHARE 
    214222         !!end 
    215223 
    216224         ! Horizontal tracer gradient  
     225!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    217226         DO jk = 1, jpkm1 
    218227            DO jj = 1, jpjm1 
     
    224233         END DO 
    225234         IF( ln_zps ) THEN      ! botton and surface ocean correction of the horizontal gradient 
     235!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    226236            DO jj = 1, jpjm1              ! bottom correction (partial bottom cell) 
    227237               DO ji = 1, fs_jpim1   ! vector opt. 
     
    231241            END DO 
    232242            IF( ln_isfcav ) THEN      ! first wet level beneath a cavity 
     243!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    233244               DO jj = 1, jpjm1 
    234245                  DO ji = 1, fs_jpim1   ! vector opt. 
     
    243254         !!   II - horizontal trend  (full) 
    244255         !!---------------------------------------------------------------------- 
    245          ! 
    246          DO jk = 1, jpkm1                                 ! Horizontal slab 
    247             ! 
    248             !                             !== Vertical tracer gradient 
    249             zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
    250             ! 
    251             IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
    252             ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 
    253             ENDIF 
    254             DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    255                DO ji = 1, fs_jpim1   ! vector opt. 
    256                   zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
    257                   zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
    258                   ! 
    259                   zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   & 
    260                      &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1. ) 
    261                   ! 
    262                   zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   & 
    263                      &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1. ) 
    264                   ! 
    265                   zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
    266                   zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
    267                   ! 
    268                   zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   & 
    269                      &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      & 
    270                      &                          + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk) 
    271                   zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   & 
    272                      &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      & 
    273                      &                          + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                   
    274                END DO 
    275             END DO 
    276             ! 
     256!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     257               DO jj = 1 , jpj            !==  Horizontal fluxes 
     258                  DO ji = 1, jpi   ! vector opt. 
     259                         zdk1t(ji,jj) = ( ptb(ji,jj,1,jn) - ptb(ji,jj,2,jn) ) * wmask(ji,jj,2)  
     260                         zdkt(ji,jj) = zdk1t(ji,jj) 
     261                  END DO 
     262               END DO 
     263!$OMP PARALLEL DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2) 
     264               DO jj = 1 , jpjm1            !==  Horizontal fluxes 
     265                  DO ji = 1, fs_jpim1   ! vector opt. 
     266                  zabe1 = pahu(ji,jj,1) * e2_e1u(ji,jj) * e3u_n(ji,jj,1) 
     267                  zabe2 = pahv(ji,jj,1) * e1_e2v(ji,jj) * e3v_n(ji,jj,1) 
     268                  ! 
     269                  zmsku = 1. / MAX(  wmask(ji+1,jj,1  ) + wmask(ji,jj,2)   & 
     270                     &             + wmask(ji+1,jj,2) + wmask(ji,jj,1 ), 1.) 
     271                  ! 
     272                  zmskv = 1. / MAX(  wmask(ji,jj+1,1  ) + wmask(ji,jj,2)   & 
     273                     &             + wmask(ji,jj+1,2) + wmask(ji,jj,1  ), 1.) 
     274                  ! 
     275                  zcof1 = - pahu(ji,jj,1) * e2u(ji,jj) * uslp(ji,jj,1) * zmsku 
     276                  zcof2 = - pahv(ji,jj,1) * e1v(ji,jj) * vslp(ji,jj,1) * zmskv 
     277                  ! 
     278                  zftu(ji,jj,1 ) = (  zabe1 * zdit(ji,jj,1)   & 
     279                     &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)   & 
     280                     &                          + zdk1t(ji+1,jj) + zdkt (ji,jj))  ) * umask(ji,jj,1) 
     281                  zftv(ji,jj,1 ) = (  zabe2 * zdjt(ji,jj,1)   & 
     282                     &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)   & 
     283                     &                          + zdk1t(ji,jj+1) + zdkt (ji,jj))  ) * vmask(ji,jj,1) 
     284               END DO 
     285            END DO 
     286            ! 
     287!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    277288            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta 
    278289               DO ji = fs_2, fs_jpim1   ! vector opt. 
    279                   pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
    280                      &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
    281                      &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    282                END DO 
    283             END DO 
    284          END DO                                        !   End of slab   
     290                  pta(ji,jj,1,jn) = pta(ji,jj,1,jn) + zsign * (zftu(ji,jj,1) - zftu(ji-1,jj,1)      & 
     291                     &               + zftv(ji,jj,1) - zftv(ji,jj-1,1)  )   & 
     292                     &                          * r1_e1e2t(ji,jj) / e3t_n(ji,jj,1) 
     293               END DO 
     294            END DO 
     295            DO jk = 2, jpkm1 
     296!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     297               DO jj = 1 , jpj            !==  Horizontal fluxes 
     298                  DO ji = 1, jpi   ! vector opt. 
     299                zdk1t(ji,jj) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) 
     300                zdkt(ji,jj) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
     301                  END DO 
     302               END DO 
     303!$OMP PARALLEL DO schedule(static) private(jj, ji, zmsku, zmskv, zabe1, zabe2, zcof1, zcof2) 
     304               DO jj = 1 , jpjm1            !==  Horizontal fluxes 
     305                  DO ji = 1, fs_jpim1   ! vector opt. 
     306                        zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
     307                        zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
     308                        ! 
     309                        zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   & 
     310                     &             + wmask(ji+1,jj,jk+1) + wmask(ji,jj,jk  ), 1.) 
     311                        ! 
     312                        zmskv = 1. / MAX(  wmask(ji,jj+1,jk  ) + wmask(ji,jj,jk+1)   & 
     313                     &             + wmask(ji,jj+1,jk+1) + wmask(ji,jj,jk  ), 1.) 
     314                        ! 
     315                        zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 
     316                        zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 
     317                  ! 
     318                        zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   & 
     319                     &               + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj) & 
     320                     &                          + zdk1t(ji+1,jj) + zdkt (ji,jj))  ) * umask(ji,jj,jk) 
     321                        zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   & 
     322                     &               + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj) & 
     323                     &                          + zdk1t(ji,jj+1) + zdkt (ji,jj))  ) * vmask(ji,jj,jk) 
     324                  END DO 
     325               END DO 
     326            ! 
     327!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     328               DO jj = 2 , jpjm1          !== horizontal divergence and add to pta 
     329                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     330                        pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
     331                     &               + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
     332                     &                          * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     333                  END DO 
     334               END DO 
     335            END DO 
     336 
    285337 
    286338         !!---------------------------------------------------------------------- 
     
    288340         !!---------------------------------------------------------------------- 
    289341         ! 
     342!$OMP PARALLEL WORKSHARE 
    290343         ztfw(1,:,:) = 0._wp     ;     ztfw(jpi,:,:) = 0._wp 
    291344         ! 
     
    294347         !                          ! Surface and bottom vertical fluxes set to zero 
    295348         ztfw(:,:, 1 ) = 0._wp      ;      ztfw(:,:,jpk) = 0._wp 
     349!$OMP END PARALLEL WORKSHARE 
    296350          
     351!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zmsku, zmskv, zahu_w, zahv_w, zcoef3, zcoef4) 
    297352         DO jk = 2, jpkm1           ! interior (2=<jk=<jpk-1) 
    298353            DO jj = 2, jpjm1 
     
    321376         !                                !==  add the vertical 33 flux  ==! 
    322377         IF( ln_traldf_lap ) THEN               ! laplacian case: eddy coef = ah_wslp2 - akz 
     378!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    323379            DO jk = 2, jpkm1        
    324380               DO jj = 1, jpjm1 
     
    334390            SELECT CASE( kpass ) 
    335391            CASE(  1  )                            ! 1st pass : eddy coef = ah_wslp2 
     392!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    336393               DO jk = 2, jpkm1  
    337394                  DO jj = 1, jpjm1 
     
    344401               END DO  
    345402            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
     403!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    346404               DO jk = 2, jpkm1  
    347405                  DO jj = 1, jpjm1 
     
    356414         ENDIF 
    357415         !          
     416!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    358417         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
    359418            DO jj = 2, jpjm1 
     
    379438              IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN 
    380439                  z2d(:,:) = zftu(ji,jj,1)  
     440!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    381441                  DO jk = 2, jpkm1 
    382442                     DO jj = 2, jpjm1 
     
    388448!!gm CAUTION I think there is an error of sign when using BLP operator.... 
    389449!!gm         a multiplication by zsign is required (to be checked twice !) 
     450!$OMP PARALLEL WORKSHARE 
    390451                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     452!$OMP END PARALLEL WORKSHARE 
    391453                  CALL lbc_lnk( z2d, 'U', -1. ) 
    392454                  CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction 
    393455                  ! 
     456!$OMP PARALLEL WORKSHARE 
    394457                  z2d(:,:) = zftv(ji,jj,1)  
     458!$OMP END PARALLEL WORKSHARE 
     459!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    395460                  DO jk = 2, jpkm1 
    396461                     DO jj = 2, jpjm1 
     
    400465                     END DO 
    401466                  END DO 
     467!$OMP PARALLEL WORKSHARE 
    402468                  z2d(:,:) = - rau0_rcp * z2d(:,:)     ! note sign is reversed to give down-gradient diffusive transports (#1043) 
     469!$OMP END PARALLEL WORKSHARE 
    403470                  CALL lbc_lnk( z2d, 'V', -1. ) 
    404471                  CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r6140 r6748  
    123123      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter 
    124124         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     125!$OMP PARALLEL WORKSHARE 
    125126         ztrdt(:,:,:) = tsn(:,:,:,jp_tem)  
    126127         ztrds(:,:,:) = tsn(:,:,:,jp_sal) 
     128!$OMP END PARALLEL WORKSHARE 
    127129         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend  
    128130            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 
     
    133135      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap) 
    134136         DO jn = 1, jpts 
     137!$OMP PARALLEL DO schedule(static) private(jk) 
    135138            DO jk = 1, jpkm1 
    136139               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)     
     
    153156      ! 
    154157      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
     158!$OMP PARALLEL DO schedule(static) private(jk, zfact) 
    155159         DO jk = 1, jpkm1 
    156160            zfact = 1._wp / r2dt              
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r6403 r6748  
    128128      IF( l_trdtra ) THEN      ! trends diagnostic: save the input temperature trend 
    129129         CALL wrk_alloc( jpi,jpj,jpk,   ztrdt )  
     130!$OMP PARALLEL WORKSHARE 
    130131         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     132!$OMP END PARALLEL WORKSHARE 
    131133      ENDIF 
    132134      ! 
     
    146148      ELSE                             !==  Swap of qsr heat content  ==! 
    147149         z1_2 = 0.5_wp 
     150!$OMP PARALLEL WORKSHARE 
    148151         qsr_hc_b(:,:,:) = qsr_hc(:,:,:) 
     152!$OMP END PARALLEL WORKSHARE 
    149153      ENDIF 
    150154      ! 
     
    155159      CASE( np_BIO )                   !==  bio-model fluxes  ==! 
    156160         ! 
     161!$OMP PARALLEL DO schedule(static) private(jk) 
    157162         DO jk = 1, nksr 
    158163            qsr_hc(:,:,jk) = r1_rau0_rcp * ( etot3(:,:,jk) - etot3(:,:,jk+1) ) 
     
    166171         IF( nqsr == np_RGBc ) THEN          !*  Variable Chlorophyll 
    167172            CALL fld_read( kt, 1, sf_chl )         ! Read Chl data and provides it at the current time step 
     173!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,zCtot,zze,zpsi,zlogc,zlogc2,zlogc3,zCb,zCmax,zpsimax,zdelpsi,zCze) 
    168174            DO jk = 1, nksr + 1 
    169175               DO jj = 2, jpjm1                       ! Separation in R-G-B depending of the surface Chl 
     
    190196            END DO 
    191197         ELSE                                !* constant chrlorophyll 
     198!$OMP PARALLEL DO schedule(static) private(jk) 
    192199           DO jk = 1, nksr + 1 
    193200              zchl3d(:,:,jk) = 0.05  
     
    206213         END DO 
    207214         ! 
     215!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zchl,irgb,zc0,zc1,zc2,zc3) 
    208216         DO jk = 2, nksr+1                   !* interior equi-partition in R-G-B depending of vertical profile of Chl 
    209217            DO jj = 2, jpjm1 
     
    232240         END DO 
    233241         ! 
     242!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    234243         DO jk = 1, nksr                     !* now qsr induced heat content 
    235244            DO jj = 2, jpjm1 
     
    247256         zz0 =        rn_abs   * r1_rau0_rcp      ! surface equi-partition in 2-bands 
    248257         zz1 = ( 1. - rn_abs ) * r1_rau0_rcp 
     258!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zc0,zc1) 
    249259         DO jk = 1, nksr                          ! solar heat absorbed at T-point in the top 400m  
    250260            DO jj = 2, jpjm1 
     
    260270      ! 
    261271      !                          !-----------------------------! 
     272!$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 
    262273      DO jk = 1, nksr            !  update to the temp. trend  ! 
    263274         DO jj = 2, jpjm1        !-----------------------------! 
     
    426437      END SELECT 
    427438      ! 
     439!$OMP PARALLEL WORKSHARE 
    428440      qsr_hc(:,:,:) = 0._wp     ! now qsr heat content set to zero where it will not be computed 
     441!$OMP END PARALLEL WORKSHARE 
    429442      ! 
    430443      ! 1st ocean level attenuation coefficient (used in sbcssm) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r6472 r6748  
    8888      IF( l_trdtra ) THEN                    !* Save ta and sa trends 
    8989         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )  
     90!$OMP PARALLEL WORKSHARE 
    9091         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    9192         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     93!$OMP END PARALLEL WORKSHARE 
    9294      ENDIF 
    9395      ! 
    9496!!gm  This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 
    9597      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration 
     98!$OMP PARALLEL WORKSHARE 
    9699         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns 
    97100         qsr(:,:) = 0._wp                     ! qsr set to zero 
     101!$OMP END PARALLEL WORKSHARE 
    98102      ENDIF 
    99103 
     
    111115         ELSE                                   ! No restart or restart not found: Euler forward time stepping 
    112116            zfact = 1._wp 
     117!$OMP PARALLEL WORKSHARE 
    113118            sbc_tsc_b(:,:,:) = 0._wp 
     119!$OMP END PARALLEL WORKSHARE 
    114120         ENDIF 
    115121      ELSE                                !* other time-steps: swap of forcing fields 
    116122         zfact = 0.5_wp 
     123!$OMP PARALLEL WORKSHARE 
    117124         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 
     125!$OMP END PARALLEL WORKSHARE 
    118126      ENDIF 
    119127      !                             !==  Now sbc tracer content fields  ==! 
     128!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    120129      DO jj = 2, jpj 
    121130         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    125134      END DO 
    126135      IF( ln_linssh ) THEN                !* linear free surface   
     136!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    127137         DO jj = 2, jpj                         !==>> add concentration/dilution effect due to constant volume cell 
    128138            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    136146      ! 
    137147      DO jn = 1, jpts               !==  update tracer trend  ==! 
     148!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    138149         DO jj = 2, jpj 
    139150            DO ji = fs_2, fs_jpim1   ! vector opt.   
     
    217228      ! 
    218229      IF( ln_iscpl .AND. ln_hsb) THEN         ! input of heat and salt due to river runoff  
     230!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zdep) 
    219231         DO jk = 1,jpk 
    220232            DO jj = 2, jpj  
     
    231243 
    232244      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
     245!$OMP PARALLEL WORKSHARE 
    233246         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    234247         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
     248!$OMP END PARALLEL WORKSHARE 
    235249         CALL trd_tra( kt, 'TRA', jp_tem, jptra_nsr, ztrdt ) 
    236250         CALL trd_tra( kt, 'TRA', jp_sal, jptra_nsr, ztrds ) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r6140 r6748  
    7272      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    7373         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     74!$OMP PARALLEL WORKSHARE 
    7475         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    7576         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     77!$OMP END PARALLEL WORKSHARE 
    7678      ENDIF 
    7779      ! 
     
    8890 
    8991      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
     92!$OMP PARALLEL DO schedule(static) private(jk) 
    9093         DO jk = 1, jpkm1 
    9194            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90

    r6140 r6748  
    109109            ELSE                                            ;   zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 
    110110            ENDIF 
     111!$OMP PARALLEL WORKSHARE 
    111112            zwt(:,:,1) = 0._wp 
     113!$OMP END PARALLEL WORKSHARE 
    112114            ! 
    113115            IF( l_ldfslp ) THEN            ! isoneutral diffusion: add the contribution  
    114116               IF( ln_traldf_msc  ) THEN     ! MSC iso-neutral operator  
     117!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    115118                  DO jk = 2, jpkm1 
    116119                     DO jj = 2, jpjm1 
     
    121124                  END DO 
    122125               ELSE                          ! standard or triad iso-neutral operator 
     126!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    123127                  DO jk = 2, jpkm1 
    124128                     DO jj = 2, jpjm1 
     
    132136            ! 
    133137            ! Diagonal, lower (i), upper (s)  (including the bottom boundary condition since avt is masked) 
     138!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    134139            DO jk = 1, jpkm1 
    135140               DO jj = 2, jpjm1 
     
    162167            !   used as a work space array: its value is modified. 
    163168            ! 
     169!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    164170            DO jj = 2, jpjm1        !* 1st recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    165171               DO ji = fs_2, fs_jpim1            ! done one for all passive tracers (so included in the IF instruction) 
     
    168174            END DO 
    169175            DO jk = 2, jpkm1 
     176!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    170177               DO jj = 2, jpjm1 
    171178                  DO ji = fs_2, fs_jpim1 
     
    177184         ENDIF  
    178185         !          
     186!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    179187         DO jj = 2, jpjm1           !* 2nd recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
    180188            DO ji = fs_2, fs_jpim1 
     
    183191         END DO 
    184192         DO jk = 2, jpkm1 
     193!$OMP PARALLEL DO schedule(static) private(jj, ji, zrhs) 
    185194            DO jj = 2, jpjm1 
    186195               DO ji = fs_2, fs_jpim1 
     
    191200         END DO 
    192201         ! 
     202!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    193203         DO jj = 2, jpjm1           !* 3d recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer) 
    194204            DO ji = fs_2, fs_jpim1 
     
    197207         END DO 
    198208         DO jk = jpk-2, 1, -1 
     209!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    199210            DO jj = 2, jpjm1 
    200211               DO ji = fs_2, fs_jpim1 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r6140 r6748  
    112112         IF ( ln_loglayer.AND. .NOT.ln_linssh ) THEN ! "log layer" bottom friction coefficient 
    113113 
     114!$OMP PARALLEL DO private(jj,ji,ikbt,ztmp) 
    114115            DO jj = 1, jpj 
    115116               DO ji = 1, jpi 
     
    123124! (ISF) 
    124125            IF ( ln_isfcav ) THEN 
     126!$OMP PARALLEL DO private(jj,ji,ikbt,ztmp) 
    125127               DO jj = 1, jpj 
    126128                  DO ji = 1, jpi 
     
    135137            !    
    136138         ELSE 
     139!$OMP PARALLEL WORKSHARE 
    137140            zbfrt(:,:) = bfrcoef2d(:,:) 
    138141            ztfrt(:,:) = tfrcoef2d(:,:) 
    139          ENDIF 
    140  
     142!$OMP END PARALLEL WORKSHARE 
     143         ENDIF 
     144 
     145!$OMP PARALLEL DO private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv) 
    141146         DO jj = 2, jpjm1 
    142147            DO ji = 2, jpim1 
     
    173178 
    174179         IF( ln_isfcav ) THEN 
     180!$OMP PARALLEL DO private(jj,ji,ikbu,ikbv,zvu,zuv,zecu,zecv) 
    175181            DO jj = 2, jpjm1 
    176182               DO ji = 2, jpim1 
     
    266272      CASE( 0 ) 
    267273         IF(lwp) WRITE(numout,*) '      free-slip ' 
     274!$OMP PARALLEL WORKSHARE 
    268275         bfrua(:,:) = 0.e0 
    269276         bfrva(:,:) = 0.e0 
    270277         tfrua(:,:) = 0.e0 
    271278         tfrva(:,:) = 0.e0 
     279!$OMP END PARALLEL WORKSHARE 
    272280         ! 
    273281      CASE( 1 ) 
     
    296304         ENDIF 
    297305         ! 
     306!$OMP PARALLEL WORKSHARE 
    298307         bfrua(:,:) = - bfrcoef2d(:,:) 
    299308         bfrva(:,:) = - bfrcoef2d(:,:) 
     309!$OMP END PARALLEL WORKSHARE 
    300310         ! 
    301311         IF ( ln_isfcav ) THEN 
     
    310320            ENDIF 
    311321            ! 
     322!$OMP PARALLEL WORKSHARE 
    312323            tfrua(:,:) = - tfrcoef2d(:,:) 
    313324            tfrva(:,:) = - tfrcoef2d(:,:) 
     325!$OMP END PARALLEL WORKSHARE 
    314326         END IF 
    315327         ! 
     
    371383         ! 
    372384         IF( ln_loglayer.AND. ln_linssh ) THEN ! set "log layer" bottom friction once for all 
     385!$OMP PARALLEL DO private(jj,ji,ikbt,ztmp) 
    373386            DO jj = 1, jpj 
    374387               DO ji = 1, jpi 
     
    380393            END DO 
    381394            IF ( ln_isfcav ) THEN 
     395!$OMP PARALLEL DO private(jj,ji,ikbt,ztmp) 
    382396               DO jj = 1, jpj 
    383397                  DO ji = 1, jpi 
     
    419433      zmaxtfr = -1.e10_wp    ! initialise tracker for maximum of bottom friction coefficient 
    420434      ! 
     435!$OMP PARALLEL DO private(jj,ji,ikbu,ikbv,zfru,zfrv,ictu,ictv,zminbfr,zmaxbfr,zmintfr,zmaxtfr) 
    421436      DO jj = 2, jpjm1 
    422437         DO ji = 2, jpim1 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90

    r6140 r6748  
    7676         zavm_evd(:,:,:) = avm(:,:,:)           ! set avm prior to evd application 
    7777         ! 
     78!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    7879         DO jk = 1, jpkm1  
    7980            DO jj = 2, jpj             ! no vector opt. 
     
    9798         ! 
    9899      CASE DEFAULT         ! enhance vertical eddy diffusivity only (if rn2<-1.e-12)  
     100!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    99101         DO jk = 1, jpkm1 
    100102!!!         WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd   ! agissant sur T SEUL!  
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90

    r6352 r6748  
    9696 
    9797      ! w-level of the mixing and mixed layers 
     98!$OMP PARALLEL WORKSHARE 
    9899      nmln(:,:)  = nlb10               ! Initialization to the number of w ocean point 
    99100      hmlp(:,:)  = 0._wp               ! here hmlp used as a dummy variable, integrating vertically N^2 
     101!$OMP END PARALLEL WORKSHARE 
    100102      zN2_c = grav * rho_c * r1_rau0   ! convert density criteria into N^2 criteria 
    101103      DO jk = nlb10, jpkm1 
     
    110112      ! 
    111113      ! w-level of the turbocline and mixing layer (iom_use) 
     114!$OMP PARALLEL WORKSHARE 
    112115      imld(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point 
     116!$OMP END PARALLEL WORKSHARE 
     117 
    113118      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10  
    114119         DO jj = 1, jpj 
     
    119124      END DO 
    120125      ! depth of the mixing and mixed layers 
     126!$OMP PARALLEL DO schedule(static) private(jj, ji, iiki, iikn) 
    121127      DO jj = 1, jpj 
    122128         DO ji = 1, jpi 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r6497 r6748  
    179179      ! 
    180180      IF( kt /= nit000 ) THEN   ! restore before value to compute tke 
     181!$OMP PARALLEL WORKSHARE 
    181182         avt (:,:,:) = avt_k (:,:,:)  
    182183         avm (:,:,:) = avm_k (:,:,:)  
    183184         avmu(:,:,:) = avmu_k(:,:,:)  
    184185         avmv(:,:,:) = avmv_k(:,:,:)  
     186!$OMP END PARALLEL WORKSHARE 
    185187      ENDIF  
    186188      ! 
     
    189191      CALL tke_avn      ! now avt, avm, avmu, avmv 
    190192      ! 
     193!$OMP PARALLEL WORKSHARE 
    191194      avt_k (:,:,:) = avt (:,:,:)  
    192195      avm_k (:,:,:) = avm (:,:,:)  
    193196      avmu_k(:,:,:) = avmu(:,:,:)  
    194197      avmv_k(:,:,:) = avmv(:,:,:)  
     198!$OMP END PARALLEL WORKSHARE 
    195199      ! 
    196200#if defined key_agrif 
     
    253257      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    254258      IF ( ln_isfcav ) THEN 
     259!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    255260         DO jj = 2, jpjm1            ! en(mikt(ji,jj))   = rn_emin 
    256261            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    259264         END DO 
    260265      END IF 
     266!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    261267      DO jj = 2, jpjm1            ! en(1)   = rn_ebb taum / rau0  (min value rn_emin0) 
    262268         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    295301         zpelc(:,:,1) =  MAX( rn2b(:,:,1), 0._wp ) * gdepw_n(:,:,1) * e3w_n(:,:,1) 
    296302         DO jk = 2, jpk 
    297             zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw_n(:,:,jk) * e3w_n(:,:,jk) 
     303!$OMP PARALLEL DO schedule(static) private(jj, ji) 
     304            DO jj =1, jpj 
     305               DO ji=1, jpi 
     306                  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) 
     307               END DO 
     308            END DO 
    298309         END DO 
    299310         !                        !* finite Langmuir Circulation depth 
     
    309320         END DO 
    310321         !                               ! finite LC depth 
     322!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    311323         DO jj = 1, jpj  
    312324            DO ji = 1, jpi 
     
    315327         END DO 
    316328         zcof = 0.016 / SQRT( zrhoa * zcdrag ) 
     329!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zus, zind, zwlc) 
    317330         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en 
    318331            DO jj = 2, jpjm1 
     
    338351      !                     ! zdiag : diagonal zd_up : upper diagonal zd_lw : lower diagonal 
    339352      ! 
     353!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    340354      DO jk = 2, jpkm1           !* Shear production at uw- and vw-points (energy conserving form) 
    341355         DO jj = 1, jpjm1 
     
    356370         ! Note that zesh2 is also computed in the next loop. 
    357371         ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 
     372!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zesh2, zri) 
    358373         DO jk = 2, jpkm1 
    359374            DO jj = 2, jpjm1 
     
    372387      ENDIF 
    373388      !          
     389!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zcof, zzd_up, zzd_lw, zesh2) 
    374390      DO jk = 2, jpkm1           !* Matrix and right hand side in en 
    375391         DO jj = 2, jpjm1 
     
    405421      !                          !* Matrix inversion from level 2 (tke prescribed at level 1) 
    406422      DO jk = 3, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 
     423!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    407424         DO jj = 2, jpjm1 
    408425            DO ji = fs_2, fs_jpim1    ! vector opt. 
     
    411428         END DO 
    412429      END DO 
     430!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    413431      DO jj = 2, jpjm1                             ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 
    414432         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    417435      END DO 
    418436      DO jk = 3, jpkm1 
     437!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    419438         DO jj = 2, jpjm1 
    420439            DO ji = fs_2, fs_jpim1    ! vector opt. 
     
    423442         END DO 
    424443      END DO 
     444!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    425445      DO jj = 2, jpjm1                             ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 
    426446         DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    429449      END DO 
    430450      DO jk = jpk-2, 2, -1 
     451!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    431452         DO jj = 2, jpjm1 
    432453            DO ji = fs_2, fs_jpim1    ! vector opt. 
     
    435456         END DO 
    436457      END DO 
     458!$OMP PARALLEL DO schedule(static) private(jk,jj, ji) 
    437459      DO jk = 2, jpkm1                             ! set the minimum value of tke 
    438460         DO jj = 2, jpjm1 
     
    450472       
    451473      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction) 
     474!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    452475         DO jk = 2, jpkm1 
    453476            DO jj = 2, jpjm1 
     
    459482         END DO 
    460483      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction) 
     484!$OMP PARALLEL DO schedule(static) private(jj, ji, jk) 
    461485         DO jj = 2, jpjm1 
    462486            DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    467491         END DO 
    468492      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability) 
     493!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztx2, zty2, ztau, zdif) 
    469494         DO jk = 2, jpkm1 
    470495            DO jj = 2, jpjm1 
     
    545570      ! 
    546571      ! initialisation of interior minimum value (avoid a 2d loop with mikt) 
     572!$OMP PARALLEL WORKSHARE 
    547573      zmxlm(:,:,:)  = rmxl_min     
    548574      zmxld(:,:,:)  = rmxl_min 
     575!$OMP END PARALLEL WORKSHARE 
    549576      ! 
    550577      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 
     578!$OMP PARALLEL DO schedule(static) private(jj, ji, zraug) 
    551579         DO jj = 2, jpjm1 
    552580            DO ji = fs_2, fs_jpim1 
     
    556584         END DO 
    557585      ELSE  
     586!$OMP PARALLEL WORKSHARE 
    558587         zmxlm(:,:,1) = rn_mxl0 
     588!$OMP END PARALLEL WORKSHARE 
    559589      ENDIF 
    560590      ! 
     591!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zrn2) 
    561592      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2) 
    562593         DO jj = 2, jpjm1 
     
    570601      !                     !* Physical limits for the mixing length 
    571602      ! 
     603!$OMP PARALLEL WORKSHARE 
    572604      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the minimum value  
    573605      zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value 
     606!$OMP END PARALLEL WORKSHARE 
    574607      ! 
    575608      SELECT CASE ( nn_mxl ) 
     
    578611      ! where wmask = 0 set zmxlm == e3w_n 
    579612      CASE ( 0 )           ! bounded by the distance to surface and bottom 
     613!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 
    580614         DO jk = 2, jpkm1 
    581615            DO jj = 2, jpjm1 
     
    591625         ! 
    592626      CASE ( 1 )           ! bounded by the vertical scale factor 
     627!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemxl) 
    593628         DO jk = 2, jpkm1 
    594629            DO jj = 2, jpjm1 
     
    603638      CASE ( 2 )           ! |dk[xml]| bounded by e3t : 
    604639         DO jk = 2, jpkm1         ! from the surface to the bottom : 
     640!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    605641            DO jj = 2, jpjm1 
    606642               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    610646         END DO 
    611647         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : 
     648!$OMP PARALLEL DO schedule(static) private(jj, ji, zemxl) 
    612649            DO jj = 2, jpjm1 
    613650               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    621658      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t : 
    622659         DO jk = 2, jpkm1         ! from the surface to the bottom : lup 
     660!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    623661            DO jj = 2, jpjm1 
    624662               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    628666         END DO 
    629667         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown 
     668!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    630669            DO jj = 2, jpjm1 
    631670               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    634673            END DO 
    635674         END DO 
     675!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zemlm, zemlp) 
    636676         DO jk = 2, jpkm1 
    637677            DO jj = 2, jpjm1 
     
    648688      ! 
    649689# if defined key_c1d 
     690!$OMP PARALLEL WORKSHARE 
    650691      e_dis(:,:,:) = zmxld(:,:,:)      ! c1d configuration : save mixing and dissipation turbulent length scales 
    651692      e_mix(:,:,:) = zmxlm(:,:,:) 
     693!$OMP END PARALLEL WORKSHARE 
    652694# endif 
    653695 
     
    655697      !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt) 
    656698      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     699!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zsqen, zav) 
    657700      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points 
    658701         DO jj = 2, jpjm1 
     
    668711      CALL lbc_lnk( avm, 'W', 1. )      ! Lateral boundary conditions (sign unchanged) 
    669712      ! 
     713!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    670714      DO jk = 2, jpkm1            !* vertical eddy viscosity at wu- and wv-points 
    671715         DO jj = 2, jpjm1 
     
    679723      ! 
    680724      IF( nn_pdl == 1 ) THEN      !* Prandtl number case: update avt 
     725!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    681726         DO jk = 2, jpkm1 
    682727            DO jj = 2, jpjm1 
     
    804849      ENDIF 
    805850      !                               !* set vertical eddy coef. to the background value 
     851!$OMP PARALLEL DO schedule(static) private(jk) 
    806852      DO jk = 1, jpk 
    807853         avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
     
    857903           ELSE                                     ! No TKE array found: initialisation 
    858904              IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without tke scheme, en computed by iterative loop' 
     905!$OMP PARALLEL WORKSHARE 
    859906              en (:,:,:) = rn_emin * tmask(:,:,:) 
     907!$OMP END PARALLEL WORKSHARE 
    860908              CALL tke_avn                               ! recompute avt, avm, avmu, avmv and dissl (approximation) 
    861909              ! 
     910!$OMP PARALLEL WORKSHARE 
    862911              avt_k (:,:,:) = avt (:,:,:) 
    863912              avm_k (:,:,:) = avm (:,:,:) 
    864913              avmu_k(:,:,:) = avmu(:,:,:) 
    865914              avmv_k(:,:,:) = avmv(:,:,:) 
     915!$OMP END PARALLEL WORKSHARE 
    866916              ! 
    867917              DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_tke( jit )   ;   END DO 
    868918           ENDIF 
    869919        ELSE                                   !* Start from rest 
     920!$OMP PARALLEL WORKSHARE 
    870921           en(:,:,:) = rn_emin * tmask(:,:,:) 
     922!$OMP END PARALLEL WORKSHARE 
     923!$OMP PARALLEL DO schedule(static) private(jk) 
    871924           DO jk = 1, jpk                           ! set the Kz to the background value 
    872925              avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 
  • branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/step.F90

    r6464 r6748  
    132132      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz 
    133133      IF( lk_zdfcst  ) THEN                              ! Constant Kz (reset avt, avm[uv] to the background value) 
     134!$OMP PARALLEL WORKSHARE 
    134135         avt (:,:,:) = rn_avt0 * wmask (:,:,:) 
    135136         avmu(:,:,:) = rn_avm0 * wumask(:,:,:) 
    136137         avmv(:,:,:) = rn_avm0 * wvmask(:,:,:) 
     138!$OMP END PARALLEL WORKSHARE 
    137139      ENDIF 
    138140 
    139141      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths 
     142!$OMP PARALLEL DO schedule(static) private(jk) 
    140143         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk)   ;   END DO 
    141144      ENDIF 
     
    194197               &                                          rhd, gru , grv , grui, grvi   )  ! of t, s, rd at the first ocean level 
    195198!!jc: fs simplification 
    196                              
     199!$OMP PARALLEL WORKSHARE                             
    197200                         ua(:,:,:) = 0._wp            ! set dynamics trends to zero 
    198201                         va(:,:,:) = 0._wp 
    199  
     202!$OMP END PARALLEL WORKSHARE 
    200203      IF(  lk_asminc .AND. ln_asmiau .AND. ln_dyninc )   & 
    201204               &         CALL dyn_asm_inc   ( kstp )  ! apply dynamics assimilation increment 
     
    250253      ! Active tracers                               
    251254      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     255!$OMP PARALLEL WORKSHARE 
    252256                         tsa(:,:,:,:) = 0._wp         ! set tracer trends to zero 
    253  
     257!$OMP END PARALLEL WORKSHARE 
    254258      IF(  lk_asminc .AND. ln_asmiau .AND. & 
    255259         & ln_trainc )   CALL tra_asm_inc   ( kstp )  ! apply tracer assimilation increment 
Note: See TracChangeset for help on using the changeset viewer.