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 11048 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90 – NEMO

Ignore:
Timestamp:
2019-05-23T18:36:06+02:00 (5 years ago)
Author:
girrmann
Message:

dev_r10984_HPC-13 : Step 1, boundary is now detected all over the local domain, this does not change the result. Improve bdy treatment for bdy_rnf in bdytra.F90, this changes the result when keyword runoff is specified in namelist

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r11024 r11048  
    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 
    8889            ua(ii,ij,jk) = dta%u3d(jb,jk) * umask(ii,ij,jk) 
    8990         END DO 
    … …  
    9596            ii   = idx%nbi(jb,igrd) 
    9697            ij   = idx%nbj(jb,igrd) 
     98            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    9799            va(ii,ij,jk) = dta%v3d(jb,jk) * vmask(ii,ij,jk) 
    98100         END DO 
    99101      END DO 
     102      ! 
    100103      CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
    101       CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
    102       ! 
    103       IF( kt == nit000 )   CLOSE( unit = 102 ) 
     104      CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy ) 
    104105      ! 
    105106   END SUBROUTINE bdy_dyn3d_spe 
    … …  
    120121      INTEGER  ::   jb, jk         ! dummy loop indices 
    121122      INTEGER  ::   ii, ij, igrd   ! local integers 
    122       REAL(wp) ::   zwgt           ! boundary weight 
    123       INTEGER  ::   fu, fv 
     123      INTEGER  ::   flagu, flagv           ! short cuts 
    124124      !!---------------------------------------------------------------------- 
    125125      ! 
    126126      igrd = 2                      ! Copying tangential velocity into bdy points 
    127127      DO jb = 1, idx%nblenrim(igrd) 
    128          DO jk = 1, jpkm1 
    129             ii   = idx%nbi(jb,igrd) 
    130             ij   = idx%nbj(jb,igrd) 
    131             fu   = ABS( ABS (NINT( idx%flagu(jb,igrd) ) ) - 1 ) 
    132             ua(ii,ij,jk) = ua(ii,ij,jk) * REAL( 1 - fu) + ( ua(ii,ij+fu,jk) * umask(ii,ij+fu,jk) & 
    133                         &+ ua(ii,ij-fu,jk) * umask(ii,ij-fu,jk) ) * umask(ii,ij,jk) * REAL( fu ) 
    134          END DO 
     128         ii    = idx%nbi(jb,igrd) 
     129         ij    = idx%nbj(jb,igrd) 
     130         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
     131         flagu = NINT(idx%flagu(jb,igrd)) 
     132         flagv = NINT(idx%flagv(jb,igrd)) 
     133         ! 
     134         IF( flagu == 0 )   THEN              ! north/south bdy 
     135            ! Rare case : rim is parallel to the mpi subdomain border and located next to the halo 
     136            IF( ij+flagv > jpj .OR. ij+flagv < 1 )   CYCLE       
     137            ! 
     138            DO jk = 1, jpkm1 
     139               ua(ii,ij,jk) = ua(ii,ij+flagv,jk) * umask(ii,ij+flagv,jk) 
     140            END DO 
     141            ! 
     142         END IF 
    135143      END DO 
    136144      ! 
    137145      igrd = 3                      ! Copying tangential velocity into bdy points 
    138146      DO jb = 1, idx%nblenrim(igrd) 
    139          DO jk = 1, jpkm1 
    140             ii   = idx%nbi(jb,igrd) 
    141             ij   = idx%nbj(jb,igrd) 
    142             fv   = ABS( ABS (NINT( idx%flagv(jb,igrd) ) ) - 1 ) 
    143             va(ii,ij,jk) = va(ii,ij,jk) * REAL( 1 - fv ) + ( va(ii+fv,ij,jk) * vmask(ii+fv,ij,jk) & 
    144                         &+ va(ii-fv,ij,jk) * vmask(ii-fv,ij,jk) ) * vmask(ii,ij,jk) * REAL( fv ) 
    145          END DO 
    146       END DO 
     147         ii    = idx%nbi(jb,igrd) 
     148         ij    = idx%nbj(jb,igrd) 
     149         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
     150         flagu = NINT(idx%flagu(jb,igrd)) 
     151         flagv = NINT(idx%flagv(jb,igrd)) 
     152         ! 
     153         IF( flagv == 0 )   THEN              !  west/east  bdy 
     154            ! Rare case : rim is parallel to the mpi subdomain border and located next to the halo 
     155            IF( ii+flagu > jpi .OR. ii+flagu < 1 )   CYCLE       
     156            ! 
     157            DO jk = 1, jpkm1 
     158               va(ii,ij,jk) = va(ii+flagu,ij,jk) * vmask(ii+flagu,ij,jk) 
     159            END DO 
     160            ! 
     161         END IF 
     162      END DO 
     163      ! 
    147164      CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
    148165      CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
    149       ! 
    150       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    151166      ! 
    152167   END SUBROUTINE bdy_dyn3d_zgrad 
    … …  
    174189         ii = idx%nbi(ib,igrd) 
    175190         ij = idx%nbj(ib,igrd) 
     191         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    176192         DO ik = 1, jpkm1 
    177193            ua(ii,ij,ik) = 0._wp 
    … …  
    183199         ii = idx%nbi(ib,igrd) 
    184200         ij = idx%nbj(ib,igrd) 
     201         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    185202         DO ik = 1, jpkm1 
    186203            va(ii,ij,ik) = 0._wp 
    … …  
    189206      ! 
    190207      CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
    191       ! 
    192       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    193208      ! 
    194209   END SUBROUTINE bdy_dyn3d_zro 
    … …  
    221236            ii   = idx%nbi(jb,igrd) 
    222237            ij   = idx%nbj(jb,igrd) 
     238            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    223239            zwgt = idx%nbw(jb,igrd) 
    224240            ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta%u3d(jb,jk) - ua(ii,ij,jk) ) ) * umask(ii,ij,jk) 
    … …  
    231247            ii   = idx%nbi(jb,igrd) 
    232248            ij   = idx%nbj(jb,igrd) 
     249            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    233250            zwgt = idx%nbw(jb,igrd) 
    234251            va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta%v3d(jb,jk) - va(ii,ij,jk) ) ) * vmask(ii,ij,jk) 
    235252         END DO 
    236253      END DO  
     254      ! 
    237255      CALL lbc_bdy_lnk( 'bdydyn3d', ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
    238256      CALL lbc_bdy_lnk( 'bdydyn3d', va, 'V', -1., ib_bdy )    
    239       ! 
    240       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    241257      ! 
    242258   END SUBROUTINE bdy_dyn3d_frs 
    … …  
    300316               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
    301317               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
     318               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    302319               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 
    303320               DO jk = 1, jpkm1 
    … …  
    311328               ii   = idx_bdy(ib_bdy)%nbi(jb,igrd) 
    312329               ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
     330               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    313331               zwgt = idx_bdy(ib_bdy)%nbd(jb,igrd) 
    314332               DO jk = 1, jpkm1 
Note: See TracChangeset for help on using the changeset viewer.