Changeset 6748 for branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

Timestamp:

2016-06-28T11:53:56+02:00 (8 years ago)

Author:

mocavero

Message:

GYRE hybrid parallelization

File:

• branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90 (modified) (17 diffs)

branches/2016/dev_r6519_HPC_4/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90

@@ -98 +98 @@
       IF( l_trd )  THEN
          CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+!$OMP PARALLEL WORKSHARE
          ztrdx(:,:,:) = 0._wp   ;    ztrdy(:,:,:) = 0._wp   ;   ztrdz(:,:,:) = 0._wp
+!$OMP END PARALLEL WORKSHARE
       ENDIF
       !
       !                          ! surface & bottom value : flux set to zero one for all
+!$OMP PARALLEL WORKSHARE
       zwz(:,:, 1 ) = 0._wp            
       zwx(:,:,jpk) = 0._wp   ;   zwy(:,:,jpk) = 0._wp    ;    zwz(:,:,jpk) = 0._wp
       !
       zwi(:,:,:) = 0._wp        
+!$OMP END PARALLEL WORKSHARE
       !
       DO jn = 1, kjpt            !==  loop over the tracers  ==!
@@ -111 +115 @@
          !        !==  upstream advection with initial mass fluxes & intermediate update  ==!
          !                    !* upstream tracer flux in the i and j direction 
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui,zfm_ui)
          DO jk = 1, jpkm1
             DO jj = 1, jpjm1
@@ -125 +130 @@
          END DO
          !                    !* upstream tracer flux in the k direction *!
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk)
          DO jk = 2, jpkm1        ! Interior value ( multiplied by wmask)
             DO jj = 1, jpj
@@ -146 +152 @@
          ENDIF
          !               
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ztra)
          DO jk = 1, jpkm1     !* trend and after field with monotonic scheme
             DO jj = 2, jpjm1
@@ -163 +170 @@
          !                
          IF( l_trd )  THEN             ! trend diagnostics (contribution of upstream fluxes)
+!$OMP PARALLEL WORKSHARE
             ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+!$OMP END PARALLEL WORKSHARE
          END IF
          !                             ! "Poleward" heat and salt transports (contribution of upstream fluxes)
@@ -176 +185 @@
          !
          CASE(  2  )                   !- 2nd order centered
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji)
             DO jk = 1, jpkm1
                DO jj = 1, jpjm1
@@ -186 +196 @@
             !
          CASE(  4  )                   !- 4th order centered
+!$OMP PARALLEL WORKSHARE
             zltu(:,:,jpk) = 0._wp            ! Bottom value : flux set to zero
             zltv(:,:,jpk) = 0._wp
+!$OMP END PARALLEL WORKSHARE
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji)
             DO jk = 1, jpkm1                 ! Laplacian
                DO jj = 1, jpjm1                    ! 1st derivative (gradient)
@@ -204 +217 @@
             CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
             !
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v)
             DO jk = 1, jpkm1                 ! Horizontal advective fluxes
                DO jj = 1, jpjm1
@@ -217 +231 @@
             !
          CASE(  41 )                   !- 4th order centered       ==>>   !!gm coding attempt   need to be tested
+!$OMP PARALLEL WORKSHARE
             ztu(:,:,jpk) = 0._wp             ! Bottom value : flux set to zero
             ztv(:,:,jpk) = 0._wp
+!$OMP END PARALLEL WORKSHARE
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji)
             DO jk = 1, jpkm1                 ! 1st derivative (gradient)
                DO jj = 1, jpjm1
@@ -229 +246 @@
             CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
             !
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zC2t_u, zC2t_v, zC4t_u, zC4t_v)
             DO jk = 1, jpkm1                 ! Horizontal advective fluxes
                DO jj = 2, jpjm1
@@ -249 +267 @@
          !
          CASE(  2  )                   !- 2nd order centered
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji)
             DO jk = 2, jpkm1    
                DO jj = 2, jpjm1
@@ -260 +279 @@
          CASE(  4  )                   !- 4th order COMPACT
             CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji)
             DO jk = 2, jpkm1
                DO jj = 2, jpjm1
@@ -282 +302 @@
          !        !==  final trend with corrected fluxes  ==!
          !
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji)
          DO jk = 1, jpkm1
             DO jj = 2, jpjm1
@@ -294 +315 @@
          !
          IF( l_trd ) THEN     ! trend diagnostics (contribution of upstream fluxes)
+!$OMP PARALLEL WORKSHARE
             ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
             ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
             ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+!$OMP END PARALLEL WORKSHARE
             !
             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )
@@ -626 +649 @@
       zbig  = 1.e+40_wp
       zrtrn = 1.e-15_wp
+!$OMP PARALLEL WORKSHARE
       zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp
+!$OMP END PARALLEL WORKSHARE
 
       ! Search local extrema
@@ -636 +661 @@
          &        paft * tmask + zbig * ( 1._wp - tmask )  )
 
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, ikm1, zup, zdo, zpos, zneg, zbt)
       DO jk = 1, jpkm1
          ikm1 = MAX(jk-1,1)
@@ -674 +700 @@
       ! 3. monotonic flux in the i & j direction (paa & pbb)
       ! ----------------------------------------
+!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu)
       DO jk = 1, jpkm1
          DO jj = 2, jpjm1