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

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

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

update trunk with OpenMP parallelization

File:
1 edited

Legend:

Unmodified
Added
Removed

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

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