New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 6508 for branches/2016/dev_v3_6_STABLE_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90 – NEMO

Ignore:
Timestamp:
2016-05-04T16:23:46+02:00 (8 years ago)
Author:
dkuts
Message:

First version of OMP changes, partly ported from previous branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_v3_6_STABLE_OMP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r6204 r6508  
    103103      IF( l_trd )  THEN 
    104104         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    105          ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0 
     105!$OMP PARALLEL WORKSHARE 
     106         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0  
     107!$OMP END PARALLEL WORKSHARE 
    106108      ENDIF 
    107109      ! 
    108       zwi(:,:,:) = 0.e0 ;  
     110!$OMP PARALLEL WORKSHARE 
     111      zwi(:,:,:) = 0.e0 ; 
     112!$OMP END PARALLEL WORKSHARE  
    109113      ! 
    110114      !                                                          ! =========== 
     
    120124         ! -------------------------------------------------------------------- 
    121125         ! upstream tracer flux in the i and j direction 
     126!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui, zfm_ui)         
    122127         DO jk = 1, jpkm1 
    123128            DO jj = 1, jpjm1 
     
    136141         ! upstream tracer flux in the k direction 
    137142         ! Interior value 
     143    !$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk) 
    138144         DO jk = 2, jpkm1 
    139145            DO jj = 1, jpj 
     
    169175 
    170176         ! total advective trend 
     177!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbtr, ztra) 
    171178         DO jk = 1, jpkm1 
    172179            z2dtt = p2dt(jk) 
     
    201208         ! -------------------------------------------------- 
    202209         ! antidiffusive flux on i and j 
     210!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    203211         DO jk = 1, jpkm1 
    204212            DO jj = 1, jpjm1 
     
    212220         ! antidiffusive flux on k 
    213221         ! Interior value 
     222!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    214223         DO jk = 2, jpkm1                     
    215224            DO jj = 1, jpj 
     
    227236            END DO 
    228237         ELSE 
     238!$OMP PARALLEL WORKSHARE 
    229239            zwz(:,:,1) = 0.e0 
     240!$OMP END PARALLEL WORKSHARE 
    230241         END IF 
    231242         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions 
     
    239250         ! 5. final trend with corrected fluxes 
    240251         ! ------------------------------------ 
     252!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbtr, ztra) 
    241253         DO jk = 1, jpkm1 
    242254            DO jj = 2, jpjm1 
     
    339351      IF( l_trd )  THEN 
    340352         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     353!$OMP PARALLEL WORKSHARE 
    341354         ztrdx(:,:,:) = 0._wp  ;    ztrdy(:,:,:) = 0._wp  ;   ztrdz(:,:,:) = 0._wp 
     355!$OMP END PARALLEL WORKSHARE 
    342356      ENDIF 
    343357      ! 
     358!$OMP PARALLEL WORKSHARE       
    344359      zwi(:,:,:) = 0._wp 
     360!$OMP END PARALLEL WORKSHARE       
    345361      z_rzts = 1._wp / REAL( jnzts, wp ) 
    346362      zr_p2dt(:) = 1._wp / p2dt(:) 
     
    351367         ! 1. Bottom value : flux set to zero 
    352368         ! ---------------------------------- 
     369!$OMP PARALLEL WORKSHARE 
    353370         zwx(:,:,jpk) = 0._wp   ;    zwz(:,:,jpk) = 0._wp 
    354371         zwy(:,:,jpk) = 0._wp   ;    zwi(:,:,jpk) = 0._wp 
    355  
     372!$OMP END PARALLEL WORKSHARE 
    356373         ! 2. upstream advection with initial mass fluxes & intermediate update 
    357374         ! -------------------------------------------------------------------- 
    358375         ! upstream tracer flux in the i and j direction 
     376!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_vj, zfm_vj, zfp_ui, zfm_ui) 
    359377         DO jk = 1, jpkm1 
    360378            DO jj = 1, jpjm1 
     
    373391         ! upstream tracer flux in the k direction 
    374392         ! Interior value 
     393!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zfp_wk, zfm_wk) 
    375394         DO jk = 2, jpkm1 
    376395            DO jj = 1, jpj 
     
    385404         IF( lk_vvl ) THEN 
    386405            IF ( ln_isfcav ) THEN 
     406!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    387407               DO jj = 1, jpj 
    388408                  DO ji = 1, jpi 
     
    391411               END DO 
    392412            ELSE 
     413!$OMP PARALLEL WORKSHARE 
    393414               zwz(:,:,1) = 0.e0                              ! volume variable + no isf 
     415!$OMP END PARALLEL WORKSHARE 
    394416            END IF 
    395417         ELSE 
    396418            IF ( ln_isfcav ) THEN 
     419!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    397420               DO jj = 1, jpj 
    398421                  DO ji = 1, jpi 
     
    401424               END DO 
    402425            ELSE 
     426!$OMP PARALLEL WORKSHARE 
    403427               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)                                               ! linear free surface + no isf 
     428!$OMP END PARALLEL WORKSHARE 
    404429            END IF 
    405430         ENDIF 
    406431 
    407432         ! total advective trend 
     433!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbtr, ztra) 
    408434         DO jk = 1, jpkm1 
    409435            z2dtt = p2dt(jk) 
     
    427453         IF( l_trd )  THEN  
    428454            ! store intermediate advective trends 
     455!$OMP PARALLEL WORKSHARE 
    429456            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
     457!$OMP END PARALLEL WORKSHARE 
    430458         END IF 
    431459         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     
    439467         ! antidiffusive flux on i and j 
    440468 
    441  
     469!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    442470         DO jk = 1, jpkm1 
    443471 
     
    451479               END DO 
    452480            END DO 
    453  
     481!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    454482            DO jj = 2, jpjm1         ! partial horizontal divergence 
    455483               DO ji = fs_2, fs_jpim1 
     
    458486               END DO 
    459487            END DO 
    460  
     488!$OMP PARALLEL DO schedule(static) private(jj, ji) 
    461489            DO jj = 1, jpjm1 
    462490               DO ji = 1, fs_jpim1   ! vector opt. 
     
    468496       
    469497         ! antidiffusive flux on k 
     498!$OMP PARALLEL WORKSHARE 
    470499         zwz(:,:,1) = 0._wp        ! Surface value 
    471500         zwz_sav(:,:,:) = zwz(:,:,:) 
     
    473502         ztrs(:,:,:,1) = ptb(:,:,:,jn) 
    474503         zwzts(:,:,:) = 0._wp 
    475  
     504!$OMP END PARALLEL WORKSHARE 
    476505         DO jl = 1, jnzts                   ! Start of sub timestepping loop 
    477506 
     
    490519              jta = MOD(jta,3) + 1 
    491520            ENDIF 
     521!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    492522            DO jk = 2, jpkm1          ! Interior value 
    493523               DO jj = 2, jpjm1 
     
    500530 
    501531            jtaken = MOD( jtaken + 1 , 2 ) 
    502  
     532!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbtr, ztra) 
    503533            DO jk = 2, jpkm1          ! Interior value 
    504534               DO jj = 2, jpjm1 
     
    513543 
    514544         END DO 
    515  
     545!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
    516546         DO jk = 2, jpkm1          ! Anti-diffusive vertical flux using average flux from the sub-timestepping 
    517547            DO jj = 2, jpjm1 
     
    531561         ! 5. final trend with corrected fluxes 
    532562         ! ------------------------------------ 
     563!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zbtr, ztra) 
    533564         DO jk = 1, jpkm1 
    534565            DO jj = 2, jpjm1 
     
    547578         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    548579         IF( l_trd )  THEN  
     580!$OMP PARALLEL WORKSHARE 
    549581            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    550582            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    551583            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    552              
     584!$OMP END PARALLEL WORKSHARE         
    553585            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    554586            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
     
    602634      zbig  = 1.e+40_wp 
    603635      zrtrn = 1.e-15_wp 
     636!$OMP PARALLEL WORKSHARE 
    604637      zbetup(:,:,:) = 0._wp   ;   zbetdo(:,:,:) = 0._wp 
    605  
     638!$OMP END PARALLEL WORKSHARE 
    606639      ! Search local extrema 
    607640      ! -------------------- 
    608641      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land 
    609       zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   & 
    610          &        paft * tmask - zbig * ( 1._wp - tmask )  ) 
    611       zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   & 
    612          &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
    613  
     642      !zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ),   & 
     643      !  &        paft * tmask - zbig * ( 1._wp - tmask )  ) 
     644      !zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ),   & 
     645      !  &        paft * tmask + zbig * ( 1._wp - tmask )  ) 
     646!$OMP PARALLEL DO schedule(static) private(jk, jj, ji) 
     647      DO jk = 1, jpk   
     648        DO jj = 1, jpj 
     649!DIR$ IVDEP            
     650    DO ji = 1, jpi 
     651      zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ), &  
     652      &                     paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ) )   
     653           zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ), &  
     654      &                     paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ) )   
     655    END DO 
     656   END DO 
     657      END DO 
     658 
     659 
     660!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, zpos, zneg, zbt, ikm1, z2dtt, zup, zdo) 
    614661      DO jk = 1, jpkm1 
    615662         ikm1 = MAX(jk-1,1) 
     
    651698      ! 3. monotonic flux in the i & j direction (paa & pbb) 
    652699      ! ---------------------------------------- 
     700!$OMP PARALLEL DO schedule(static) private(jk, jj, ji, za, zb, zc, zav, zbv, zcv, zau, zbu, zcu) 
    653701      DO jk = 1, jpkm1 
    654702         DO jj = 2, jpjm1 
Note: See TracChangeset for help on using the changeset viewer.