Changeset 11044


Ignore:
Timestamp:
2019-05-23T17:13:38+02:00 (17 months ago)
Author:
girrmann
Message:

dev_r10984_HPC-13 : missing part of [11024], see #2285

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

Legend:

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

    r11024 r11044  
    256256      !! ** Purpose : Duplicate sea level across open boundaries 
    257257      !! 
    258       !! ** Method  : - take the average of free ocean neighbours 
    259       !! 
    260       !!      ___   !      _|    !   |_____|   !   ___|    !   __|x o   !  ___|   
    261       !!   __|x     !   __|x o   !      x      !     x o   !      o     !      x o 
    262       !!      o     !      o     !      o      !     o     !            !      o  
    263       !!                                 
    264       !!            (special treatments) 
    265       !!         !   |_   _|     ! |                
    266       !!         !     |_|       ! |x o     
    267       !!         !    o x o      ! |x_x_  
    268       !!         !      o       
    269       !!---------------------------------------------------------------------- 
    270       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zssh ! Sea level 
    271       !! 
    272       INTEGER  ::   ib_bdy, ib, igrd                        ! local integers 
    273       INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   !   "       " 
    274       INTEGER  ::   flagu, flagv                            ! short cuts 
    275       REAL(wp) ::   zr_3 
    276       !!---------------------------------------------------------------------- 
    277       igrd = 1                       ! Everything is at T-points here 
    278       zr_3 = 1. / 3. 
    279       ! 
     258      !!---------------------------------------------------------------------- 
     259      REAL(wp), DIMENSION(jpi,jpj,1), INTENT(inout) ::   zssh ! Sea level, need 3 dimensions to be used by bdy_nmn 
     260      !! 
     261      INTEGER  ::   ib_bdy          ! bdy index 
     262      !!---------------------------------------------------------------------- 
    280263      DO ib_bdy = 1, nb_bdy 
    281          DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    282             ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    283             ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    284             SELECT CASE( idx_bdy(ib_bdy)%ntreat(ib,igrd) ) 
    285                CASE( 0 ) 
    286                   flagu = NINT( idx_bdy(ib_bdy)%flagu(ib,igrd) ) 
    287                   flagv = NINT( idx_bdy(ib_bdy)%flagv(ib,igrd) ) 
    288                   IF( flagu == 0 .OR. flagv == 0 )   THEN    ! linear bdy   o 
    289                      zssh(ii,ij) = zssh(ii+flagu,ij+flagv)   !           ___x___  
    290                   ELSE   !   ___  o 
    291                          !      | x o 
    292                      zssh(ii,ij) = ( zssh(ii+flagu,ij) + zssh(ii,ij+flagv) ) * 0.5 
    293                   END IF 
    294                !               !              !     _____     !     _____      
    295                !  1 |   o      !  2  o   |    !  3 | x        !  4     x |     
    296                !    |_x_ _     !    _ _x_|    !    |   o      !      o   |  
    297                CASE( 1 )   ;   zssh(ii,ij) = zssh(ii+1,ij+1) 
    298                CASE( 2 )   ;   zssh(ii,ij) = zssh(ii-1,ij+1) 
    299                CASE( 3 )   ;   zssh(ii,ij) = zssh(ii+1,ij-1) 
    300                CASE( 4 )   ;   zssh(ii,ij) = zssh(ii-1,ij-1) 
    301                !    |_  o      !        o  _|  !     ¨¨|_|¨¨   !       o          
    302                !  5  _| x o    !  6   o x |_   !  7   o x o    ! 8   o x o        
    303                !    |   o      !        o   |  !        o      !    __|¨|__       
    304                CASE( 5 )   ;   zssh(ii,ij) = ( zssh(ii  ,ij+1) + zssh(ii+1,ij  ) + zssh(ii  ,ij-1) ) * zr_3 
    305                CASE( 6 )   ;   zssh(ii,ij) = ( zssh(ii  ,ij+1) + zssh(ii-1,ij  ) + zssh(ii  ,ij-1) ) * zr_3 
    306                CASE( 7 )   ;   zssh(ii,ij) = ( zssh(ii-1,ij  ) + zssh(ii  ,ij-1) + zssh(ii+1,ij  ) ) * zr_3 
    307                CASE( 8 )   ;   zssh(ii,ij) = ( zssh(ii-1,ij  ) + zssh(ii  ,ij+1) + zssh(ii+1,ij  ) ) * zr_3 
    308             END SELECT 
    309          END DO 
    310  
    311          ! Boundary points should be updated 
    312          CALL lbc_bdy_lnk( 'bdydyn2d', zssh(:,:), 'T', 1., ib_bdy ) 
    313       END DO 
    314  
     264         CALL bdy_nmn( idx_bdy(ib_bdy), 1, zssh )   ! zssh is masked 
     265         CALL lbc_bdy_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1., ib_bdy ) 
     266      END DO 
     267      ! 
    315268   END SUBROUTINE bdy_ssh 
    316269 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyini.F90

    r11024 r11044  
    12461246      END DO 
    12471247       
    1248       ! detect corners and their orientation index 1 to 4 depending on the orientation 
    1249       ! detect geometries with 3 neighbours  index 5 to 8 depending on the orientation 
    1250       ! else                                 index 0 
     1248      ! detect corner interior and its orientation index 1 to 4  depending on the orientation 
     1249      ! detect corner exterior and its orientation index 5 to 8  depending on the orientation 
     1250      ! detect geometries with 3 neighbours        index 9 to 12 depending on the orientation 
     1251      ! else                                       index 0 
    12511252      DO ib_bdy = 1, nb_bdy 
    12521253         DO igrd = 1, jpbgrd 
     
    12591260               ii        =  idx_bdy(ib_bdy)%nbi(ib,igrd) 
    12601261               ij        =  idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1261                !IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE 
    12621262               llnobdy = pmask(ii  ,ij+1) == 1.   
    12631263               llsobdy = pmask(ii  ,ij-1) == 1.  
     
    12781278               END IF 
    12791279               IF( inbdy == 2 )   THEN   ! exterior of a corner 
    1280                   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 0   ! regular treatment with flags 
     1280                  !        o      !        o      !    _____|       !       |_____   
     1281                  !  5 ____x o    !  6   o x___   ! 7      x o      !  8   o x       
     1282                  !         |     !       |       !        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 
    12811287               END IF 
    12821288               IF( inbdy == 3 )   THEN   ! 3 neighbours __   __ 
    12831289                  !    |_  o      !        o  _|  !       |_|     !       o          
    1284                   !  5  _| x o    !  6   o x |_   !  7   o x o    ! 8   o x o        
    1285                   !    |   o      !        o   |  !        o      !    __|¨|__       
    1286                   IF( llnobdy .AND. lleabdy .AND. llsobdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 5 
    1287                   IF( llnobdy .AND. llwebdy .AND. llsobdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 6 
    1288                   IF( llwebdy .AND. llsobdy .AND. lleabdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 7 
    1289                   IF( llwebdy .AND. llnobdy .AND. lleabdy )   idx_bdy(ib_bdy)%ntreat(ib,igrd) = 8 
     1290                  !  9  _| x o    ! 10   o x |_   ! 11   o x o    ! 12  o x o        
     1291                  !    |   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 
    12901296               END IF 
    12911297               IF( inbdy == 4 )   THEN 
     
    12971303            END DO 
    12981304         END DO 
    1299          !CALL lbc_lnk( 'bdyini', )  
    13001305      END DO 
    13011306      ! 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdylib.F90

    r11024 r11044  
    7575      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
    7676      !! 
    77       REAL(wp) ::   zwgt           ! boundary weight 
    7877      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    7978      INTEGER  ::   ii, ij         ! 2D addresses 
     
    434433      !! ** Purpose : Duplicate the value at open boundaries, zero gradient. 
    435434      !!  
     435      !! 
     436      !! ** Method  : - take the average of free ocean neighbours 
     437      !! 
     438      !!      ___   !   |_____|   !   ___|    !   __|x o   !   |_   _|     ! |       
     439      !!   __|x     !      x      !     x o   !      o     !     |_|       ! |x o    
     440      !!      o     !      o      !     o     !            !    o x o      ! |x_x_  
     441      !!                                                   !      o       
    436442      !!---------------------------------------------------------------------- 
    437443      INTEGER,                    INTENT(in)     ::   igrd     ! grid index 
     
    441447      REAL(wp) ::   zweight 
    442448      REAL(wp), POINTER, DIMENSION(:,:,:)      :: pmask         ! land/sea mask for field 
    443       REAL(wp), POINTER, DIMENSION(:,:)        :: bdypmask      ! land/sea mask for field 
    444449      INTEGER  ::   ib, ik   ! dummy loop indices 
    445450      INTEGER  ::   ii, ij   ! 2D addresses 
     451      INTEGER  ::   ipkm1    ! size of phia third dimension minus 1 
    446452      INTEGER  ::   flagu, flagv                        ! short cuts 
    447453      INTEGER  ::   ii1, ii2, ii3, ij1, ij2, ij3 
    448454      !!---------------------------------------------------------------------- 
     455      ! 
     456      ipkm1 = MAX( SIZE(phia,3) - 1, 1 )  
    449457      ! 
    450458      SELECT CASE(igrd) 
     
    458466         ii = idx%nbi(ib,igrd) 
    459467         ij = idx%nbj(ib,igrd) 
     468         ! 
    460469         SELECT CASE( idx%ntreat(ib,igrd) )   ! select free ocean neighbours 
     470            !     o  
     471            !  ___x___         ! either flagu or flagv = 0 
     472            CASE( 0 )   ;   flagu = NINT( idx%flagu(ib,igrd) )   ;   ii1 = ii+flagu 
     473                            flagv = NINT( idx%flagv(ib,igrd) )   ;   ij1 = ij+flagv 
    461474            !               !              !     _____     !     _____      
    462475            !  1 |   o      !  2  o   |    !  3 | x        !  4     x |     
     
    466479            CASE( 3 )   ;   ii1 = ii+1   ;   ij1 = ij-1 
    467480            CASE( 4 )   ;   ii1 = ii-1   ;   ij1 = ij-1 
     481            !        o      !        o      !    _____|       !       |_____   
     482            !  5 ____x o    !  6   o x___   ! 7      x o      !  8   o x       
     483            !         |     !       |       !        o        !        o       
     484            CASE( 5 )   ;   ii1 = ii   ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij    
     485            CASE( 6 )   ;   ii1 = ii   ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij 
     486            CASE( 7 )   ;   ii1 = ii   ;   ij1 = ij-1   ;   ii2 = ii+1   ;   ij2 = ij   
     487            CASE( 8 )   ;   ii1 = ii   ;   ij1 = ij-1   ;   ii2 = ii-1   ;   ij2 = ij   
    468488            !    |_  o      !        o  _|  !     ¨¨|_|¨¨   !       o          
    469             !  5  _| x o    !  6   o x |_   !  7   o x o    ! 8   o x o        
     489            !  9  _| x o    !  10  o x |_   !  11  o x o    ! 12  o x o        
    470490            !    |   o      !        o   |  !        o      !    __|¨|__  
    471             CASE( 5 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1    
    472             CASE( 6 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1  
    473             CASE( 7 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij-1   ;   ii3 = ii+1   ;   ij3 = ij    
    474             CASE( 8 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij+1   ;   ii3 = ii+1   ;   ij3 = ij   
    475             CASE DEFAULT 
     491            CASE( 9  )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1    
     492            CASE( 10 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1  
     493            CASE( 11 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij-1   ;   ii3 = ii+1   ;   ij3 = ij    
     494            CASE( 12 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij+1   ;   ii3 = ii+1   ;   ij3 = ij 
    476495         END SELECT 
    477496         ! 
    478          SELECT CASE( idx%ntreat(ib,igrd) )          
    479             CASE( 0 ) 
    480                flagu = NINT( idx%flagu(ib,igrd) ) 
    481                flagv = NINT( idx%flagv(ib,igrd) ) 
    482                IF( flagu == 0 .OR. flagv == 0 )   THEN     ! linear bdy   o 
    483                    DO ik = 1, jpkm1                        !           ___x___  
    484                       IF( pmask(ii+flagu,ij+flagv,ik) /= 0. )   phia(ii,ij,ik) = phia(ii+flagu,ij+flagv,ik)   
    485                    END DO 
    486                ELSE                           
    487                   DO ik = 1, jpkm1                                              !   ___  o 
    488                      zweight = pmask(ii+flagu,ij,ik) + pmask(ii,ij+flagv,ik)    !      | x o 
    489                      IF( zweight /= 0. )   phia(ii,ij,ik) = ( phia(ii+flagu,ij,ik) + phia(ii,ij+flagv,ik) ) / zweight 
    490                   END DO 
    491                END IF 
    492             CASE( 1:4 ) 
    493                    DO ik = 1, jpkm1 
    494                       IF( pmask(ii1,ij1,ik) /= 0. )   phia(ii,ij,ik) = phia(ii1,ij1,ik)   
    495                    END DO     
     497         SELECT CASE( idx%ntreat(ib,igrd) ) 
     498            CASE( 0:4 ) 
     499               DO ik = 1, ipkm1 
     500                  IF( pmask(ii1,ij1,ik) /= 0. )   phia(ii,ij,ik) = phia(ii1,ij1,ik)   
     501               END DO 
    496502            CASE( 5:8 ) 
    497                DO ik = 1, jpkm1 
    498                   zweight        =  pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) + pmask(ii3,ij3,ik) 
     503               DO ik = 1, ipkm1 
     504                  zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) 
     505                  IF( zweight /= 0. )   phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia (ii2,ij2,ik) ) / zweight 
     506               END DO 
     507            CASE( 9:12 ) 
     508               DO ik = 1, ipkm1 
     509                  zweight = pmask(ii1,ij1,ik) + pmask(ii2,ij2,ik) + pmask(ii3,ij3,ik) 
    499510                  IF( zweight /= 0. )   phia(ii,ij,ik) = ( phia(ii1,ij1,ik) + phia (ii2,ij2,ik) + phia (ii3,ij3,ik) ) / zweight 
    500511               END DO 
    501512         END SELECT 
     513         ! 
    502514      END DO 
    503515      ! 
Note: See TracChangeset for help on using the changeset viewer.