Changeset 11195
- Timestamp:
- 2019-06-28T12:59:32+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src
- Files:
-
- 9 edited
-
OCE/BDY/bdydyn2d.F90 (modified) (2 diffs)
-
OCE/BDY/bdydyn3d.F90 (modified) (1 diff)
-
OCE/BDY/bdyice.F90 (modified) (3 diffs)
-
OCE/BDY/bdytra.F90 (modified) (1 diff)
-
OCE/DYN/dynkeg.F90 (modified) (1 diff)
-
OCE/LBC/lbc_lnk_multi_generic.h90 (modified) (3 diffs)
-
OCE/LBC/lbclnk.F90 (modified) (6 diffs)
-
OCE/LBC/mpp_lnk_generic.h90 (modified) (14 diffs)
-
TOP/trcbdy.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn2d.F90
r11191 r11195 100 100 END DO 101 101 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 ) 103 103 END IF 104 104 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 ) 106 106 END IF 107 107 ! 108 END DO 108 END DO ! ir 109 109 ! 110 110 END SUBROUTINE bdy_dyn2d … … 322 322 END DO 323 323 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 ) 325 325 END IF 326 326 END DO -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydyn3d.F90
r11191 r11195 94 94 ! 95 95 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 ) 97 97 END IF 98 98 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 102 102 ! 103 103 END SUBROUTINE bdy_dyn3d -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdyice.F90
r11191 r11195 92 92 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 93 93 ! 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 = 1100 CALL lbc_ bdy_lnk_multi( 'bdyice', llsend1, llrecv1, t_i , 'T', 1., e_i , 'T', 1. ) ! third dimension = jpk94 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 ) 101 101 END IF 102 102 END DO ! ir … … 414 414 END DO 415 415 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 ) 417 417 END IF 418 418 CASE ( 'V' ) … … 427 427 END DO 428 428 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 ) 430 430 END IF 431 431 END SELECT -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdytra.F90
r11191 r11195 98 98 END DO 99 99 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 ) 101 101 END IF 102 END DO 102 ! 103 END DO ! ir 103 104 ! 104 105 END SUBROUTINE bdy_tra -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynkeg.F90
r11191 r11195 147 147 148 148 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 ) 150 150 END IF 151 151 END IF -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbc_lnk_multi_generic.h90
r11192 r11195 15 15 #endif 16 16 17 #if defined IS_BDY18 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 out24 #else25 17 SUBROUTINE ROUTINE_MULTI( cdname & 26 18 & , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4 & 27 19 & , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8 & 28 20 & , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11 & 29 & , kfillmode, pfillval ) 30 #endif 21 & , kfillmode, pfillval, lsend, lrecv ) 31 22 !!--------------------------------------------------------------------- 32 23 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine … … 39 30 INTEGER , OPTIONAL , INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 40 31 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 41 33 !! 42 34 INTEGER :: kfld ! number of elements that will be attributed … … 63 55 IF( PRESENT(psgn11) ) CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 64 56 ! 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 ) 70 58 ! 71 59 END SUBROUTINE ROUTINE_MULTI -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbclnk.F90
r11194 r11195 37 37 END INTERFACE 38 38 ! 39 INTERFACE lbc_bdy_lnk40 MODULE PROCEDURE mpp_lnk_bdy_2d , mpp_lnk_bdy_3d , mpp_lnk_bdy_4d41 END INTERFACE42 INTERFACE lbc_bdy_lnk_ptr43 MODULE PROCEDURE mpp_lnk_bdy_2d_ptr , mpp_lnk_bdy_3d_ptr , mpp_lnk_bdy_4d_ptr44 END INTERFACE45 INTERFACE lbc_bdy_lnk_multi46 MODULE PROCEDURE lbc_lnk_bdy_2d_multi, lbc_lnk_bdy_3d_multi, lbc_lnk_bdy_4d_multi47 END INTERFACE48 !49 39 INTERFACE lbc_lnk_icb 50 40 MODULE PROCEDURE mpp_lnk_2d_icb … … 58 48 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 59 49 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 60 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions61 PUBLIC lbc_bdy_lnk_multi ! modified ocean lateral BDY boundary conditions62 50 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 63 51 … … 108 96 # undef ROUTINE_MULTI 109 97 # undef ROUTINE_LOAD 110 # define IS_BDY111 # define ROUTINE_LOAD load_ptr_bdy_2d112 # define ROUTINE_MULTI lbc_lnk_bdy_2d_multi113 # include "lbc_lnk_multi_generic.h90"114 # undef ROUTINE_MULTI115 # undef IS_BDY116 # undef ROUTINE_LOAD117 98 # undef DIM_2d 118 99 … … 123 104 # undef ROUTINE_MULTI 124 105 # undef ROUTINE_LOAD 125 # define IS_BDY126 # define ROUTINE_LOAD load_ptr_bdy_3d127 # define ROUTINE_MULTI lbc_lnk_bdy_3d_multi128 # include "lbc_lnk_multi_generic.h90"129 # undef ROUTINE_MULTI130 # undef IS_BDY131 # undef ROUTINE_LOAD132 106 # undef DIM_3d 133 107 … … 137 111 # include "lbc_lnk_multi_generic.h90" 138 112 # undef ROUTINE_MULTI 139 # undef ROUTINE_LOAD140 # define IS_BDY141 # define ROUTINE_LOAD load_ptr_bdy_4d142 # define ROUTINE_MULTI lbc_lnk_bdy_4d_multi143 # include "lbc_lnk_multi_generic.h90"144 # undef ROUTINE_MULTI145 # undef IS_BDY146 113 # undef ROUTINE_LOAD 147 114 # undef DIM_4d … … 249 216 # undef DIM_4d 250 217 251 !!----------------------------------------------------------------------252 !! *** routine mpp_lnk_bdy_(2,3,4)d ***253 !!254 !! * Argument : dummy argument use in mpp_lnk_... routines255 !! ptab : array or pointer of arrays on which the boundary condition is applied256 !! cd_nat : nature of array grid-points257 !! psgn : sign used across the north fold boundary258 !! kb_bdy : BDY boundary set259 !! kfld : optional, number of pt3d arrays260 !!----------------------------------------------------------------------261 !262 ! !== 2D array and array of 2D pointer ==!263 !264 # define DIM_2d265 # define ROUTINE_BDY mpp_lnk_bdy_2d266 # include "mpp_bdy_generic.h90"267 # undef ROUTINE_BDY268 # define MULTI269 # define ROUTINE_BDY mpp_lnk_bdy_2d_ptr270 # include "mpp_bdy_generic.h90"271 # undef ROUTINE_BDY272 # undef MULTI273 # undef DIM_2d274 !275 ! !== 3D array and array of 3D pointer ==!276 !277 # define DIM_3d278 # define ROUTINE_BDY mpp_lnk_bdy_3d279 # include "mpp_bdy_generic.h90"280 # undef ROUTINE_BDY281 # define MULTI282 # define ROUTINE_BDY mpp_lnk_bdy_3d_ptr283 # include "mpp_bdy_generic.h90"284 # undef ROUTINE_BDY285 # undef MULTI286 # undef DIM_3d287 !288 ! !== 4D array and array of 4D pointer ==!289 !290 # define DIM_4d291 # define ROUTINE_BDY mpp_lnk_bdy_4d292 # include "mpp_bdy_generic.h90"293 # undef ROUTINE_BDY294 # define MULTI295 # define ROUTINE_BDY mpp_lnk_bdy_4d_ptr296 # include "mpp_bdy_generic.h90"297 # undef ROUTINE_BDY298 # undef MULTI299 # undef DIM_4d300 218 301 219 !!====================================================================== -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/mpp_lnk_generic.h90
r11194 r11195 46 46 47 47 #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 ) 49 49 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 50 50 #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 ) 52 52 #endif 53 53 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 59 60 ! 60 61 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices … … 68 69 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsnd_we, zrcv_we, zsnd_ea, zrcv_ea ! east -west & west - east halos 69 70 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 71 73 LOGICAL :: lldo_nfd ! do north pole folding 72 74 !!---------------------------------------------------------------------- … … 82 84 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 83 85 ! 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 89 102 lldo_nfd = npolj /= 0 ! keep for compatibility, should be defined in mppini 90 103 … … 93 106 94 107 ! define the method we will use to fill the halos in each direction 95 IF( llcom_we ) THEN ; ifill_we = jpfillmpi108 IF( llrecv_we ) THEN ; ifill_we = jpfillmpi 96 109 ELSEIF( l_Iperio ) THEN ; ifill_we = jpfillperio 97 110 ELSEIF( PRESENT(kfillmode) ) THEN ; ifill_we = kfillmode … … 99 112 END IF 100 113 ! 101 IF( llcom_ea ) THEN ; ifill_ea = jpfillmpi114 IF( llrecv_ea ) THEN ; ifill_ea = jpfillmpi 102 115 ELSEIF( l_Iperio ) THEN ; ifill_ea = jpfillperio 103 116 ELSEIF( PRESENT(kfillmode) ) THEN ; ifill_ea = kfillmode … … 105 118 END IF 106 119 ! 107 IF( llcom_so ) THEN ; ifill_so = jpfillmpi120 IF( llrecv_so ) THEN ; ifill_so = jpfillmpi 108 121 ELSEIF( l_Jperio ) THEN ; ifill_so = jpfillperio 109 122 ELSEIF( PRESENT(kfillmode) ) THEN ; ifill_so = kfillmode … … 111 124 END IF 112 125 ! 113 IF( llcom_no ) THEN ; ifill_no = jpfillmpi126 IF( llrecv_no ) THEN ; ifill_no = jpfillmpi 114 127 ELSEIF( l_Jperio ) THEN ; ifill_no = jpfillperio 115 128 ELSEIF( PRESENT(kfillmode) ) THEN ; ifill_no = kfillmode … … 131 144 ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 132 145 isize = nn_hls * jpj * ipk * ipl * ipf 133 146 ! 134 147 ! 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 138 154 ishift = nn_hls 139 155 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls … … 142 158 ENDIF 143 159 ! 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 147 161 ishift = jpi - 2 * nn_hls 148 162 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls … … 154 168 ! 155 169 ! 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 ) 158 172 ! 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 ) 161 175 ! 162 176 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 244 258 ! ---------------------------------------------------- ! 245 259 ! 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 ! 246 265 isize = jpi * nn_hls * ipk * ipl * ipf 247 266 248 267 ! 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 252 269 ishift = nn_hls 253 270 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi … … 256 273 ENDIF 257 274 ! 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 261 276 ishift = jpj - 2 * nn_hls 262 277 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi … … 268 283 ! 269 284 ! 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 ) 272 287 ! 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 ) 275 290 ! 276 291 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 340 355 ! -------------------------------------------- ! 341 356 ! 342 IF( ifill_we == jpfillmpi) THEN357 IF( llsend_we ) THEN 343 358 CALL mpi_wait(ireq_we, istat, ierr ) 344 DEALLOCATE( zsnd_we , zrcv_we)345 ENDIF 346 IF( ifill_ea == jpfillmpi) THEN359 DEALLOCATE( zsnd_we ) 360 ENDIF 361 IF( llsend_ea ) THEN 347 362 CALL mpi_wait(ireq_ea, istat, ierr ) 348 DEALLOCATE( zsnd_ea , zrcv_ea)349 ENDIF 350 IF( ifill_so == jpfillmpi) THEN363 DEALLOCATE( zsnd_ea ) 364 ENDIF 365 IF( llsend_so ) THEN 351 366 CALL mpi_wait(ireq_so, istat, ierr ) 352 DEALLOCATE( zsnd_so , zrcv_so)353 ENDIF 354 IF( ifill_no == jpfillmpi) THEN367 DEALLOCATE( zsnd_so ) 368 ENDIF 369 IF( llsend_no ) THEN 355 370 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 ) 358 378 ! 359 379 END SUBROUTINE ROUTINE_LNK -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/TOP/trcbdy.F90
r11071 r11195 22 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 23 USE in_out_manager ! I/O manager 24 USE bdy_oce , only: idx_bdy! ocean open boundary conditions24 USE bdy_oce ! ocean open boundary conditions 25 25 26 26 IMPLICIT NONE … … 49 49 REAL(wp), POINTER, DIMENSION(:,:) :: ztrc 50 50 REAL(wp), POINTER :: zfac 51 LOGICAL :: llrim0 ! indicate if rim 0 is treated 51 52 LOGICAL, DIMENSION(4) :: llsend1, llrecv1 ! indicate how communications are to be carried out 52 53 !!---------------------------------------------------------------------- … … 56 57 igrd = 1 57 58 ! 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 72 94 END SELECT 73 !74 95 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 92 101 ! 93 102 IF( ln_timing ) CALL timing_stop('trc_bdy')
Note: See TracChangeset
for help on using the changeset viewer.
