Changeset 9176 for branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

Timestamp:

2018-01-04T13:30:03+01:00 (6 years ago)

Author:

andmirek

Message:

#2001: OMP directives

File:

• branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90 (modified) (6 diffs)

branches/UKMO/dev_r5518_GO6_package_OMP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

@@ -77 +77 @@
       INTEGER  ::   ji, jj, jk                  ! dummy loop indices
       REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar
-      REAL(wp), POINTER, DIMENSION(:,:  ) :: zcu, zcv
+      REAL(wp),      DIMENSION(jpi,jpj  ) :: zcu, zcv
       REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv
       !!----------------------------------------------------------------------
@@ -83 +83 @@
       IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilap')
       !
-      CALL wrk_alloc( jpi, jpj,      zcu, zcv           )
+!     CALL wrk_alloc( jpi, jpj,      zcu, zcv           )
       CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 
       !
@@ -102 +102 @@
       zlv(:,:,:) = 0._wp
 
-      !                                                ! ===============
-      DO jk = 1, jpkm1                                 ! Horizontal slab
-         !                                             ! ===============
+         !
          ! Laplacian
          ! ---------
 
          IF( ln_sco .OR. ln_zps ) THEN   ! s-coordinate or z-coordinate with partial steps
-            zuf(:,:,jk) = rotb(:,:,jk) * fse3f(:,:,jk)
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
-                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj)
-   
-                  zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
-                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj)
-               END DO
+!$OMP PARALLEL DO
+            !                                                ! ===============
+            DO jk = 1, jpkm1                                 ! Horizontal slab
+               !                                             ! ===============
+               ! Laplacian
+               ! ---------
+                  zuf(:,:,jk) = rotb(:,:,jk) * fse3f(:,:,jk)
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                           &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj)
+   
+                        zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                           &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj)
+                     END DO
+                  END DO
             END DO
          ELSE                            ! z-coordinate - full step
-            DO jj = 2, jpjm1
-               DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   &
-                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj)
-   
-                  zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   &
-                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj)
+!$OMP PARALLEL DO
+           !                                                ! ===============
+            DO jk = 1, jpkm1                                 ! Horizontal slab
+               !                                             ! ===============
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   &
+                        &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj)
+   
+                     zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   &
+                        &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj)
+                  END DO  
                END DO  
-            END DO  
+            END DO
          ENDIF
-      END DO
       CALL lbc_lnk( zlu, 'U', -1. )   ;   CALL lbc_lnk( zlv, 'V', -1. )   ! Boundary conditions
-
-         
+!$OMP PARALLE DO PRIVATE(zcu, zcv, zbt)
       DO jk = 1, jpkm1
    
@@ -145 +153 @@
          
          ! Contravariant "laplacian"
-         zcu(:,:) = e1u(:,:) * zlu(:,:,jk)
-         zcv(:,:) = e2v(:,:) * zlv(:,:,jk)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcu(ji,jj) = e1u(ji,jj) * zlu(ji,jj,jk)
+               zcv(ji,jj) = e2v(ji,jj) * zlv(ji,jj,jk)
+            END DO
+         END DO
          
          ! Laplacian curl ( * e3f if s-coordinates or z-coordinate with partial steps)
@@ -180 +192 @@
       CALL lbc_lnk( zuf, 'F', 1. )
       CALL lbc_lnk( zut, 'T', 1. )
-
+!OMP PARALLEL DO PRIVATE(ze2u, ze2v, zua, zva)
       DO jk = 1, jpkm1      
    
@@ -205 +217 @@
       END DO                                           !   End of slab
       !                                                ! ===============
-      CALL wrk_dealloc( jpi, jpj,      zcu, zcv           )
+!     CALL wrk_dealloc( jpi, jpj,      zcu, zcv           )
       CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 
       !