New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11049 – NEMO

Changeset 11049


Ignore:
Timestamp:
2019-05-24T10:22:47+02:00 (6 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

Location:
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE
Files:
8 edited

Legend:

Unmodified
Added
Removed

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

    r11048 r11049  
    9999         ii   = idx%nbi(jb,igrd) 
    100100         ij   = idx%nbj(jb,igrd) 
    101          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    102101         zwgt = idx%nbw(jb,igrd) 
    103102         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1) 
    … …  
    108107         ii   = idx%nbi(jb,igrd) 
    109108         ij   = idx%nbj(jb,igrd) 
    110          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    111109         zwgt = idx%nbw(jb,igrd) 
    112110         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 
    … …  
    165163         ii = idx%nbi(jb,igrd) 
    166164         ij = idx%nbj(jb,igrd) 
    167          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    168165         IF( ll_wd ) THEN 
    169166            spgu(ii, ij) = dta%ssh(jb)  - ssh_ref  
    … …  
    180177      DO jb = 1, idx%nblenrim(igrd) 
    181178         ii  = idx%nbi(jb,igrd) 
    182          ij  = idx%nbj(jb,igrd)  
    183          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
     179         ij  = idx%nbj(jb,igrd) 
    184180         flagu => idx%flagu(jb,igrd) 
    185181         iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary 
    186182         iip1 = ii - MIN( 0, INT( flagu ) )   ! T pts i-indice outside the boundary  
     183         IF( iim1 > jpi .OR. iip1 > jpi )   CYCLE 
    187184         ! 
    188185         zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
    … …  
    199196      DO jb = 1, idx%nblenrim(igrd) 
    200197         ii  = idx%nbi(jb,igrd) 
    201          ij  = idx%nbj(jb,igrd)  
    202          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
     198         ij  = idx%nbj(jb,igrd) 
    203199         flagv => idx%flagv(jb,igrd) 
    204200         ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary 
    205201         ijp1 = ij - MIN( 0, INT( flagv ) )   ! T pts j-indice outside the boundary  
     202         IF( ijm1 > jpj .OR. ijp1 > jpj )   CYCLE 
    206203         ! 
    207204         zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
    … …  
    210207         ! Use characteristics method instead 
    211208         zflag = ABS(flagv) 
    212          zforc  = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1) 
     209         zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1) 
    213210         pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 
    214211      END DO 

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

    r11048 r11049  
    8686            ii   = idx%nbi(jb,igrd) 
    8787            ij   = idx%nbj(jb,igrd) 
    88             IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    8988            ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk) 
    9089         END DO 
    … …  
    9695            ii   = idx%nbi(jb,igrd) 
    9796            ij   = idx%nbj(jb,igrd) 
    98             IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    9997            va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk) 
    10098         END DO 
    … …  
    128126         ii    = idx%nbi(jb,igrd) 
    129127         ij    = idx%nbj(jb,igrd) 
    130          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    131128         flagu = NINT(idx%flagu(jb,igrd)) 
    132129         flagv = NINT(idx%flagv(jb,igrd)) 
    133130         ! 
    134131         IF( flagu == 0 )   THEN              ! north/south bdy 
    135             ! Rare case : rim is parallel to the mpi subdomain border and located next to the halo 
    136132            IF( ij+flagv > jpj .OR. ij+flagv < 1 )   CYCLE       
    137133            ! 
    … …  
    147143         ii    = idx%nbi(jb,igrd) 
    148144         ij    = idx%nbj(jb,igrd) 
    149          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    150145         flagu = NINT(idx%flagu(jb,igrd)) 
    151146         flagv = NINT(idx%flagv(jb,igrd)) 
    152147         ! 
    153148         IF( flagv == 0 )   THEN              !  west/east  bdy 
    154             ! Rare case : rim is parallel to the mpi subdomain border and located next to the halo 
    155149            IF( ii+flagu > jpi .OR. ii+flagu < 1 )   CYCLE       
    156150            ! 
    … …  
    189183         ii = idx%nbi(ib,igrd) 
    190184         ij = idx%nbj(ib,igrd) 
    191          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    192185         DO ik = 1, jpkm1 
    193186            ua(ii,ij,ik) = 0._wp 
    … …  
    199192         ii = idx%nbi(ib,igrd) 
    200193         ij = idx%nbj(ib,igrd) 
    201          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    202194         DO ik = 1, jpkm1 
    203195            va(ii,ij,ik) = 0._wp 
    … …  
    236228            ii   = idx%nbi(jb,igrd) 
    237229            ij   = idx%nbj(jb,igrd) 
    238             IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    239230            zwgt = idx%nbw(jb,igrd) 
    240231            ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta%u3d(jb,jk) - ua(ii,ij,jk) ) ) * umask(ii,ij,jk) 
    … …  
    247238            ii   = idx%nbi(jb,igrd) 
    248239            ij   = idx%nbj(jb,igrd) 
    249             IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    250240            zwgt = idx%nbw(jb,igrd) 
    251241            va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk) 
    … …  
    316306               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
    317307               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    318                IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    319308               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 
    320309               DO jk = 1, jpkm1 
    … …  
    328317               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
    329318               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    330                IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    331319               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 
    332320               DO jk = 1, jpkm1 

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

    r11048 r11049  
    116116            ji    = idx%nbi(i_bdy,jgrd) 
    117117            jj    = idx%nbj(i_bdy,jgrd) 
    118             IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
    119118            zwgt  = idx%nbw(i_bdy,jgrd) 
    120119            zwgt1 = 1.e0 - idx%nbw(i_bdy,jgrd) 
    … …  
    148147            ji = idx%nbi(i_bdy,jgrd) 
    149148            jj = idx%nbj(i_bdy,jgrd) 
    150             IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
    151149            flagu => idx%flagu(i_bdy,jgrd) 
    152150            flagv => idx%flagv(i_bdy,jgrd) 
    … …  
    155153            jpbound = 0   ;   ib = ji   ;   jb = jj 
    156154            ! 
    157             IF( u_ice(ji  ,jj  ) < 0. .AND. flagu ==  1. )   jpbound = 1 ; ib = ji+1  
    158             IF( u_ice(ji-1,jj  ) > 0. .AND. flagu == -1. )   jpbound = 1 ; ib = ji-1 
    159             IF( v_ice(ji  ,jj  ) < 0. .AND. flagv ==  1. )   jpbound = 1             ; jb = jj+1 
    160             IF( v_ice(ji  ,jj-1) > 0. .AND. flagv == -1. )   jpbound = 1             ; jb = jj-1 
     155            IF( flagu ==  1. )   THEN 
     156               IF( ji+1 > jpi  )   CYCLE 
     157               IF( u_ice(ji  ,jj  ) < 0. )   jpbound = 1 ; ib = ji+1 
     158            END IF 
     159            IF( flagu == -1. )   THEN 
     160               IF( ji-1 < 1    )   CYCLE 
     161               IF( u_ice(ji-1,jj  ) < 0. )   jpbound = 1 ; ib = ji-1 
     162            END IF 
     163            IF( flagv ==  1. )   THEN 
     164               IF( ji+1 > jpj )   CYCLE 
     165               IF( v_ice(ji  ,jj  ) < 0. )   jpbound = 1 ; jb = jj+1 
     166            END IF 
     167            IF( flagv == -1. )   THEN 
     168               IF( jj-1 < 1   )   CYCLE 
     169               IF( v_ice(ji  ,jj-1) < 0. )   jpbound = 1 ; jb = jj-1 
     170            END IF 
    161171            ! 
    162172            IF( nn_ice_dta(jbdy) == 0 )   jpbound = 0 ; ib = ji ; jb = jj   ! case ice boundaries = initial conditions 
    … …  
    308318                  ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
    309319                  jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
    310                   IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
    311320                  zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 
    312321                  !     i-1  i   i    |  !        i  i i+1 |  !          i  i i+1 | 
    … …  
    337346                  ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
    338347                  jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
    339                   IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
    340348                  zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 
    341349                  !    ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨     !  ¨¨¨¨ïce¨¨¨(jj+1)¨¨     ! ¨¨¨¨¨¨ö¨¨¨¨(jj+1)        

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

    r11048 r11049  
    132132      INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 
    133133      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
    134       INTEGER  ::   i_offset, j_offset, inbdy            !   -       - 
     134      INTEGER  ::   i_offset, j_offset, inbdy, itreat      !   -       - 
    135135      INTEGER , POINTER  ::  nbi, nbj, nbr                 ! short cuts 
    136136      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields 
    … …  
    146146      REAL(wp), TARGET, DIMENSION(jpi,jpj) ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
    147147      REAL(wp)        , DIMENSION(jpi,jpj) ::   ztmp 
     148      REAL(wp), POINTER                    :: flagu,     flagv     ! short cuts 
    148149      LOGICAL  ::   llnobdy, llsobdy, lleabdy, llwebdy     ! local logicals 
    149150      !! 
    … …  
    802803      iwe = mig(1) - 1 + 2 - nde       ! if monotasking and no zoom, iw=2 
    803804      ies = mig(1) + nlci-1 - 1 + nde  ! if monotasking and no zoom, ie=jpim1 
    804       iso = mjg(1) - 1 + 2 -nde        ! if monotasking and no zoom, is=2 
     805      iso = mjg(1) - 1 + 2 - nde       ! if monotasking and no zoom, is=2 
    805806      ino = mjg(1) + nlcj-1 - 1 + nde  ! if monotasking and no zoom, in=jpjm1 
    806807 
    … …  
    12741275            ztmp(:,:) = 0._wp 
    12751276            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    1276                ii =  idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1277                ij =  idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1277               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1278               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    12781279               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE 
    12791280               llnobdy = pmask(ii  ,ij+1) == 1.   
    … …  
    13271328         END DO 
    13281329      END DO 
     1330 
    13291331      ! 
    13301332      ! Tidy up 

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

    r11048 r11049  
    5656            ii = idx%nbi(ib,igrd)  
    5757            ij = idx%nbj(ib,igrd) 
    58             IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    5958            zwgt = idx%nbw(ib,igrd) 
    6059            pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik) 
    … …  
    8483         ii = idx%nbi(ib,igrd) 
    8584         ij = idx%nbj(ib,igrd) 
    86          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    8785         DO ik = 1, jpkm1 
    8886            pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 
    … …  
    468466         ii = idx%nbi(ib,igrd) 
    469467         ij = idx%nbj(ib,igrd) 
    470          IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
     468         ! 
    471469         SELECT CASE( idx%ntreat(ib,igrd) )   ! select free ocean neighbours 
    472470            !     o  
    … …  
    499497         SELECT CASE( idx%ntreat(ib,igrd) ) 
    500498            CASE( 0:4 ) 
     499               IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
    501500               DO ik = 1, ipkm1 
    502501                  IF( pmask(ii1,ij1,ik) /= 0. )   phia(ii,ij,ik) = phia(ii1,ij1,ik)   
    503502               END DO 
    504503            CASE( 5:8 ) 
     504               IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
     505               IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE 
    505506               DO ik = 1, ipkm1 
    506507                  zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) 
    … …  
    508509               END DO 
    509510            CASE( 9:12 ) 
     511               IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
     512               IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE 
     513               IF( ii3 < 1 .OR. ii3 > jpi .OR. ij3 < 1 .OR. ij3 > jpj )   CYCLE 
    510514               DO ik = 1, ipkm1 
    511515                  zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) + pmask(ii3,ij3,ik) 

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

    r11048 r11049  
    104104            ii = idx%nbi(ib,igrd) 
    105105            ij = idx%nbj(ib,igrd) 
    106             IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    107106            pta(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1) 
    108107         END DO 
    … …  
    136135               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    137136               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    138                IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    139137               zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 
    140138               DO ik = 1, jpkm1 

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

    r11048 r11049  
    9999            ii = idx%nbi(jb,jgrd) 
    100100            ij = idx%nbj(jb,jgrd) 
    101             IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? check tmask_i definition... 
     101            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    102102            zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * pua2d(ii,ij) * e2u(ii,ij) * phu(ii,ij) * tmask_i(ii,ij) * tmask_i(ii+1,ij) 
    103103         END DO 
    … …  
    106106            ii = idx%nbi(jb,jgrd) 
    107107            ij = idx%nbj(jb,jgrd) 
    108             IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
     108            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    109109            zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * pva2d(ii,ij) * e1v(ii,ij) * phv(ii,ij) * tmask_i(ii,ij) * tmask_i(ii,ij+1) 
    110110         END DO 

  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynkeg.F90

    r11048 r11049  
    122122                     ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 1 to jpi 
    123123                     jj   = idx_bdy(ib_bdy)%nbj(jb,igrd)   ! maximum extent : from 1 to jpj 
    124                      IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove? 
     124                     IF( ji == 1 .OR. jj == 1 )  CYCLE 
    125125                     DO jk = 1, jpkm1 
    126126                        zhke(ji,jj,jk) = 0._wp 
    … …  
    164164                     ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 1 to jpi 
    165165                     jj   = idx_bdy(ib_bdy)%nbj(jb,igrd)   ! maximum extent : from 1 to jpj 
    166                      IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
     166                     IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE 
    167167                     DO jk = 1, jpkm1 
    168168                        zhke(ji,jj,jk) = 0._wp 
Note: See TracChangeset for help on using the changeset viewer.