Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

Timestamp:

2017-02-18T10:02:03+01:00 (7 years ago)

Author:

mocavero

Message:

update trunk with OpenMP parallelization

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90 (modified) (5 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

@@ -59 +59 @@
       !! ** Purpose :   Initialization of the dynamics and tracer fields.
       !!----------------------------------------------------------------------
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices
       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace
       !!----------------------------------------------------------------------
@@ -75 +75 @@
 !      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data
 !!gm
-
-      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk
-      rn2b (:,:,:  ) = 0._wp   ;   rn2  (:,:,:  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
-      tsa  (:,:,:,:) = 0._wp                                   ! set one for all to 0 at level jpk
-      rab_b(:,:,:,:) = 0._wp   ;   rab_n(:,:,:,:) = 0._wp      ! set one for all to 0 at level jpk
+!$OMP PARALLEL
+      DO jn = 1, jpts
+!$OMP DO schedule(static) private(jk, jj, ji)
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  tsa  (ji,jj,jk,jn) = 0._wp                                       ! set one for all to 0 at level jpk
+                  rab_b(ji,jj,jk,jn) = 0._wp   ;   rab_n(ji,jj,jk,jn) = 0._wp      ! set one for all to 0 at level jpk
+               END DO
+            END DO
+         END DO
+      END DO
+!$OMP DO schedule(static) private(jk, jj, ji)
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               rhd  (ji,jj,jk  ) = 0._wp   ;   rhop (ji,jj,jk  ) = 0._wp      ! set one for all to 0 at level jpk
+               rn2b (ji,jj,jk  ) = 0._wp   ;   rn2  (ji,jj,jk  ) = 0._wp      ! set one for all to 0 at levels 1 and jpk
+            END DO
+         END DO
+      END DO
+!$OMP END PARALLEL
 
       IF( ln_rstart ) THEN                    ! Restart from a file
@@ -97 +114 @@
             CALL dta_tsd( nit000, tsb )       ! read 3D T and S data at nit000
             !
-            sshb(:,:)   = 0._wp               ! set the ocean at rest
-            ub  (:,:,:) = 0._wp
-            vb  (:,:,:) = 0._wp  
+!$OMP PARALLEL
+!$OMP DO schedule(static) private(jj, ji)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  sshb (ji,jj)   = 0._wp      ! set the ocean at rest
+               END DO
+            END DO
+!$OMP END DO NOWAIT
+!$OMP DO schedule(static) private(jk, jj, ji)
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ub  (ji,jj,jk) = 0._wp
+                     vb  (ji,jj,jk) = 0._wp  
+                  END DO
+               END DO
+            END DO
+!$OMP END PARALLEL
             !
          ELSE                                 ! user defined initial T and S
             CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )         
          ENDIF
-         tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones
-         sshn (:,:)     = sshb(:,:)   
-         un   (:,:,:)   = ub  (:,:,:)
-         vn   (:,:,:)   = vb  (:,:,:)
-         hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level
+!$OMP PARALLEL
+         DO jn = 1, jpts
+!$OMP DO schedule(static) private(jk, jj, ji)
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     tsn  (ji,jj,jk,jn) = tsb (ji,jj,jk,jn)       ! set now values from to before ones
+                  END DO
+               END DO
+            END DO
+         END DO
+!$OMP DO schedule(static) private(jk, jj, ji)
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  un   (ji,jj,jk)   = ub  (ji,jj,jk)
+                  vn   (ji,jj,jk)   = vb  (ji,jj,jk)
+               END DO
+            END DO
+         END DO
+!$OMP DO schedule(static) private(jj, ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               sshn (ji,jj)     = sshb(ji,jj)   
+               hdivn(ji,jj,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level
+            END DO
+         END DO
+!$OMP END PARALLEL
          CALL div_hor( 0 )                    ! compute interior hdivn value  
 !!gm                                    hdivn(:,:,:) = 0._wp
@@ -142 +197 @@
       ! Do it whatever the free surface method, these arrays being eventually used
       !
-      un_b(:,:) = 0._wp   ;   vn_b(:,:) = 0._wp
-      ub_b(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
+!$OMP PARALLEL
+!$OMP DO schedule(static) private(jj, ji)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            un_b(ji,jj) = 0._wp   ;   vn_b(ji,jj) = 0._wp
+            ub_b(ji,jj) = 0._wp   ;   vb_b(ji,jj) = 0._wp
+         END DO
+      END DO
       !
 !!gm  the use of umsak & vmask is not necessary below as un, vn, ub, vb are always masked
       DO jk = 1, jpkm1
+!$OMP DO schedule(static) private(jj, ji)
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -158 +220 @@
       END DO
       !
-      un_b(:,:) = un_b(:,:) * r1_hu_n(:,:)
-      vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:)
-      !
-      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
-      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
+!$OMP DO schedule(static) private(jj, ji)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            un_b(ji,jj) = un_b(ji,jj) * r1_hu_n(ji,jj)
+            vn_b(ji,jj) = vn_b(ji,jj) * r1_hv_n(ji,jj)
+            !
+            ub_b(ji,jj) = ub_b(ji,jj) * r1_hu_b(ji,jj)
+            vb_b(ji,jj) = vb_b(ji,jj) * r1_hv_b(ji,jj)
+         END DO
+      END DO
+!$OMP END PARALLEL
       !
       IF( nn_timing == 1 )   CALL timing_stop('istate_init')