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 – NEMO

Changeset 11048


Ignore:
Timestamp:
2019-05-23T18:36:06+02:00 (6 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

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

Legend:

Unmodified
Added
Removed

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

    r11044 r11048  
    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 
    101102         zwgt = idx%nbw(jb,igrd) 
    102103         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1) 
    … …  
    107108         ii   = idx%nbi(jb,igrd) 
    108109         ij   = idx%nbj(jb,igrd) 
     110         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    109111         zwgt = idx%nbw(jb,igrd) 
    110112         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 
    … …  
    163165         ii = idx%nbi(jb,igrd) 
    164166         ij = idx%nbj(jb,igrd) 
     167         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    165168         IF( ll_wd ) THEN 
    166169            spgu(ii, ij) = dta%ssh(jb)  - ssh_ref  
    … …  
    178181         ii  = idx%nbi(jb,igrd) 
    179182         ij  = idx%nbj(jb,igrd)  
     183         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    180184         flagu => idx%flagu(jb,igrd) 
    181185         iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary 
    … …  
    196200         ii  = idx%nbi(jb,igrd) 
    197201         ij  = idx%nbj(jb,igrd)  
     202         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    198203         flagv => idx%flagv(jb,igrd) 
    199204         ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary 

  • 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 

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

    r11042 r11048  
    107107      REAL(wp) ::   zwgt, zwgt1        ! local scalar 
    108108      REAL(wp) ::   ztmelts, zdh 
     109      REAL(wp), POINTER  :: flagu, flagv              ! short cuts 
    109110      !!------------------------------------------------------------------------------ 
    110111      ! 
    … …  
    115116            ji    = idx%nbi(i_bdy,jgrd) 
    116117            jj    = idx%nbj(i_bdy,jgrd) 
     118            IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
    117119            zwgt  = idx%nbw(i_bdy,jgrd) 
    118120            zwgt1 = 1.e0 - idx%nbw(i_bdy,jgrd) 
    … …  
    146148            ji = idx%nbi(i_bdy,jgrd) 
    147149            jj = idx%nbj(i_bdy,jgrd) 
    148  
     150            IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
     151            flagu => idx%flagu(i_bdy,jgrd) 
     152            flagv => idx%flagv(i_bdy,jgrd) 
    149153            ! condition on ice thickness depends on the ice velocity 
    150154            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 
    151155            jpbound = 0   ;   ib = ji   ;   jb = jj 
    152156            ! 
    153             IF( u_ice(ji  ,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji+1 
    154             IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji  ,jj  ,1) == 0. )   jpbound = 1 ; ib = ji-1 
    155             IF( v_ice(ji  ,jj  ) < 0. .AND. vmask(ji  ,jj-1,1) == 0. )   jpbound = 1 ; jb = jj+1 
    156             IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj  ,1) == 0. )   jpbound = 1 ; jb = jj-1 
     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 
    157161            ! 
    158162            IF( nn_ice_dta(jbdy) == 0 )   jpbound = 0 ; ib = ji ; jb = jj   ! case ice boundaries = initial conditions 
    … …  
    304308                  ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
    305309                  jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
     310                  IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
    306311                  zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 
    307                   ! 
    308                   IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries 
    309                      ! one of the two zmsk is always 0 (because of zflag) 
    310                      zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice 
    311                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj) ) )   ! 0 if no ice 
    312                      !   
    313                      ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then do not change u_ice) 
    314                      u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
    315                         &            u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    316                         &            u_ice(ji  ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    317                   ELSE                             ! everywhere else 
    318                      u_ice(ji,jj) = 0._wp 
    319                   ENDIF 
     312                  !     i-1  i   i    |  !        i  i i+1 |  !          i  i i+1 | 
     313                  !      >  ice  >    |  !        o  > ice |  !          o  >  o  |       
     314                  ! => set at u_ice(i-1) !  => set to O       !  => unchanged 
     315                  IF( zflag == -1. .AND. ji > 1 .AND. ji < jpi )   THEN   
     316                     IF    ( vt_i(ji  ,jj) > 0. )   THEN   ;   u_ice(ji,jj) = u_ice(ji-1,jj)  
     317                     ELSEIF( vt_i(ji+1,jj) > 0. )   THEN   ;   u_ice(ji,jj) = 0._wp 
     318                     END IF 
     319                  END IF 
     320                  ! |    i  i+1 i+1        !  |  i   i i+1        !  | i  i i+1 
     321                  ! |    >  ice  >         !  | ice  >  o         !  | o  >  o    
     322                  ! => set at u_ice(i+1)   !     => set to O      !     =>  unchanged 
     323                  IF( zflag ==  1. .AND. ji+1 < jpi+1 )   THEN 
     324                     IF    ( vt_i(ji+1,jj) > 0. )   THEN   ;   u_ice(ji,jj) = u_ice(ji+1,jj) 
     325                     ELSEIF( vt_i(ji  ,jj) > 0. )   THEN   ;   u_ice(ji,jj) = 0._wp 
     326                     END IF 
     327                  END IF 
     328                  ! 
     329                  IF( zflag ==  0. )   u_ice(ji,jj) = 0._wp   ! u_ice = 0  if north/south bdy   
    320330                  ! 
    321331               END DO 
    … …  
    327337                  ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
    328338                  jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
     339                  IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE   ! to remove 
    329340                  zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 
    330                   ! 
    331                   IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries 
    332                      ! one of the two zmsk is always 0 (because of zflag) 
    333                      zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice 
    334                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj) ) )   ! 0 if no ice 
    335                      !   
    336                      ! v_ice = v_ice of the adjacent grid point except if this grid point is ice-free (then do not change v_ice) 
    337                      v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
    338                         &            v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 
    339                         &            v_ice(ji,jj  ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 
    340                   ELSE                             ! everywhere else 
    341                      v_ice(ji,jj) = 0._wp 
    342                   ENDIF 
     341                  !    ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨     !  ¨¨¨¨ïce¨¨¨(jj+1)¨¨     ! ¨¨¨¨¨¨ö¨¨¨¨(jj+1)        
     342                  !       ^    (jj  )       !       ^    (jj  )       !       ^    (jj  )        
     343                  !      ice   (jj  )       !       o    (jj  )       !       o    (jj  )        
     344                  !       ^    (jj-1)       !                         ! 
     345                  ! => set to u_ice(jj-1)   !  =>   set to 0          !   => unchanged         
     346                  IF( zflag == -1. .AND. jj > 1 .AND. jj < jpj )   THEN                  
     347                    IF    ( vt_i(ji,jj  ) > 0. )   THEN   ;   v_ice(ji,jj) = v_ice(ji,jj-1) 
     348                    ELSEIF( vt_i(ji,jj+1) > 0. )   THEN   ;   v_ice(ji,jj) = 0._wp 
     349                    END IF 
     350                  END IF  
     351                  !       ^    (jj+1)       !                         !               
     352                  !      ice   (jj+1)       !       o    (jj+1)       !       o    (jj+1)        
     353                  !       ^    (jj  )       !       ^    (jj  )       !       ^    (jj  ) 
     354                  !   ________________      !  ____ice___(jj  )_      !  _____o____(jj  )  
     355                  ! => set to u_ice(jj+1)   !    => set to 0          !    => unchanged   
     356                  IF( zflag ==  1. .AND. jj < jpj )   THEN               
     357                     IF    ( vt_i(ji,jj+1) > 0. )   THEN   ;   v_ice(ji,jj) = v_ice(ji,jj+1) 
     358                     ELSEIF( vt_i(ji,jj  ) > 0. )   THEN   ;   v_ice(ji,jj) = 0._wp 
     359                     END IF 
     360                  END IF                                           
     361                  ! 
     362                  IF( zflag ==  0. )   v_ice(ji,jj) = 0._wp   ! v_ice = 0  if west/east bdy   
    343363                  ! 
    344364               END DO 

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

    r11044 r11048  
    3737   INTEGER, PARAMETER ::   jp_nseg = 100   !  
    3838   INTEGER, PARAMETER ::   nrimmax =  20   ! maximum rimwidth in structured 
     39   INTEGER  :: nde = 1 ! domain extended in the halo to deal with bondaries  
    3940                                               ! open boundary data files 
    4041   ! Straight open boundary segment parameters: 
    … …  
    144145      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
    145146      REAL(wp), TARGET, DIMENSION(jpi,jpj) ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
     147      REAL(wp)        , DIMENSION(jpi,jpj) ::   ztmp 
    146148      LOGICAL  ::   llnobdy, llsobdy, lleabdy, llwebdy     ! local logicals 
    147149      !! 
    … …  
    798800!      is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
    799801!      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1       
    800       iwe = mig(1) - 1 + 2         ! if monotasking and no zoom, iw=2 
    801       ies = mig(1) + nlci-1 - 1 ! if monotasking and no zoom, ie=jpim1 
    802       iso = mjg(1) - 1 + 2         ! if monotasking and no zoom, is=2 
    803       ino = mjg(1) + nlcj-1 - 1 ! if monotasking and no zoom, in=jpjm1 
     802      iwe = mig(1) - 1 + 2 - nde       ! if monotasking and no zoom, iw=2 
     803      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      ino = mjg(1) + nlcj-1 - 1 + nde ! if monotasking and no zoom, in=jpjm1 
    804806 
    805807      ALLOCATE( nbondi_bdy(nb_bdy)) 
    … …  
    11731175      CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1., bdytmask, 'T', 1. ) 
    11741176      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
    1175  
    1176          idx_bdy(ib_bdy)%flagu(:,:) = 0._wp 
    1177          idx_bdy(ib_bdy)%flagv(:,:) = 0._wp 
    11781177         icount = 0  
    11791178 
    … …  
    11901189            END SELECT  
    11911190            icount = 0 
     1191            ztmp(:,:) = 0._wp 
    11921192            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1193                nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1194                nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1195                zefl = pmask(nbi+i_offset-1,nbj) 
    1196                zwfl = pmask(nbi+i_offset,nbj) 
     1193               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1194               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1195               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE 
     1196               zefl = pmask(ii+i_offset-1,ij) 
     1197               zwfl = pmask(ii+i_offset  ,ij) 
    11971198               ! This error check only works if you are using the bdyXmask arrays 
    1198                IF( i_offset == 1 .and. zefl + zwfl == 2 ) THEN 
     1199               IF( i_offset == 1 .and. zefl + zwfl == 2. ) THEN 
    11991200                  icount = icount + 1 
    1200                   IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     1201                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij) 
    12011202               ELSE 
    1202                   idx_bdy(ib_bdy)%flagu(ib,igrd) = -zefl + zwfl 
     1203                  ztmp(ii,ij) = -zefl + zwfl 
    12031204               ENDIF 
    12041205            END DO 
    … …  
    12091210               CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
    12101211            ENDIF  
     1212            CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
     1213            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1214               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1215               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1216               idx_bdy(ib_bdy)%flagu(ib,igrd) = ztmp(ii,ij) 
     1217            END DO 
    12111218         END DO 
    12121219 
    … …  
    12231230            END SELECT  
    12241231            icount = 0 
     1232            ztmp(:,:) = 0._wp 
    12251233            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1226                nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1227                nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1228                znfl = pmask(nbi,nbj+j_offset-1) 
    1229                zsfl = pmask(nbi,nbj+j_offset  ) 
     1234               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1235               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1236               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE 
     1237               znfl = pmask(ii,ij+j_offset-1) 
     1238               zsfl = pmask(ii,ij+j_offset  ) 
    12301239               ! This error check only works if you are using the bdyXmask arrays 
    1231                IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN 
    1232                   IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     1240               IF( j_offset == 1 .and. znfl + zsfl == 2. ) THEN 
     1241                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(ii),mjg(ij) 
    12331242                  icount = icount + 1 
    12341243               ELSE 
    1235                   idx_bdy(ib_bdy)%flagv(ib,igrd) = -znfl + zsfl 
     1244                  ztmp(ii,ij) = -znfl + zsfl 
    12361245               END IF 
    12371246            END DO 
    … …  
    12411250               WRITE(ctmp2,*) ' ========== ' 
    12421251               CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
    1243             ENDIF  
     1252            ENDIF 
     1253            CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
     1254            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1255               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1256               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1257               idx_bdy(ib_bdy)%flagv(ib,igrd) = ztmp(ii,ij) 
     1258            END DO 
    12441259         END DO 
    12451260         ! 
    … …  
    12571272               CASE( 3 )   ;   pmask => bdyvmask  
    12581273            END SELECT 
     1274            ztmp(:,:) = 0._wp 
    12591275            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    1260                ii        =  idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1261                ij        =  idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1276               ii =  idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1277               ij =  idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1278               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE 
    12621279               llnobdy = pmask(ii  ,ij+1) == 1.   
    12631280               llsobdy = pmask(ii  ,ij-1) == 1.  
    … …  
    12681285                  !               !              !     _____     !     _____      
    12691286                  !  1 |   o      !  2  o   |    !  3 | x        !  4     x |     
    1270                   !    |_x_ _     !    _ _x_|    !    |   o      !      o   |     
    1271                   IF( pmask(ii+1,ij+1) == 1. )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 1 
    1272                   IF( pmask(ii-1,ij+1) == 1. )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 2 
    1273                   IF( pmask(ii+1,ij-1) == 1. )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 3 
    1274                   IF( pmask(ii-1,ij-1) == 1. )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 4 
     1287                  !    |_x_ _     !    _ _x_|    !    |   o      !      o   | 
     1288                  IF( pmask(ii+1,ij+1) == 1. )   ztmp(ii,ij) = 1 
     1289                  IF( pmask(ii-1,ij+1) == 1. )   ztmp(ii,ij) = 2 
     1290                  IF( pmask(ii+1,ij-1) == 1. )   ztmp(ii,ij) = 3 
     1291                  IF( pmask(ii-1,ij-1) == 1. )   ztmp(ii,ij) = 4 
    12751292               END IF 
    12761293               IF( inbdy == 1 )   THEN   ! middle of linear bdy 
    1277                   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 0   ! regular treatment with flags 
     1294                  ztmp(ii,ij) = 0   ! regular treatment with flags 
    12781295               END IF 
    12791296               IF( inbdy == 2 )   THEN   ! exterior of a corner 
    … …  
    12811298                  !  5 ____x o    !  6   o x___   ! 7      x o      !  8   o x       
    12821299                  !         |     !       |       !        o        !        o  
    1283                   IF( llnobdy .AND. lleabdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 5 
    1284                   IF( llnobdy .AND. llwebdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 6 
    1285                   IF( llsobdy .AND. lleabdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 7 
    1286                   IF( llsobdy .AND. llwebdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 8 
     1300                  IF( llnobdy .AND. lleabdy )   ztmp(ii,ij) = 5 
     1301                  IF( llnobdy .AND. llwebdy )   ztmp(ii,ij) = 6 
     1302                  IF( llsobdy .AND. lleabdy )   ztmp(ii,ij) = 7 
     1303                  IF( llsobdy .AND. llwebdy )   ztmp(ii,ij) = 8 
    12871304               END IF 
    12881305               IF( inbdy == 3 )   THEN   ! 3 neighbours __   __ 
    … …  
    12901307                  !  9  _| x o    ! 10   o x |_   ! 11   o x o    ! 12  o x o        
    12911308                  !    |   o      !        o   |  !        o      !    __|¨|__     
    1292                   IF( llnobdy .AND. lleabdy .AND. llsobdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 9 
    1293                   IF( llnobdy .AND. llwebdy .AND. llsobdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 10 
    1294                   IF( llwebdy .AND. llsobdy .AND. lleabdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 11 
    1295                   IF( llwebdy .AND. llnobdy .AND. lleabdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 12 
     1309                  IF( llnobdy .AND. lleabdy .AND. llsobdy )   ztmp(ii,ij) = 9 
     1310                  IF( llnobdy .AND. llwebdy .AND. llsobdy )   ztmp(ii,ij) = 10 
     1311                  IF( llwebdy .AND. llsobdy .AND. lleabdy )   ztmp(ii,ij) = 11 
     1312                  IF( llwebdy .AND. llnobdy .AND. lleabdy )   ztmp(ii,ij) = 12 
    12961313               END IF 
    12971314               IF( inbdy == 4 )   THEN 
    … …  
    13011318                  CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
    13021319               END IF 
     1320            END DO 
     1321            CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. ) 
     1322            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1323               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1324               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1325               idx_bdy(ib_bdy)%ntreat(ib,igrd) = ztmp(ii,ij) 
    13031326            END DO 
    13041327         END DO 

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

    r11044 r11048  
    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 
    5859            zwgt = idx%nbw(ib,igrd) 
    5960            pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik) 
    … …  
    8384         ii = idx%nbi(ib,igrd) 
    8485         ij = idx%nbj(ib,igrd) 
     86         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    8587         DO ik = 1, jpkm1 
    8688            pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 
    … …  
    466468         ii = idx%nbi(ib,igrd) 
    467469         ij = idx%nbj(ib,igrd) 
    468          ! 
     470         IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    469471         SELECT CASE( idx%ntreat(ib,igrd) )   ! select free ocean neighbours 
    470472            !     o  

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

    r10068 r11048  
    161161                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    162162                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     163                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    163164                     td%ssh0(ib,itide,1) = ztr(ii,ij) 
    164165                     td%ssh0(ib,itide,2) = zti(ii,ij) 
    … …  
    177178                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    178179                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     180                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    179181                     td%u0(ib,itide,1) = ztr(ii,ij) 
    180182                     td%u0(ib,itide,2) = zti(ii,ij) 
    … …  
    193195                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    194196                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     197                     IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    195198                     td%v0(ib,itide,1) = ztr(ii,ij) 
    196199                     td%v0(ib,itide,2) = zti(ii,ij) 

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

    r11024 r11048  
    9393      INTEGER,                             INTENT(in) ::   jpa  ! TRA index 
    9494      ! 
    95       REAL(wp) ::   zwgt           ! boundary weight 
    96       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    97       INTEGER  ::   ii, ij, ip, jp ! 2D addresses 
     95      INTEGER  ::   ib, ii, ij, igrd   ! dummy loop indices 
     96      INTEGER  ::   ik, ip, jp ! 2D addresses 
    9897      !!---------------------------------------------------------------------- 
    9998      ! 
    10099      igrd = 1                       ! Everything is at T-points here 
    101       DO ib = 1, idx%nblenrim(igrd) 
    102          ii = idx%nbi(ib,igrd) 
    103          ij = idx%nbj(ib,igrd) 
    104          DO ik = 1, jpkm1 
    105             ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    106             jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    107             if (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 
    108             if (jpa == jp_sal) pta(ii,ij,ik) =                 0.1 * tmask(ii,ij,ik) 
     100      IF(      jpa == jp_tem )   THEN 
     101         CALL bdy_nmn( idx, igrd, pta ) 
     102      ELSE IF( jpa == jp_sal )   THEN 
     103         DO ib = 1, idx%nblenrim(igrd) 
     104            ii = idx%nbi(ib,igrd) 
     105            ij = idx%nbj(ib,igrd) 
     106            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
     107            pta(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1) 
    109108         END DO 
    110       END DO 
     109      END IF 
    111110      ! 
    112111   END SUBROUTINE bdy_rnf 
    … …  
    137136               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    138137               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     138               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove 
    139139               zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 
    140140               DO ik = 1, jpkm1 

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

    r10481 r11048  
    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... 
    101102            zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * pua2d(ii,ij) * e2u(ii,ij) * phu(ii,ij) * tmask_i(ii,ij) * tmask_i(ii+1,ij) 
    102103         END DO 
    … …  
    105106            ii = idx%nbi(jb,jgrd) 
    106107            ij = idx%nbj(jb,jgrd) 
     108            IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    107109            zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * pva2d(ii,ij) * e1v(ii,ij) * phv(ii,ij) * tmask_i(ii,ij) * tmask_i(ii,ij+1) 
    108110         END DO 
    … …  
    126128               ii = idx%nbi(jb,jgrd) 
    127129               ij = idx%nbj(jb,jgrd) 
     130               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! sum : else halo couted twice 
    128131               pua2d(ii,ij) = pua2d(ii,ij) - idx%flagu(jb,jgrd) * zubtpecor * tmask_i(ii,ij) * tmask_i(ii+1,ij) 
    129132         END DO 
    … …  
    132135               ii = idx%nbi(jb,jgrd) 
    133136               ij = idx%nbj(jb,jgrd) 
     137               IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! sum : else halo couted twice 
    134138               pva2d(ii,ij) = pva2d(ii,ij) - idx%flagv(jb,jgrd) * zubtpecor * tmask_i(ii,ij) * tmask_i(ii,ij+1) 
    135139         END DO 
    … …  
    150154                  ii = idx%nbi(jb,jgrd) 
    151155                  ij = idx%nbj(jb,jgrd) 
     156                  IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    152157                  ztranst = ztranst + idx%flagu(jb,jgrd) * pua2d(ii,ij) * e2u(ii,ij) * phu(ii,ij) * tmask_i(ii,ij) * tmask_i(ii+1,ij) 
    153158            END DO 
    … …  
    156161                  ii = idx%nbi(jb,jgrd) 
    157162                  ij = idx%nbj(jb,jgrd) 
     163                  IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE   ! to remove? 
    158164                  ztranst = ztranst + idx%flagv(jb,jgrd) * pva2d(ii,ij) * e1v(ii,ij) * phv(ii,ij) * tmask_i(ii,ij) * tmask_i(ii,ij+1) 
    159165            END DO 
    … …  
    195201            nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    196202            nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     203            IF( nbi == 1 .OR. nbi == jpi .OR. nbj == 1 .OR. nbj == jpj )  CYCLE 
    197204            zflagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 
    198205            bdy_segs_surf = bdy_segs_surf + phu(nbi, nbj)                              & 
    … …  
    207214            nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    208215            nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     216            IF( nbi == 1 .OR. nbi == jpi .OR. nbj == 1 .OR. nbj == jpj )  CYCLE 
    209217            zflagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 
    210218            bdy_segs_surf = bdy_segs_surf + phv(nbi, nbj)                              & 

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

    r11024 r11048  
    120120                  igrd = 1           ! compensating null velocity on the bdy 
    121121                  DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    122                      ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 2 to jpi-1 
    123                      jj   = idx_bdy(ib_bdy)%nbj(jb,igrd)   ! maximum extent : from 2 to jpj-1 
     122                     ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 1 to jpi 
     123                     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? 
    124125                     DO jk = 1, jpkm1 
    125126                        zhke(ji,jj,jk) = 0._wp 
    … …  
    161162                  igrd = 1           ! compensation null velocity on land at the bdy 
    162163                  DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    163                      ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 2 to jpi-1 
    164                      jj   = idx_bdy(ib_bdy)%nbj(jb,igrd)   ! maximum extent : from 2 to jpj-1 
     164                     ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 1 to jpi 
     165                     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 
    165167                     DO jk = 1, jpkm1 
    166168                        zhke(ji,jj,jk) = 0._wp 
Note: See TracChangeset for help on using the changeset viewer.