Changeset 7698 for trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.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/SBC/sbcmod.F90 (modified) (6 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

@@ -84 +84 @@
       !!              - nsbc: type of sbc
       !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jn                        ! dummy loop indices
       INTEGER ::   ios, icpt                         ! local integer
       LOGICAL ::   ll_purecpl, ll_opa, ll_not_nemo   ! local logical
@@ -240 +241 @@
       IF( .NOT.ln_isf ) THEN        !* No ice-shelf in the domain : allocate and set to zero
          IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
-         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp
-         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp
+!$OMP PARALLEL
+!$OMP DO schedule(static) private(jj,ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               fwfisf  (ji,jj)   = 0.0_wp ; fwfisf_b  (ji,jj)   = 0.0_wp
+            END DO
+         END DO
+!$OMP END DO NOWAIT
+         DO jn = 1, jpts
+!$OMP DO schedule(static) private(jj,ji)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  risf_tsc(ji,jj,jn) = 0.0_wp ; risf_tsc_b(ji,jj,jn) = 0.0_wp
+               END DO
+            END DO
+         END DO
+!$OMP END PARALLEL
       END IF
       IF( nn_ice == 0 ) THEN        !* No sea-ice in the domain : ice fraction is always zero
-         IF( nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! except for OPA in SAS-OPA coupled case
-      ENDIF
-      !
-      sfx   (:,:) = 0._wp           !* salt flux due to freezing/melting
-      fmmflx(:,:) = 0._wp           !* freezing minus melting flux
-
-      taum(:,:) = 0._wp             !* wind stress module (needed in GLS in case of reduced restart)
+         IF( nn_components /= jp_iam_opa ) THEN
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  fr_i(ji,jj) = 0._wp    ! except for OPA in SAS-OPA coupled case
+               END DO
+            END DO
+         END IF
+      ENDIF
+      !
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            sfx   (ji,jj) = 0._wp           !* salt flux due to freezing/melting
+            fmmflx(ji,jj) = 0._wp           !* freezing minus melting flux
+            taum  (ji,jj) = 0._wp           !* wind stress module (needed in GLS in case of reduced restart)
+         END DO
+      END DO
 
       !                          ! Choice of the Surface Boudary Condition (set nsbc)
@@ -356 +383 @@
       !!----------------------------------------------------------------------
       INTEGER, INTENT(in) ::   kt   ! ocean time step
+      INTEGER ::   ji, jj, jn       ! dummy loop indices
       !
       LOGICAL ::   ll_sas, ll_opa   ! local logical
@@ -365 +393 @@
       IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
          !                                         ! ---------------------------------------- !
-         utau_b(:,:) = utau(:,:)                         ! Swap the ocean forcing fields
-         vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields
-         qns_b (:,:) = qns (:,:)                         !  are set at the end of the routine)
-         emp_b (:,:) = emp (:,:)
-         sfx_b (:,:) = sfx (:,:)
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               utau_b(ji,jj) = utau(ji,jj)                         ! Swap the ocean forcing fields
+               vtau_b(ji,jj) = vtau(ji,jj)                         ! (except at nit000 where before fields
+               qns_b (ji,jj) = qns (ji,jj)                         !  are set at the end of the routine)
+               emp_b (ji,jj) = emp (ji,jj)
+               sfx_b (ji,jj) = sfx (ji,jj)
+            END DO
+         END DO
          IF ( ln_rnf ) THEN
-            rnf_b    (:,:  ) = rnf    (:,:  )
-            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
+!$OMP PARALLEL
+!$OMP DO schedule(static) private(jj,ji)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  rnf_b    (ji,jj  ) = rnf    (ji,jj  )
+               END DO
+            END DO
+!$OMP END DO NOWAIT
+            DO jn = 1, jpts
+!$OMP DO schedule(static) private(jj,ji)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     rnf_tsc_b(ji,jj,jn) = rnf_tsc(ji,jj,jn)
+                  END DO
+               END DO
+            END DO
+!$OMP END PARALLEL
          ENDIF
       ENDIF
@@ -401 +449 @@
       END SELECT
       IF ( ln_wave .AND. ln_tauoc) THEN                                 ! Wave stress subctracted
-            utau(:,:) = utau(:,:)*tauoc_wave(:,:)
-            vtau(:,:) = vtau(:,:)*tauoc_wave(:,:)
-            taum(:,:) = taum(:,:)*tauoc_wave(:,:)
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               utau(ji,jj) = utau(ji,jj)*tauoc_wave(ji,jj)
+               vtau(ji,jj) = vtau(ji,jj)*tauoc_wave(ji,jj)
+               taum(ji,jj) = taum(ji,jj)*tauoc_wave(ji,jj)
+            END DO
+         END DO
       !
             SELECT CASE( nsbc )
@@ -457 +510 @@
                CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point)
             ELSE
-               sfx_b (:,:) = sfx(:,:)
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     sfx_b (ji,jj) = sfx(ji,jj)
+                  END DO
+               END DO
             ENDIF
          ELSE                                                   !* no restart: set from nit000 values
             IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000'
-            utau_b(:,:) = utau(:,:)
-            vtau_b(:,:) = vtau(:,:)
-            qns_b (:,:) = qns (:,:)
-            emp_b (:,:) = emp (:,:)
-            sfx_b (:,:) = sfx (:,:)
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  utau_b(ji,jj) = utau(ji,jj)
+                  vtau_b(ji,jj) = vtau(ji,jj)
+                  qns_b (ji,jj) = qns (ji,jj)
+                  emp_b (ji,jj) = emp(ji,jj)
+                  sfx_b (ji,jj) = sfx(ji,jj)
+               END DO
+            END DO
          ENDIF
       ENDIF