Changeset 5920 for branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

Timestamp:

2015-11-25T17:58:51+01:00 (8 years ago)

Author:

mathiot

Message:

ice sheet coupling: add treshold to define grounded area, remove useless va
riable, change some variable name + add some namelist parameter

File:

• branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90 (modified) (6 diffs)

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

@@ -34 +34 @@
    !! * Substitutions  
 #  include "domzgr_substitute.h90"  
+#  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -187 +188 @@
       DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+)
          zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:)
-         DO ji = 2,jpi-1
-            DO jj = 2,jpj-1
+         DO jj = 2,jpj-1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
                jip1=ji+1; jim1=ji-1;
                jjp1=jj+1; jjm1=jj-1;
@@ -280 +281 @@
       vb(:,:,:)=vn(:,:,:)
       DO jk = 1,jpk
-         DO ji = 1,jpi
-            DO jj = 1,jpj
+         DO jj = 1,jpj
+            DO ji = 1,jpi
                un(ji,jj,jk) = ub(ji,jj,jk)*pe3u_b(ji,jj,jk)*pumask_b(ji,jj,jk)/fse3u_n(ji,jj,jk)*umask(ji,jj,jk);
                vn(ji,jj,jk) = vb(ji,jj,jk)*pe3v_b(ji,jj,jk)*pvmask_b(ji,jj,jk)/fse3v_n(ji,jj,jk)*vmask(ji,jj,jk);
@@ -310 +311 @@
       zucorr = 0._wp
       zvcorr = 0._wp
-      DO ji = 1,jpi
-         DO jj = 1,jpj
+      DO jj = 1,jpj
+         DO ji = 1,jpi
             IF (zbun(ji,jj) .NE. zbub(ji,jj) .AND. hu1(ji,jj) .NE. 0._wp ) THEN
                zucorr(ji,jj) = (zbun(ji,jj) - zbub(ji,jj))/hu1(ji,jj)
@@ -334 +335 @@
       ztmask1(:,:,:) = ptmask_b(:,:,:)
       ztmask0(:,:,:) = ptmask_b(:,:,:)
-      DO iz = 1,10 ! resolution dependent (OK for ISOMIP+ case)
+      DO iz = 1,nn_drown ! resolution dependent (OK for ISOMIP+ case)
           DO jk = 1,jpk-1
               zdmask=tmask(:,:,jk)-ztmask0(:,:,jk);
-              DO ji = 2,jpi-1
-                  DO jj = 2,jpj-1
+              DO jj = 2,jpj-1
+                 DO ji = fs_2,fs_jpim1
                       jip1=ji+1; jim1=ji-1;
                       jjp1=jj+1; jjm1=jj-1;
                       summsk= (ztmask0(jip1,jj  ,jk)+ztmask0(jim1,jj  ,jk)+ztmask0(ji  ,jjp1,jk)+ztmask0(ji  ,jjm1,jk))
+                      IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN
                       !! horizontal basic extrapolation
-                      IF (zdmask(ji,jj)==1._wp .AND. summsk .NE. 0._wp) THEN
                          tsn(ji,jj,jk,1)=( zts0(jip1,jj  ,jk,1)*ztmask0(jip1,jj  ,jk) &
                          &                +zts0(jim1,jj  ,jk,1)*ztmask0(jim1,jj  ,jk) &
@@ -353 +354 @@
                          &                +zts0(ji  ,jjm1,jk,2)*ztmask0(ji  ,jjm1,jk) ) / summsk
                          ztmask1(ji,jj,jk)=1
-                      END IF
-                      !! vertical extrapolation if horizontal extra failed
-                      IF (zdmask(ji,jj)==1._wp .AND. summsk==0._wp) THEN
+                      ELSEIF (zdmask(ji,jj)==1._wp .AND. summsk==0._wp) THEN
+                      !! vertical extrapolation if horizontal extrapolation failed
                          jkm1=max(1,jk-1) ; jkp1=min(jpk,jk+1)
                          summsk=(ztmask0(ji,jj,jkm1)+ztmask0(ji,jj,jkp1))