Changeset 7698 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

Timestamp:

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

Author:

mocavero

Message:

update trunk with OpenMP parallelization

File:

• trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 (modified) (10 diffs)

trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

@@ -110 +110 @@
       !---------------------------------------------!
       IF( ln_limdyn ) THEN
-         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)
-         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
+!$OMP PARALLEL
+!$OMP DO schedule(static) private(jj,ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zu_io(ji,jj) = u_ice(ji,jj) - ssu_m(ji,jj)
+               zv_io(ji,jj) = v_ice(ji,jj) - ssv_m(ji,jj)
+            END DO
+         END DO
+!$OMP DO schedule(static) private(jj,ji)
          DO jj = 2, jpjm1 
             DO ji = fs_2, fs_jpim1
@@ -119 +126 @@
             END DO
          END DO
+!$OMP END PARALLEL
       ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
          DO jj = 2, jpjm1
             DO ji = fs_2, fs_jpim1
@@ -133 +142 @@
       ! Initialization and units change
       !----------------------------------!
-      ftr_ice(:,:,:) = 0._wp  ! part of solar radiation transmitted through the ice
+!$OMP PARALLEL
+      DO jl = 1, jpl
+!$OMP DO schedule(static) private(jj,ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ftr_ice(ji,jj,jl) = 0._wp  ! part of solar radiation transmitted through the ice
+            END DO
+         END DO
+      END DO
 
       ! Change the units of heat content; from J/m2 to J/m3
       DO jl = 1, jpl
          DO jk = 1, nlay_i
+!$OMP DO schedule(static) private(jj,ji,rswitch)
             DO jj = 1, jpj
                DO ji = 1, jpi
@@ -147 +165 @@
          END DO
          DO jk = 1, nlay_s
+!$OMP DO schedule(static) private(jj,ji,rswitch)
             DO jj = 1, jpj
                DO ji = 1, jpi
@@ -160 +179 @@
       ! Partial computation of forcing for the thermodynamic sea ice model
       !--------------------------------------------------------------------!
+!$OMP DO schedule(static) private(jj,ji,rswitch,zqld,zqfr,zfric_u)
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -201 +221 @@
          END DO
       END DO
+!$OMP END PARALLEL
       
       ! In case we bypass open-water ice formation
-      IF( .NOT. ln_limdO )  qlead(:,:) = 0._wp
+      IF( .NOT. ln_limdO ) THEN
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               qlead(ji,jj) = 0._wp
+            END DO
+         END DO
+      END IF
       ! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere
-      IF( .NOT. ln_limdH )  hfx_in(:,:) = pfrld(:,:) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
-      IF( .NOT. ln_limdH )  fhtur (:,:) = 0._wp  ;  fhld  (:,:) = 0._wp
+      IF( .NOT. ln_limdH ) THEN
+!$OMP PARALLEL DO schedule(static) private(jj,ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               hfx_in(ji,jj) = pfrld(ji,jj) * ( qns_oce(ji,jj) + qsr_oce(ji,jj) ) + qemp_oce(ji,jj)
+               fhtur (ji,jj) = 0._wp
+            END DO
+         END DO
+      END IF
+!$OMP PARALLEL
+!$OMP DO schedule(static) private(jj,ji)
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            fhld (ji,jj) = 0._wp
+         END DO
+      END DO
 
       ! ---------------------------------------------------------------------
@@ -214 +256 @@
       !     Second step in limthd_dh      :  heat remaining if total melt (zq_rema) 
       !     Third  step in limsbc         :  heat from ice-ocean mass exchange (zf_mass) + solar
+!$OMP DO schedule(static) private(jj,ji)
       DO jj = 1, jpj
          DO ji = 1, jpi
@@ -223 +266 @@
          END DO
       END DO
+!$OMP END PARALLEL
 
       !------------------------------------------------------------------------------!
@@ -288 +332 @@
 
       ! Enthalpies are global variables we have to readjust the units (heat content in J/m2)
+!$OMP PARALLEL
       DO jl = 1, jpl
          DO jk = 1, nlay_i
-            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * a_i(:,:,jl) * ht_i(:,:,jl) * r1_nlay_i
+!$OMP DO schedule(static) private(jj,ji)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i
+               END DO
+            END DO
          END DO
          DO jk = 1, nlay_s
-            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * a_i(:,:,jl) * ht_s(:,:,jl) * r1_nlay_s
-         END DO
-      END DO
- 
-      ! Change thickness to volume
-      v_i(:,:,:)   = ht_i(:,:,:) * a_i(:,:,:)
-      v_s(:,:,:)   = ht_s(:,:,:) * a_i(:,:,:)
-      smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
+!$OMP DO schedule(static) private(jj,ji)
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_s(ji,jj,jl) * r1_nlay_s
+               END DO
+            END DO
+         END DO
+      END DO
+
+! Change thickness to volume
+      DO jl = 1, jpl
+!$OMP DO schedule(static) private(jj,ji)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               v_i(ji,jj,jl)   = ht_i(ji,jj,jl) * a_i(ji,jj,jl)
+               v_s(ji,jj,jl)   = ht_s(ji,jj,jl) * a_i(ji,jj,jl)
+               smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)
+            END DO
+         END DO
+      END DO
 
       ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat)
       DO jl  = 1, jpl
+!$OMP DO schedule(static) private(jj,ji,rswitch)
          DO jj = 1, jpj
             DO ji = 1, jpi
@@ -311 +374 @@
          END DO
       END DO
+!$OMP END PARALLEL
 
       CALL lim_var_zapsmall