Ignore:
Timestamp:
2019-05-21T16:07:24+02:00 (2 years ago)
Author:
girrmann
Message:

dev_r10984_HPC-13 : imrpove bdy treatment ssh and neumann, see #2285

File:
1 edited

Legend:

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

    r10983 r11024  
    131131      INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 
    132132      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
    133       INTEGER  ::   i_offset, j_offset                     !   -       - 
     133      INTEGER  ::   i_offset, j_offset, inbdy            !   -       - 
    134134      INTEGER , POINTER  ::  nbi, nbj, nbr                 ! short cuts 
    135135      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields 
     
    144144      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
    145145      REAL(wp), TARGET, DIMENSION(jpi,jpj) ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
     146      LOGICAL  ::   llnobdy, llsobdy, lleabdy, llwebdy     ! local logicals 
    146147      !! 
    147148      CHARACTER(LEN=1)                     ::   ctypebdy   !     -        -  
     
    893894            &      idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) ,   & 
    894895            &      idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ,   & 
     896            &      idx_bdy(ib_bdy)%ntreat(ilen1,jpbgrd) ,   & 
    895897            &      idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) ,   & 
    896898            &      idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) ,   & 
     
    12431245         ! 
    12441246      END DO 
     1247       
     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 
     1251      DO ib_bdy = 1, nb_bdy 
     1252         DO igrd = 1, jpbgrd 
     1253            SELECT CASE( igrd ) 
     1254               CASE( 1 )   ;   pmask => bdytmask  
     1255               CASE( 2 )   ;   pmask => bdyumask  
     1256               CASE( 3 )   ;   pmask => bdyvmask  
     1257            END SELECT 
     1258            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
     1259               ii        =  idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1260               ij        =  idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1261               !IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE 
     1262               llnobdy = pmask(ii  ,ij+1) == 1.   
     1263               llsobdy = pmask(ii  ,ij-1) == 1.  
     1264               lleabdy = pmask(ii+1,ij  ) == 1.  
     1265               llwebdy = pmask(ii-1,ij  ) == 1.  
     1266               inbdy  = COUNT( (/ llnobdy, llsobdy, lleabdy, llwebdy /) ) 
     1267               IF( inbdy == 0 )   THEN   ! no neighbours -> interior of a corner 
     1268                  !               !              !     _____     !     _____      
     1269                  !  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 
     1275               END IF 
     1276               IF( inbdy == 1 )   THEN   ! middle of linear bdy 
     1277                  idx_bdy(ib_bdy)%ntreat(ib,igrd) = 0   ! regular treatment with flags 
     1278               END IF 
     1279               IF( inbdy == 2 )   THEN   ! exterior of a corner 
     1280                  idx_bdy(ib_bdy)%ntreat(ib,igrd) = 0   ! regular treatment with flags 
     1281               END IF 
     1282               IF( inbdy == 3 )   THEN   ! 3 neighbours __   __ 
     1283                  !    |_  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               END IF 
     1291               IF( inbdy == 4 )   THEN 
     1292                  WRITE(ctmp1,*) ' E R R O R : Problem with  ',cgrid(igrd) ,' grid points,',   & 
     1293                       '  some points on boundary set ', ib_bdy, ' have 4 neighbours' 
     1294                  WRITE(ctmp2,*) ' ========== ' 
     1295                  CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     1296               END IF 
     1297            END DO 
     1298         END DO 
     1299         !CALL lbc_lnk( 'bdyini', )  
     1300      END DO 
    12451301      ! 
    12461302      ! Tidy up 
Note: See TracChangeset for help on using the changeset viewer.