Changeset 11049 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90

Timestamp:

2019-05-24T10:22:47+02:00 (5 years ago)

Author:

girrmann

Message:

dev_r10984_HPC-13 : CYCLE instruction is not systematic anymore, computation is done on the halo whenever possible and overwritten by lbc_bdy instruction, see #2285

File:

• NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90 (modified) (6 diffs)

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90

@@ -99 +99 @@
          ii   = idx%nbi(jb,igrd)
          ij   = idx%nbj(jb,igrd)
-         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove
          zwgt = idx%nbw(jb,igrd)
          pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1)
@@ -108 +107 @@
          ii   = idx%nbi(jb,igrd)
          ij   = idx%nbj(jb,igrd)
-         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove
          zwgt = idx%nbw(jb,igrd)
          pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1)
@@ -165 +163 @@
          ii = idx%nbi(jb,igrd)
          ij = idx%nbj(jb,igrd)
-         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove
          IF( ll_wd ) THEN
             spgu(ii, ij) = dta%ssh(jb)  - ssh_ref 
@@ -180 +177 @@
       DO jb = 1, idx%nblenrim(igrd)
          ii  = idx%nbi(jb,igrd)
-         ij  = idx%nbj(jb,igrd) 
-         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove
+         ij  = idx%nbj(jb,igrd)
          flagu => idx%flagu(jb,igrd)
          iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary
          iip1 = ii - MIN( 0, INT( flagu ) )   ! T pts i-indice outside the boundary 
+         IF( iim1 > jpi .OR. iip1 > jpi )   CYCLE
          !
          zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
@@ -199 +196 @@
       DO jb = 1, idx%nblenrim(igrd)
          ii  = idx%nbi(jb,igrd)
-         ij  = idx%nbj(jb,igrd) 
-         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove
+         ij  = idx%nbj(jb,igrd)
          flagv => idx%flagv(jb,igrd)
          ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary
          ijp1 = ij - MIN( 0, INT( flagv ) )   ! T pts j-indice outside the boundary 
+         IF( ijm1 > jpj .OR. ijp1 > jpj )   CYCLE
          !
          zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
@@ -210 +207 @@
          ! Use characteristics method instead
          zflag = ABS(flagv)
-         zforc  = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1)
+         zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1)
          pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1)
       END DO