Changeset 11195


Ignore:
Timestamp:
2019-06-28T12:59:32+02:00 (14 months ago)
Author:
girrmann
Message:

dev_r10984_HPC-13 : update of trc_bdy following [11191], merge of lbc_lnk and lbc_bdy_lnk in a single lbc_lnk routine, see #2285

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

Legend:

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

    r11191 r11195  
    100100         END DO 
    101101         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    102             CALL lbc_bdy_lnk( 'bdydyn2d', llsend2, llrecv2, pua2d, 'U', -1. ) 
     102            CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
    103103         END IF 
    104104         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    105             CALL lbc_bdy_lnk( 'bdydyn2d', llsend3, llrecv3, pva2d, 'V', -1. ) 
     105            CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
    106106         END IF 
    107107         ! 
    108       END DO 
     108      END DO   ! ir 
    109109      ! 
    110110   END SUBROUTINE bdy_dyn2d 
     
    322322         END DO 
    323323         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    324             CALL lbc_bdy_lnk( 'bdydyn2d', llsend1, llrecv1, zssh(:,:,1), 'T',  1. ) 
     324            CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    325325         END IF 
    326326      END DO 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90

    r11191 r11195  
    9494         ! 
    9595         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    96             CALL lbc_bdy_lnk( 'bdydyn2d', llsend2, llrecv2, ua, 'U', -1. ) 
     96            CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
    9797         END IF 
    9898         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    99             CALL lbc_bdy_lnk( 'bdydyn2d', llsend3, llrecv3, va, 'V', -1. ) 
    100          END IF 
    101       END DO 
     99            CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     100         END IF 
     101      END DO   ! ir 
    102102      ! 
    103103   END SUBROUTINE bdy_dyn3d 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyice.F90

    r11191 r11195  
    9292         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    9393            ! exchange 3d arrays 
    94             CALL lbc_bdy_lnk_multi( 'bdyice', llsend1, llrecv1, a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1. & 
    95                  &                                            , oa_i, 'T', 1., a_ip, 'T', 1., v_ip, 'T', 1. & 
    96                  &                                            , s_i , 'T', 1., t_su, 'T', 1., v_i , 'T', 1. & 
    97                  &                                            , v_s , 'T', 1., sv_i, 'T', 1.                ) 
    98             ! exchange 4d arrays 
    99             CALL lbc_bdy_lnk_multi( 'bdyice', llsend1, llrecv1, t_s , 'T', 1., e_s , 'T', 1. )   ! third dimension = 1 
    100             CALL lbc_bdy_lnk_multi( 'bdyice', llsend1, llrecv1, t_i , 'T', 1., e_i , 'T', 1. )   ! third dimension = jpk 
     94            CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1. & 
     95                 &                      , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1. & 
     96                 &                      , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.                & 
     97                 &                      , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1      ) 
     98            ! exchange 4d arrays :   third dimension = 1   and then   third dimension = jpk 
     99            CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     100            CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1., e_i , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    101101         END IF 
    102102      END DO   ! ir 
     
    414414            END DO 
    415415            IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    416                CALL lbc_bdy_lnk( 'bdyice', llsend2, llrecv2, u_ice, 'U', -1. ) 
     416               CALL lbc_lnk( 'bdyice', u_ice, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
    417417            END IF 
    418418         CASE ( 'V' ) 
     
    427427            END DO 
    428428            IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    429                CALL lbc_bdy_lnk( 'bdyice', llsend3, llrecv3, v_ice, 'V', -1. ) 
     429               CALL lbc_lnk( 'bdyice', v_ice, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
    430430            END IF 
    431431         END SELECT 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdytra.F90

    r11191 r11195  
    9898         END DO 
    9999         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    100             CALL lbc_bdy_lnk( 'bdytra', llsend1, llrecv1, tsa, 'T',  1. ) 
     100            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    101101         END IF 
    102       END DO 
     102         ! 
     103      END DO   ! ir 
    103104      ! 
    104105   END SUBROUTINE bdy_tra 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynkeg.F90

    r11191 r11195  
    147147    
    148148            IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    149                CALL lbc_bdy_lnk( 'bdydyn2d', llsend1, llrecv1, zhke, 'T',  1. ) 
     149               CALL lbc_lnk( 'bdydyn2d', zhke, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    150150            END IF 
    151151         END IF 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r11192 r11195  
    1515#endif 
    1616 
    17 #if defined IS_BDY 
    18    SUBROUTINE ROUTINE_MULTI( cdname, lsend, lrecv                                                               & 
    19       &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   & 
    20       &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
    21       &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
    22       &                    , kfillmode, pfillval ) 
    23       LOGICAL, DIMENSION(4)        , INTENT(in   ) ::   lsend, lrecv   ! indicate how communications are to be carried out 
    24 #else 
    2517   SUBROUTINE ROUTINE_MULTI( cdname                                                                             & 
    2618      &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   & 
    2719      &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
    2820      &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
    29       &                    , kfillmode, pfillval ) 
    30 #endif 
     21      &                    , kfillmode, pfillval, lsend, lrecv ) 
    3122      !!--------------------------------------------------------------------- 
    3223      CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine 
     
    3930      INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant) 
    4031      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries) 
     32      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out 
    4133      !! 
    4234      INTEGER                          ::   kfld        ! number of elements that will be attributed 
     
    6355      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    6456      ! 
    65 #if defined IS_BDY 
    66       CALL lbc_bdy_lnk_ptr( cdname, lsend, lrecv, ptab_ptr, cdna_ptr, psgn_ptr, kfld                      ) 
    67 #else  
    68       CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval ) 
    69 #endif 
     57      CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 
    7058      ! 
    7159   END SUBROUTINE ROUTINE_MULTI 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbclnk.F90

    r11194 r11195  
    3737   END INTERFACE 
    3838   ! 
    39    INTERFACE lbc_bdy_lnk 
    40       MODULE PROCEDURE   mpp_lnk_bdy_2d      , mpp_lnk_bdy_3d      , mpp_lnk_bdy_4d 
    41    END INTERFACE 
    42    INTERFACE lbc_bdy_lnk_ptr 
    43       MODULE PROCEDURE   mpp_lnk_bdy_2d_ptr  , mpp_lnk_bdy_3d_ptr  , mpp_lnk_bdy_4d_ptr 
    44    END INTERFACE 
    45    INTERFACE lbc_bdy_lnk_multi 
    46       MODULE PROCEDURE   lbc_lnk_bdy_2d_multi, lbc_lnk_bdy_3d_multi, lbc_lnk_bdy_4d_multi 
    47    END INTERFACE 
    48    ! 
    4939   INTERFACE lbc_lnk_icb 
    5040      MODULE PROCEDURE mpp_lnk_2d_icb 
     
    5848   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions 
    5949   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 
    60    PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    61    PUBLIC   lbc_bdy_lnk_multi ! modified ocean lateral BDY boundary conditions 
    6250   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions 
    6351 
     
    10896#     undef ROUTINE_MULTI 
    10997#     undef ROUTINE_LOAD 
    110 #     define IS_BDY 
    111 #     define ROUTINE_LOAD           load_ptr_bdy_2d 
    112 #     define ROUTINE_MULTI          lbc_lnk_bdy_2d_multi 
    113 #     include "lbc_lnk_multi_generic.h90" 
    114 #     undef ROUTINE_MULTI 
    115 #     undef IS_BDY 
    116 #     undef ROUTINE_LOAD 
    11798#  undef DIM_2d 
    11899 
     
    123104#     undef ROUTINE_MULTI 
    124105#     undef ROUTINE_LOAD 
    125 #     define IS_BDY 
    126 #     define ROUTINE_LOAD           load_ptr_bdy_3d 
    127 #     define ROUTINE_MULTI          lbc_lnk_bdy_3d_multi 
    128 #     include "lbc_lnk_multi_generic.h90" 
    129 #     undef ROUTINE_MULTI 
    130 #     undef IS_BDY 
    131 #     undef ROUTINE_LOAD 
    132106#  undef DIM_3d 
    133107 
     
    137111#     include "lbc_lnk_multi_generic.h90" 
    138112#     undef ROUTINE_MULTI 
    139 #     undef ROUTINE_LOAD 
    140 #     define IS_BDY 
    141 #     define ROUTINE_LOAD           load_ptr_bdy_4d 
    142 #     define ROUTINE_MULTI          lbc_lnk_bdy_4d_multi 
    143 #     include "lbc_lnk_multi_generic.h90" 
    144 #     undef ROUTINE_MULTI 
    145 #     undef IS_BDY 
    146113#     undef ROUTINE_LOAD 
    147114#  undef DIM_4d 
     
    249216#  undef DIM_4d 
    250217 
    251    !!---------------------------------------------------------------------- 
    252    !!                   ***  routine mpp_lnk_bdy_(2,3,4)d  *** 
    253    !! 
    254    !!   * Argument : dummy argument use in mpp_lnk_... routines 
    255    !!                ptab   :   array or pointer of arrays on which the boundary condition is applied 
    256    !!                cd_nat :   nature of array grid-points 
    257    !!                psgn   :   sign used across the north fold boundary 
    258    !!                kb_bdy :   BDY boundary set 
    259    !!                kfld   :   optional, number of pt3d arrays 
    260    !!---------------------------------------------------------------------- 
    261    ! 
    262    !                       !==  2D array and array of 2D pointer  ==! 
    263    ! 
    264 #  define DIM_2d 
    265 #     define ROUTINE_BDY           mpp_lnk_bdy_2d 
    266 #     include "mpp_bdy_generic.h90" 
    267 #     undef ROUTINE_BDY 
    268 #     define MULTI 
    269 #     define ROUTINE_BDY           mpp_lnk_bdy_2d_ptr 
    270 #     include "mpp_bdy_generic.h90" 
    271 #     undef ROUTINE_BDY 
    272 #     undef MULTI 
    273 #  undef DIM_2d 
    274    ! 
    275    !                       !==  3D array and array of 3D pointer  ==! 
    276    ! 
    277 #  define DIM_3d 
    278 #     define ROUTINE_BDY           mpp_lnk_bdy_3d 
    279 #     include "mpp_bdy_generic.h90" 
    280 #     undef ROUTINE_BDY 
    281 #     define MULTI 
    282 #     define ROUTINE_BDY           mpp_lnk_bdy_3d_ptr 
    283 #     include "mpp_bdy_generic.h90" 
    284 #     undef ROUTINE_BDY 
    285 #     undef MULTI 
    286 #  undef DIM_3d 
    287    ! 
    288    !                       !==  4D array and array of 4D pointer  ==! 
    289    ! 
    290 #  define DIM_4d 
    291 #     define ROUTINE_BDY           mpp_lnk_bdy_4d 
    292 #     include "mpp_bdy_generic.h90" 
    293 #     undef ROUTINE_BDY 
    294 #     define MULTI 
    295 #     define ROUTINE_BDY           mpp_lnk_bdy_4d_ptr 
    296 #     include "mpp_bdy_generic.h90" 
    297 #     undef ROUTINE_BDY 
    298 #     undef MULTI 
    299 #  undef DIM_4d 
    300218 
    301219   !!====================================================================== 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/mpp_lnk_generic.h90

    r11194 r11195  
    4646 
    4747#if defined MULTI 
    48    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval ) 
     48   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv ) 
    4949      INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    5050#else 
    51    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval ) 
     51   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv ) 
    5252#endif 
    5353      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
    54       CHARACTER(len=*)    , INTENT(in   ) ::   cdname      ! name of the calling subroutine 
    55       CHARACTER(len=1)    , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    56       REAL(wp)            , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
    57       INTEGER , OPTIONAL  , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant) 
    58       REAL(wp), OPTIONAL  , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
     54      CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine 
     55      CHARACTER(len=1)              , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
     56      REAL(wp)                      , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     57      INTEGER , OPTIONAL            , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant) 
     58      REAL(wp), OPTIONAL            , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
     59      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc 
    5960      ! 
    6061      INTEGER  ::    ji,  jj,  jk,  jl,  jf      ! dummy loop indices 
     
    6869      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_we, zrcv_we, zsnd_ea, zrcv_ea   ! east -west  & west - east  halos 
    6970      REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_so, zrcv_so, zsnd_no, zrcv_no   ! north-south & south-north  halos 
    70       LOGICAL  ::   llcom_we, llcom_ea, llcom_no, llcom_so       ! communication done or not 
     71      LOGICAL  ::   llsend_we, llsend_ea, llsend_no, llsend_so       ! communication send 
     72      LOGICAL  ::   llrecv_we, llrecv_ea, llrecv_no, llrecv_so       ! communication receive  
    7173      LOGICAL  ::   lldo_nfd                                     ! do north pole folding 
    7274      !!---------------------------------------------------------------------- 
     
    8284      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 
    8385      ! 
    84       llcom_we = nbondi ==  1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini 
    85       llcom_ea = nbondi == -1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini 
    86       llcom_so = nbondj ==  1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini 
    87       llcom_no = nbondj == -1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini 
    88        
     86      IF     ( PRESENT(lsend) .AND. PRESENT(lrecv) ) THEN 
     87         llsend_we = lsend(1)   ;   llsend_ea = lsend(2)   ;   llsend_so = lsend(3)   ;   llsend_no = lsend(4) 
     88         llrecv_we = lrecv(1)   ;   llrecv_ea = lrecv(2)   ;   llrecv_so = lrecv(3)   ;   llrecv_no = lrecv(4) 
     89      ELSE IF( PRESENT(lsend) .OR.  PRESENT(lrecv) ) THEN 
     90         WRITE(ctmp1,*) ' E R R O R : Routine ', cdname, '  is calling lbc_lnk with only one of the two arguments lsend or lrecv' 
     91         WRITE(ctmp2,*) ' ========== ' 
     92         CALL ctl_stop( ' ', ctmp1, ctmp2, ' ' ) 
     93      ELSE   ! send and receive with every neighbour 
     94         llsend_we = nbondi ==  1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini 
     95         llsend_ea = nbondi == -1 .OR. nbondi == 0   ! keep for compatibility, should be defined in mppini 
     96         llsend_so = nbondj ==  1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini 
     97         llsend_no = nbondj == -1 .OR. nbondj == 0   ! keep for compatibility, should be defined in mppini 
     98         llrecv_we = llsend_we   ;   llrecv_ea = llsend_ea   ;   llrecv_so = llsend_so   ;   llrecv_no = llsend_no 
     99      END IF 
     100          
     101          
    89102      lldo_nfd = npolj /= 0                      ! keep for compatibility, should be defined in mppini 
    90103 
     
    93106 
    94107      ! define the method we will use to fill the halos in each direction 
    95       IF(               llcom_we ) THEN   ;   ifill_we = jpfillmpi 
     108      IF(              llrecv_we ) THEN   ;   ifill_we = jpfillmpi 
    96109      ELSEIF(           l_Iperio ) THEN   ;   ifill_we = jpfillperio 
    97110      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_we = kfillmode 
     
    99112      END IF 
    100113      ! 
    101       IF(               llcom_ea ) THEN   ;   ifill_ea = jpfillmpi 
     114      IF(              llrecv_ea ) THEN   ;   ifill_ea = jpfillmpi 
    102115      ELSEIF(           l_Iperio ) THEN   ;   ifill_ea = jpfillperio 
    103116      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_ea = kfillmode 
     
    105118      END IF 
    106119      ! 
    107       IF(               llcom_so ) THEN   ;   ifill_so = jpfillmpi 
     120      IF(              llrecv_so ) THEN   ;   ifill_so = jpfillmpi 
    108121      ELSEIF(           l_Jperio ) THEN   ;   ifill_so = jpfillperio 
    109122      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_so = kfillmode 
     
    111124      END IF 
    112125      ! 
    113       IF(               llcom_no ) THEN   ;   ifill_no = jpfillmpi 
     126      IF(              llrecv_no ) THEN   ;   ifill_no = jpfillmpi 
    114127      ELSEIF(           l_Jperio ) THEN   ;   ifill_no = jpfillperio 
    115128      ELSEIF( PRESENT(kfillmode) ) THEN   ;   ifill_no = kfillmode 
     
    131144      ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 
    132145      isize = nn_hls * jpj * ipk * ipl * ipf       
    133  
     146      ! 
    134147      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    135       IF( ifill_we == jpfillmpi ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 
    136          ! 
    137          ALLOCATE( zsnd_we(nn_hls,jpj,ipk,ipl,ipf), zrcv_we(nn_hls,jpj,ipk,ipl,ipf) ) 
     148      IF( llsend_we )   ALLOCATE( zsnd_we(nn_hls,jpj,ipk,ipl,ipf) ) 
     149      IF( llsend_ea )   ALLOCATE( zsnd_ea(nn_hls,jpj,ipk,ipl,ipf) ) 
     150      IF( llrecv_we )   ALLOCATE( zrcv_we(nn_hls,jpj,ipk,ipl,ipf) ) 
     151      IF( llrecv_ea )   ALLOCATE( zrcv_ea(nn_hls,jpj,ipk,ipl,ipf) ) 
     152      ! 
     153      IF( llsend_we ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 
    138154         ishift = nn_hls 
    139155         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     
    142158      ENDIF 
    143159      ! 
    144       IF( ifill_ea == jpfillmpi ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    145          ! 
    146          ALLOCATE( zsnd_ea(nn_hls,jpj,ipk,ipl,ipf), zrcv_ea(nn_hls,jpj,ipk,ipl,ipf) ) 
     160      IF(llsend_ea  ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    147161         ishift = jpi - 2 * nn_hls 
    148162         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     
    154168      ! 
    155169      ! non-blocking send of the western/eastern side using local temporary arrays 
    156       IF( ifill_we == jpfillmpi )   CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 
    157       IF( ifill_ea == jpfillmpi )   CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 
     170      IF( llsend_we )   CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 
     171      IF( llsend_ea )   CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 
    158172      ! blocking receive of the western/eastern halo in local temporary arrays 
    159       IF( ifill_we == jpfillmpi )   CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 
    160       IF( ifill_ea == jpfillmpi )   CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 
     173      IF( llrecv_we )   CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 
     174      IF( llrecv_ea )   CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 
    161175      ! 
    162176      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    244258      ! ---------------------------------------------------- ! 
    245259      ! 
     260      IF( llsend_so )   ALLOCATE( zsnd_so(jpi,nn_hls,ipk,ipl,ipf) ) 
     261      IF( llsend_no )   ALLOCATE( zsnd_no(jpi,nn_hls,ipk,ipl,ipf) ) 
     262      IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,nn_hls,ipk,ipl,ipf) ) 
     263      IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,nn_hls,ipk,ipl,ipf) ) 
     264      ! 
    246265      isize = jpi * nn_hls * ipk * ipl * ipf       
    247266 
    248267      ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    249       IF( ifill_so == jpfillmpi ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 
    250          ! 
    251          ALLOCATE( zsnd_so(jpi,nn_hls,ipk,ipl,ipf), zrcv_so(jpi,nn_hls,ipk,ipl,ipf) ) 
     268      IF( llsend_so ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 
    252269         ishift = nn_hls 
    253270         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     
    256273      ENDIF 
    257274      ! 
    258       IF( ifill_no == jpfillmpi ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    259          ! 
    260          ALLOCATE( zsnd_no(jpi,nn_hls,ipk,ipl,ipf), zrcv_no(jpi,nn_hls,ipk,ipl,ipf) ) 
     275      IF( llsend_no ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    261276         ishift = jpj - 2 * nn_hls 
    262277         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     
    268283      ! 
    269284      ! non-blocking send of the southern/northern side 
    270       IF( ifill_so == jpfillmpi )   CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 
    271       IF( ifill_no == jpfillmpi )   CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 
     285      IF( llsend_so )   CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 
     286      IF( llsend_no )   CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 
    272287      ! blocking receive of the southern/northern halo 
    273       IF( ifill_so == jpfillmpi )   CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso ) 
    274       IF( ifill_no == jpfillmpi )   CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono ) 
     288      IF( llrecv_so )   CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso ) 
     289      IF( llrecv_no )   CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono ) 
    275290      ! 
    276291      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    340355      ! -------------------------------------------- ! 
    341356      ! 
    342       IF( ifill_we == jpfillmpi ) THEN 
     357      IF( llsend_we ) THEN 
    343358         CALL mpi_wait(ireq_we, istat, ierr ) 
    344          DEALLOCATE( zsnd_we, zrcv_we ) 
    345       ENDIF 
    346       IF( ifill_ea == jpfillmpi )  THEN 
     359         DEALLOCATE( zsnd_we ) 
     360      ENDIF 
     361      IF( llsend_ea )  THEN 
    347362         CALL mpi_wait(ireq_ea, istat, ierr ) 
    348          DEALLOCATE( zsnd_ea, zrcv_ea ) 
    349       ENDIF 
    350       IF( ifill_so == jpfillmpi ) THEN 
     363         DEALLOCATE( zsnd_ea ) 
     364      ENDIF 
     365      IF( llsend_so ) THEN 
    351366         CALL mpi_wait(ireq_so, istat, ierr ) 
    352          DEALLOCATE( zsnd_so, zrcv_so ) 
    353       ENDIF 
    354       IF( ifill_no == jpfillmpi ) THEN 
     367         DEALLOCATE( zsnd_so ) 
     368      ENDIF 
     369      IF( llsend_no ) THEN 
    355370         CALL mpi_wait(ireq_no, istat, ierr ) 
    356          DEALLOCATE( zsnd_no, zrcv_no ) 
    357       ENDIF 
     371         DEALLOCATE( zsnd_no ) 
     372      ENDIF 
     373      ! 
     374      IF( llrecv_we )   DEALLOCATE( zrcv_we ) 
     375      IF( llrecv_ea )   DEALLOCATE( zrcv_ea ) 
     376      IF( llrecv_so )   DEALLOCATE( zrcv_so ) 
     377      IF( llrecv_no )   DEALLOCATE( zrcv_no ) 
    358378      ! 
    359379   END SUBROUTINE ROUTINE_LNK 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/TOP/trcbdy.F90

    r11071 r11195  
    2222   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    2323   USE in_out_manager               ! I/O manager 
    24    USE bdy_oce, only: idx_bdy       ! ocean open boundary conditions 
     24   USE bdy_oce                      ! ocean open boundary conditions 
    2525 
    2626   IMPLICIT NONE 
     
    4949      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc 
    5050      REAL(wp), POINTER                 ::  zfac 
     51      LOGICAL                           :: llrim0               ! indicate if rim 0 is treated 
    5152      LOGICAL, DIMENSION(4)             :: llsend1, llrecv1     ! indicate how communications are to be carried out 
    5253      !!---------------------------------------------------------------------- 
     
    5657      igrd = 1  
    5758      ! 
    58       DO ib_bdy=1, nb_bdy 
    59          DO jn = 1, jptra 
    60             ! 
    61             ztrc => trcdta_bdy(jn,ib_bdy)%trc  
    62             zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
    63             ! 
    64             SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
    65             CASE('none'        )   ;   CYCLE 
    66             CASE('frs'         )   ;   CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
    67             CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
    68             CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) ) 
    69             CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. ) 
    70             CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. ) 
    71             CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     59      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
     60         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
     61         ELSE                 ;   llrim0 = .FALSE. 
     62         END IF 
     63         DO ib_bdy=1, nb_bdy 
     64            DO jn = 1, jptra 
     65               ! 
     66               ztrc => trcdta_bdy(jn,ib_bdy)%trc  
     67               zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     68               ! 
     69               SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     70               CASE('none'        )   ;   CYCLE 
     71               CASE('frs'         )   ! treat the whole boundary at once 
     72                  IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
     73               CASE('specified'   )   ! treat the whole rim      at once 
     74                  IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
     75               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) )   ! tra masked 
     76               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. ) 
     77               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. ) 
     78               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     79               END SELECT 
     80               ! 
     81            END DO 
     82         END DO 
     83         ! 
     84         llsend1(:) = .false. 
     85         llrecv1(:) = .false. 
     86         DO ib_bdy=1, nb_bdy 
     87            SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     88            CASE('neumann') 
     89               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     90               llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     91            CASE('orlanski','orlanski_npo') 
     92               llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     93               llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    7294            END SELECT 
    73             ! 
    7495         END DO 
    75       END DO 
    76       ! 
    77       llsend1(:) = .false. 
    78       llrecv1(:) = .false. 
    79       DO ib_bdy=1, nb_bdy 
    80          SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
    81          CASE('neumann') 
    82             llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:)   ! possibly every direction, T points 
    83             llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:)   ! possibly every direction, T points 
    84          CASE('orlanski','orlanski_npo') 
    85             llsend1(:) = llsend1(:) .OR. lsend_bdy(ib_bdy,1,:)   ! possibly every direction, T points 
    86             llrecv1(:) = llrecv1(:) .OR. lrecv_bdy(ib_bdy,1,:)   ! possibly every direction, T points 
    87          END SELECT 
    88       END DO 
    89       IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    90          CALL lbc_bdy_lnk( 'bdytra', llsend1, llrecv1, tsa, 'T',  1. ) 
    91       END IF 
     96         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
     97            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     98         END IF 
     99         ! 
     100      END DO   ! ir 
    92101      ! 
    93102      IF( ln_timing )   CALL timing_stop('trc_bdy') 
Note: See TracChangeset for help on using the changeset viewer.