Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

Timestamp:

2017-03-03T12:46:59+01:00 (7 years ago)

Author:

mocavero

Message:

Reverting trunk to remove OpenMP

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90 (modified) (10 diffs)

trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

@@ -88 +88 @@
       CALL wrk_alloc( jpi,jpj,   z2d0, z2d1 )
       !
-!$OMP PARALLEL DO schedule(static) private(jk,jj,ji)
-      DO jk = 1, jpk
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               tsn(ji,jj,jk,1) = tsn(ji,jj,jk,1) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,1) = tsb(ji,jj,jk,1) * tmask(ji,jj,jk) 
-               tsn(ji,jj,jk,2) = tsn(ji,jj,jk,2) * tmask(ji,jj,jk) ; tsb(ji,jj,jk,2) = tsb(ji,jj,jk,2) * tmask(ji,jj,jk)
-            END DO
-         END DO
-      END DO
+      tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ;
+      tsn(:,:,:,2) = tsn(:,:,:,2) * tmask(:,:,:) ; tsb(:,:,:,2) = tsb(:,:,:,2) * tmask(:,:,:) ;
       ! ------------------------- !
       ! 1 - Trends due to forcing !
@@ -115 +108 @@
       IF( ln_linssh ) THEN
          IF( ln_isfcav ) THEN
-!$OMP PARALLEL DO schedule(static) private(jj,ji)
             DO ji=1,jpi
                DO jj=1,jpj
@@ -123 +115 @@
             END DO
          ELSE
-!$OMP PARALLEL DO schedule(static) private(jj,ji)
-            DO ji=1,jpi
-               DO jj=1,jpj
-                  z2d0(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_tem)
-                  z2d1(ji,jj) = surf(ji,jj) * wn(ji,jj,1) * tsb(ji,jj,1,jp_sal)
-               END DO
-            END DO
+            z2d0(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem)
+            z2d1(:,:) = surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal)
          END IF
          z_wn_trd_t = - glob_sum( z2d0 ) 
@@ -158 +145 @@
       IF( ln_linssh ) THEN
          IF( ln_isfcav ) THEN
-!$OMP PARALLEL DO schedule(static) private(jj,ji)
             DO ji = 1, jpi
                DO jj = 1, jpj
@@ -166 +152 @@
             END DO
          ELSE
-!$OMP PARALLEL DO schedule(static) private(jj,ji)
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  z2d0(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_tem) * sshn(ji,jj) - ssh_hc_loc_ini(ji,jj) ) 
-                  z2d1(ji,jj) = surf(ji,jj) * ( tsn(ji,jj,1,jp_sal) * sshn(ji,jj) - ssh_sc_loc_ini(ji,jj) ) 
-               END DO
-            END DO
+            z2d0(:,:) = surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) 
+            z2d1(:,:) = surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) 
          END IF
          z_ssh_hc = glob_sum_full( z2d0 ) 
@@ -294 +275 @@
           IF(lwp) WRITE(numout,*) ' dia_hsb at initial state '
           IF(lwp) WRITE(numout,*) '~~~~~~~'
-!$OMP PARALLEL
-!$OMP DO schedule(static) private(jj,ji)
-          DO jj = 1, jpj
-             DO ji = 1, jpi
-                surf_ini(ji,jj) = e1e2t(ji,jj) * tmask_i(ji,jj)         ! initial ocean surface
-                ssh_ini(ji,jj) = sshn(ji,jj)                          ! initial ssh
-             END DO
+          surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:)         ! initial ocean surface
+          ssh_ini(:,:) = sshn(:,:)                          ! initial ssh
+          DO jk = 1, jpk
+             ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
+             e3t_ini   (:,:,jk) = e3t_n(:,:,jk)                      * tmask(:,:,jk)  ! initial vertical scale factors
+             hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial heat content
+             sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * e3t_n(:,:,jk) * tmask(:,:,jk)  ! initial salt content
           END DO
-!$OMP DO schedule(static) private(jk,jj,ji)
-          DO jk = 1, jpk
-             DO jj = 1, jpj
-                DO ji = 1, jpi
-                   ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance).
-                   e3t_ini   (ji,jj,jk) = e3t_n(ji,jj,jk)                      * tmask(ji,jj,jk)  ! initial vertical scale factors
-                   hc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! initial heat content
-                   sc_loc_ini(ji,jj,jk) = tsn(ji,jj,jk,jp_sal) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)  ! initial salt content
-                END DO
-             END DO
-          END DO
-!$OMP END PARALLEL
           frc_v = 0._wp                                           ! volume       trend due to forcing
           frc_t = 0._wp                                           ! heat content   -    -   -    -   
@@ -319 +288 @@
           IF( ln_linssh ) THEN
              IF ( ln_isfcav ) THEN
-!$OMP PARALLEL DO schedule(static) private(jj,ji)
                 DO ji=1,jpi
                    DO jj=1,jpj
@@ -327 +295 @@
                 ENDDO
              ELSE
-!$OMP PARALLEL DO schedule(static) private(jj,ji)
-                DO jj = 1, jpj
-                   DO ji = 1, jpi
-                      ssh_hc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_tem) * sshn(ji,jj)   ! initial heat content in ssh
-                      ssh_sc_loc_ini(ji,jj) = tsn(ji,jj,1,jp_sal) * sshn(ji,jj)   ! initial salt content in ssh
-                   ENDDO
-                ENDDO
+                ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * sshn(:,:)   ! initial heat content in ssh
+                ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * sshn(:,:)   ! initial salt content in ssh
              END IF
              frc_wn_t = 0._wp                                       ! initial heat content misfit due to free surface
@@ -382 +345 @@
       INTEGER ::   ierror   ! local integer
       INTEGER ::   ios
-      INTEGER ::   ji, jj, jk   ! dummy loop indices
       !!
       NAMELIST/namhsb/ ln_diahsb
@@ -422 +384 @@
       ! 2 - Time independant variables and file opening !
       ! ----------------------------------------------- !
-!$OMP PARALLEL DO schedule(static) private(jj,ji)
-      DO jj = 1, jpj
-         DO ji = 1, jpi
-            surf(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)      ! masked surface grid cell area
-         END DO
-      END DO
+      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:)      ! masked surface grid cell area
       surf_tot  = glob_sum( surf(:,:) )                   ! total ocean surface area