Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.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/diaptr.F90 (modified) (3 diffs)

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

@@ -66 +66 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id$
+   !! $Id$ 
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -384 +384 @@
       !! ** Purpose :   Initialization, namelist read
       !!----------------------------------------------------------------------
-      INTEGER ::  jn, jj, ji   ! local integers
+      INTEGER ::  jn           ! local integers
       INTEGER ::  inum, ierr   ! local integers
       INTEGER ::  ios          ! Local integer output status for namelist read
@@ -434 +434 @@
             CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin
             CALL iom_close( inum )
-!$OMP PARALLEL DO schedule(static) private(jj,ji)
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  btmsk(ji,jj,5) = MAX ( btmsk(ji,jj,3), btmsk(ji,jj,4) )          ! Indo-Pacific basin
-                  IF( gphit(ji,jj) < -30._wp) THEN   ;   btm30(ji,jj) = 0._wp      ! mask out Southern Ocean
-                  ELSE                               ;   btm30(ji,jj) = ssmask(ji,jj)
-                  END IF
-               END DO
-            END DO
+            btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin
+            WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean
+            ELSE WHERE                     ;   btm30(:,:) = ssmask(:,:)
+            END WHERE
          ENDIF
    
-!$OMP PARALLEL
-!$OMP DO schedule(static) private(jj,ji)
-         DO jj = 1, jpj
-           DO ji = 1, jpi
-              btmsk(ji,jj,1) = tmask_i(ji,jj)                          ! global ocean
-           END DO
-         END DO
+         btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean
       
          DO jn = 1, nptr
-!$OMP DO schedule(static) private(jj,ji)
-            DO jj = 1, jpj
-               DO ji = 1, jpi
-                  btmsk(ji,jj,jn) = btmsk(ji,jj,jn) * tmask_i(ji,jj)               ! interior domain only
-               END DO
-            END DO
+            btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only
          END DO
 
          ! Initialise arrays to zero because diatpr is called before they are first calculated
          ! Note that this means diagnostics will not be exactly correct when model run is restarted.
-!$OMP DO schedule(static) private(jj,ji)
-         DO jj = 1, jpj
-            DO ji = 1, jpi
-               htr_adv(ji,jj) = 0._wp  ;  str_adv(ji,jj) =  0._wp 
-               htr_ldf(ji,jj) = 0._wp  ;  str_ldf(ji,jj) =  0._wp 
-               htr_eiv(ji,jj) = 0._wp  ;  str_eiv(ji,jj) =  0._wp 
-               htr_ove(ji,jj) = 0._wp  ;   str_ove(ji,jj) =  0._wp
-               htr_btr(ji,jj) = 0._wp  ;   str_btr(ji,jj) =  0._wp
-             END DO
-         END DO
-              !
-!$OMP END PARALLEL
+         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp 
+         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp 
+         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp 
+         htr_ove(:,:) = 0._wp  ;   str_ove(:,:) =  0._wp
+         htr_btr(:,:) = 0._wp  ;   str_btr(:,:) =  0._wp
+         !
       ENDIF 
       !