Changeset 7698 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

Timestamp:

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

Author:

mocavero

Message:

update trunk with OpenMP parallelization

File:

• trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90 (modified) (11 diffs)

trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

@@ -78 +78 @@
 
       ! Initialisation of temprary arrys
-      zdepprod(:,:,:) = 1._wp
-      ztempbac(:,:)   = 0._wp
-      zfacsib(:,:,:)  = xsilab / ( 1.0 - xsilab )
-      zfacsi(:,:,:)   = xsilab
+!$OMP PARALLEL
+!$OMP DO schedule(static) private(jk,jj,ji)
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zdepprod(ji,jj,jk) = 1._wp
+               zfacsib(ji,jj,jk)  = xsilab / ( 1.0 - xsilab )
+               zfacsi(ji,jj,jk)   = xsilab
+            END DO
+         END DO
+      END DO
+!$OMP DO schedule(static) private(jj,ji)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ztempbac(ji,jj)   = 0._wp
+         END DO
+      END DO
 
       ! Computation of the mean phytoplankton concentration as
@@ -89 +102 @@
       ! -------------------------------------------------------
       DO jk = 1, jpkm1
+!$OMP DO schedule(static) private(jj,ji,zdep,zdepmin)
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -105 +119 @@
 
       IF( ln_p4z ) THEN
+!$OMP DO schedule(static) private(jk,jj,ji,zremik,zolimit)
          DO jk = 1, jpkm1
             DO jj = 1, jpj
@@ -136 +151 @@
          END DO
       ELSE
+!$OMP DO schedule(static) private(jk,jj,ji,zremik,zremikc,zremikn,zremikp,zolimit,zolimic,zolimin,zolimip,zdenitrn,zdenitrp)
          DO jk = 1, jpkm1
             DO jj = 1, jpj
@@ -181 +197 @@
 
 
+!$OMP DO schedule(static) private(jk,jj,ji,zonitr,zdenitnh4)
       DO jk = 1, jpkm1
          DO jj = 1, jpj
@@ -199 +216 @@
          END DO
       END DO
-
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('rem1')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
-       ENDIF
-
+!$OMP END PARALLEL
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+        WRITE(charout, FMT="('rem1')")
+        CALL prt_ctl_trc_info(charout)
+        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+
+!$OMP PARALLEL DO schedule(static) private(jk,jj,ji,zbactfer)
       DO jk = 1, jpkm1
          DO jj = 1, jpj
@@ -224 +243 @@
       END DO
 
-       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
-         WRITE(charout, FMT="('rem2')")
-         CALL prt_ctl_trc_info(charout)
-         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
-       ENDIF
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+        WRITE(charout, FMT="('rem2')")
+        CALL prt_ctl_trc_info(charout)
+        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
 
       ! Initialization of the array which contains the labile fraction
@@ -235 +254 @@
 
       DO jk = 1, jpkm1
+!$OMP PARALLEL DO schedule(static) private(jj,ji,zdep,zsatur,zsatur2,znusil,zsiremin,zosil)
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -264 +284 @@
          CALL prt_ctl_trc_info(charout)
          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
-       ENDIF
+      ENDIF
 
       IF( knt == nrdttrc ) THEN
-          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
-          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
-          !
-          IF( iom_use( "REMIN" ) )  THEN
-              zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact !  Remineralisation rate
-              CALL iom_put( "REMIN"  , zw3d )
-          ENDIF
-          IF( iom_use( "DENIT" ) )  THEN
-              zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification
-              CALL iom_put( "DENIT"  , zw3d )
-          ENDIF
-          !
-          CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
-       ENDIF
+         CALL wrk_alloc( jpi, jpj, jpk, zw3d )
+         zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
+         !
+         IF( iom_use( "REMIN" ) )  THEN
+!$OMP PARALLEL DO schedule(static) private(jk,jj,ji)
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zw3d(ji,jj,jk) = zolimi(ji,jj,jk) * tmask(ji,jj,jk) * zfact !  Remineralisation rate
+                  END DO
+               END DO
+            END DO
+            CALL iom_put( "REMIN"  , zw3d )
+         ENDIF
+         IF( iom_use( "DENIT" ) )  THEN
+!$OMP PARALLEL DO schedule(static) private(jk,jj,ji)
+            DO jk = 1, jpk
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zw3d(ji,jj,jk) = denitr(ji,jj,jk) * rdenit * rno3 * tmask(ji,jj,jk) * zfact ! Denitrification
+                  END DO
+               END DO
+            END DO
+            CALL iom_put( "DENIT"  , zw3d )
+         ENDIF
+         !
+         CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
+      ENDIF
       !
       CALL wrk_dealloc( jpi, jpj,      ztempbac                  )
@@ -305 +339 @@
          &                xremikc, xremikn, xremikp
       INTEGER :: ios                 ! Local integer output status for namelist read
+      INTEGER :: ji, jj, jk
 
       REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization
@@ -334 +369 @@
       ENDIF
       !
-      denitr  (:,:,:) = 0._wp
+!$OMP PARALLEL DO schedule(static) private(jk,jj,ji)
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               denitr  (ji,jj,jk) = 0._wp
+            END DO
+         END DO
+      END DO
       !
    END SUBROUTINE p4z_rem_init