- Timestamp:
- 2019-05-29T11:34:32+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC
- Files:
-
- 4 edited
-
lbc_lnk_multi_generic.h90 (modified) (3 diffs)
-
lbclnk.F90 (modified) (3 diffs)
-
lib_mpp.F90 (modified) (5 diffs)
-
mpp_bdy_generic.h90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbc_lnk_multi_generic.h90
r10425 r11067 14 14 # define PTR_ptab pt4d 15 15 #endif 16 SUBROUTINE ROUTINE_MULTI( cdname & 17 & , pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3 & 18 & , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6 & 19 & , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval) 16 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 & , cd_mpp, pval ) 23 LOGICAL, DIMENSION(4) , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 24 #else 25 SUBROUTINE ROUTINE_MULTI( cdname & 26 & , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4 & 27 & , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8 & 28 & , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11 & 29 & , cd_mpp, pval ) 30 #endif 20 31 !!--------------------------------------------------------------------- 21 CHARACTER(len=*) , INTENT(in ) :: 22 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: 23 ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt924 CHARACTER(len=1) , INTENT(in ) :: 25 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna926 REAL(wp) , INTENT(in ) :: 27 REAL(wp) , OPTIONAL , INTENT(in ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn928 CHARACTER(len=3) , OPTIONAL , INTENT(in ) :: 29 REAL(wp) , OPTIONAL , INTENT(in ) :: 32 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 33 ARRAY_TYPE(:,:,:,:) , TARGET, INTENT(inout) :: pt1 ! arrays on which the lbc is applied 34 ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9 , pt10 , pt11 35 CHARACTER(len=1) , INTENT(in ) :: cdna1 ! nature of pt2D. array grid-points 36 CHARACTER(len=1) , OPTIONAL , INTENT(in ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11 37 REAL(wp) , INTENT(in ) :: psgn1 ! sign used across the north fold 38 REAL(wp) , OPTIONAL , INTENT(in ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11 39 CHARACTER(len=3) , OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 40 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 30 41 !! 31 INTEGER :: kfld ! number of elements that will be attributed32 PTR_TYPE , DIMENSION( 9) :: ptab_ptr ! pointer array33 CHARACTER(len=1) , DIMENSION( 9) :: cdna_ptr ! nature of ptab_ptr grid-points34 REAL(wp) , DIMENSION( 9) :: psgn_ptr ! sign used across the north fold boundary42 INTEGER :: kfld ! number of elements that will be attributed 43 PTR_TYPE , DIMENSION(11) :: ptab_ptr ! pointer array 44 CHARACTER(len=1) , DIMENSION(11) :: cdna_ptr ! nature of ptab_ptr grid-points 45 REAL(wp) , DIMENSION(11) :: psgn_ptr ! sign used across the north fold boundary 35 46 !!--------------------------------------------------------------------- 36 47 ! … … 41 52 ! 42 53 ! ! Look if more arrays are added 43 IF( PRESENT(psgn2) ) CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 44 IF( PRESENT(psgn3) ) CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 45 IF( PRESENT(psgn4) ) CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 46 IF( PRESENT(psgn5) ) CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 47 IF( PRESENT(psgn6) ) CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 48 IF( PRESENT(psgn7) ) CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 49 IF( PRESENT(psgn8) ) CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 50 IF( PRESENT(psgn9) ) CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 54 IF( PRESENT(psgn2 ) ) CALL ROUTINE_LOAD( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 55 IF( PRESENT(psgn3 ) ) CALL ROUTINE_LOAD( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 56 IF( PRESENT(psgn4 ) ) CALL ROUTINE_LOAD( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 57 IF( PRESENT(psgn5 ) ) CALL ROUTINE_LOAD( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 58 IF( PRESENT(psgn6 ) ) CALL ROUTINE_LOAD( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 59 IF( PRESENT(psgn7 ) ) CALL ROUTINE_LOAD( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 60 IF( PRESENT(psgn8 ) ) CALL ROUTINE_LOAD( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 61 IF( PRESENT(psgn9 ) ) CALL ROUTINE_LOAD( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 62 IF( PRESENT(psgn10) ) CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 63 IF( PRESENT(psgn11) ) CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 51 64 ! 52 CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval ) 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, cd_mpp, pval ) 69 #endif 53 70 ! 54 71 END SUBROUTINE ROUTINE_MULTI … … 72 89 ! 73 90 END SUBROUTINE ROUTINE_LOAD 91 74 92 #undef ARRAY_TYPE 75 93 #undef PTR_TYPE -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbclnk.F90
r10425 r11067 38 38 ! 39 39 INTERFACE lbc_bdy_lnk 40 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 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 41 47 END INTERFACE 42 48 ! … … 45 51 END INTERFACE 46 52 47 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 48 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 49 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 50 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 53 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 54 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 55 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 56 PUBLIC lbc_bdy_lnk_multi ! modified ocean lateral BDY boundary conditions 57 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 51 58 52 59 !!---------------------------------------------------------------------- … … 256 263 257 264 # define DIM_2d 265 # define ROUTINE_LOAD load_ptr_2d 258 266 # define ROUTINE_MULTI lbc_lnk_2d_multi 259 # define ROUTINE_LOAD load_ptr_2d 260 # include "lbc_lnk_multi_generic.h90" 261 # undef ROUTINE_MULTI 267 # include "lbc_lnk_multi_generic.h90" 268 # undef ROUTINE_MULTI 269 # undef ROUTINE_LOAD 270 # define IS_BDY 271 # define ROUTINE_LOAD load_ptr_bdy_2d 272 # define ROUTINE_MULTI lbc_lnk_bdy_2d_multi 273 # include "lbc_lnk_multi_generic.h90" 274 # undef ROUTINE_MULTI 275 # undef IS_BDY 262 276 # undef ROUTINE_LOAD 263 277 # undef DIM_2d 264 278 265 266 279 # define DIM_3d 280 # define ROUTINE_LOAD load_ptr_3d 267 281 # define ROUTINE_MULTI lbc_lnk_3d_multi 268 # define ROUTINE_LOAD load_ptr_3d 269 # include "lbc_lnk_multi_generic.h90" 270 # undef ROUTINE_MULTI 282 # include "lbc_lnk_multi_generic.h90" 283 # undef ROUTINE_MULTI 284 # undef ROUTINE_LOAD 285 # define IS_BDY 286 # define ROUTINE_LOAD load_ptr_bdy_3d 287 # define ROUTINE_MULTI lbc_lnk_bdy_3d_multi 288 # include "lbc_lnk_multi_generic.h90" 289 # undef ROUTINE_MULTI 290 # undef IS_BDY 271 291 # undef ROUTINE_LOAD 272 292 # undef DIM_3d 273 293 274 275 294 # define DIM_4d 295 # define ROUTINE_LOAD load_ptr_4d 276 296 # define ROUTINE_MULTI lbc_lnk_4d_multi 277 # define ROUTINE_LOAD load_ptr_4d 278 # include "lbc_lnk_multi_generic.h90" 279 # undef ROUTINE_MULTI 297 # include "lbc_lnk_multi_generic.h90" 298 # undef ROUTINE_MULTI 299 # undef ROUTINE_LOAD 300 # define IS_BDY 301 # define ROUTINE_LOAD load_ptr_bdy_4d 302 # define ROUTINE_MULTI lbc_lnk_bdy_4d_multi 303 # include "lbc_lnk_multi_generic.h90" 304 # undef ROUTINE_MULTI 305 # undef IS_BDY 280 306 # undef ROUTINE_LOAD 281 307 # undef DIM_4d 282 308 309 283 310 !!====================================================================== 284 311 END MODULE lbclnk -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lib_mpp.F90
r10982 r11067 69 69 70 70 ! Interface associated to the mpp_lnk_... routines is defined in lbclnk 71 PUBLIC mpp_lnk_2d , mpp_lnk_3d , mpp_lnk_4d 72 PUBLIC mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr 71 PUBLIC mpp_lnk_2d , mpp_lnk_3d , mpp_lnk_4d 72 PUBLIC mpp_lnk_2d_ptr , mpp_lnk_3d_ptr , mpp_lnk_4d_ptr 73 PUBLIC mpp_lnk_bdy_2d , mpp_lnk_bdy_3d , mpp_lnk_bdy_4d 74 PUBLIC mpp_lnk_bdy_2d_ptr, mpp_lnk_bdy_3d_ptr, mpp_lnk_bdy_4d_ptr 73 75 ! 74 76 !!gm this should be useless … … 87 89 PUBLIC mpp_ini_znl 88 90 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 89 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d90 91 91 92 !! * Interfaces … … 451 452 # include "mpp_bdy_generic.h90" 452 453 # undef ROUTINE_BDY 454 # define MULTI 455 # define ROUTINE_BDY mpp_lnk_bdy_2d_ptr 456 # include "mpp_bdy_generic.h90" 457 # undef ROUTINE_BDY 458 # undef MULTI 453 459 # undef DIM_2d 454 460 ! … … 459 465 # include "mpp_bdy_generic.h90" 460 466 # undef ROUTINE_BDY 467 # define MULTI 468 # define ROUTINE_BDY mpp_lnk_bdy_3d_ptr 469 # include "mpp_bdy_generic.h90" 470 # undef ROUTINE_BDY 471 # undef MULTI 461 472 # undef DIM_3d 462 473 ! … … 467 478 # include "mpp_bdy_generic.h90" 468 479 # undef ROUTINE_BDY 480 # define MULTI 481 # define ROUTINE_BDY mpp_lnk_bdy_4d_ptr 482 # include "mpp_bdy_generic.h90" 483 # undef ROUTINE_BDY 484 # undef MULTI 469 485 # undef DIM_4d 470 486 -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/mpp_bdy_generic.h90
r10629 r11067 1 #if defined MULTI 2 # define NAT_IN(k) cd_nat(k) 3 # define SGN_IN(k) psgn(k) 4 # define F_SIZE(ptab) kfld 5 # define OPT_K(k) ,ipf 6 # if defined DIM_2d 7 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_2D) , INTENT(inout) :: ptab(f) 8 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt2d(i,j) 9 # define K_SIZE(ptab) 1 10 # define L_SIZE(ptab) 1 11 # endif 12 # if defined DIM_3d 13 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_3D) , INTENT(inout) :: ptab(f) 14 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt3d(i,j,k) 15 # define K_SIZE(ptab) SIZE(ptab(1)%pt3d,3) 16 # define L_SIZE(ptab) 1 17 # endif 18 # if defined DIM_4d 19 # define ARRAY_TYPE(i,j,k,l,f) TYPE(PTR_4D) , INTENT(inout) :: ptab(f) 20 # define ARRAY_IN(i,j,k,l,f) ptab(f)%pt4d(i,j,k,l) 21 # define K_SIZE(ptab) SIZE(ptab(1)%pt4d,3) 22 # define L_SIZE(ptab) SIZE(ptab(1)%pt4d,4) 23 # endif 24 #else 1 25 # define ARRAY_TYPE(i,j,k,l,f) REAL(wp) , INTENT(inout) :: ARRAY_IN(i,j,k,l,f) 2 26 # define NAT_IN(k) cd_nat 3 27 # define SGN_IN(k) psgn 4 # define IBD_IN(k) kb_bdy5 28 # define F_SIZE(ptab) 1 6 29 # define OPT_K(k) … … 20 43 # define L_SIZE(ptab) SIZE(ptab,4) 21 44 # endif 22 23 SUBROUTINE ROUTINE_BDY( cdname, ptab, cd_nat, psgn , kb_bdy ) 45 #endif 24 46 !!---------------------------------------------------------------------- 25 !! *** routine mpp_lnk_bdy _3d***47 !! *** routine mpp_lnk_bdy *** 26 48 !! 27 49 !! ** Purpose : Message passing management … … 32 54 !! nlci : first dimension of the local subdomain 33 55 !! nlcj : second dimension of the local subdomain 34 !! nbondi_bdy : mark for "east-west local boundary"35 !! nbondj_bdy : mark for "north-south local boundary"36 56 !! noea : number for local neighboring processors 37 57 !! nowe : number for local neighboring processors … … 42 62 !! 43 63 !!---------------------------------------------------------------------- 44 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 64 #if defined MULTI 65 SUBROUTINE ROUTINE_BDY( cdname, lsend, lrecv, ptab, cd_nat, psgn, kfld ) 66 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 67 #else 68 SUBROUTINE ROUTINE_BDY( cdname, lsend, lrecv, ptab, cd_nat, psgn ) 69 #endif 70 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 45 71 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied 46 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points47 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary48 INTEGER , INTENT(in ) :: IBD_IN(:) ! BDY boundary set72 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 73 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 74 LOGICAL, DIMENSION(4) , INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 49 75 ! 50 76 INTEGER :: ji, jj, jk, jl, jh, jf ! dummy loop indices … … 52 78 INTEGER :: imigr, iihom, ijhom ! local integers 53 79 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 54 REAL(wp) :: zland ! local scalar55 80 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 56 ! 57 REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 58 REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 81 LOGICAL :: llsend_we, llsend_ea, llsend_no, llsend_so ! communication send 82 LOGICAL :: llrecv_we, llrecv_ea, llrecv_no, llrecv_so ! communication receive 83 ! 84 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsend_no, zsend_so ! 3d for north-south & south-north send 85 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zsend_ea, zsend_we ! 3d for east-west & west-east send 86 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zrecv_no, zrecv_so ! 3d for north-south & south-north receive 87 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zrecv_ea, zrecv_we ! 3d for east-west & west-east receive 59 88 !!---------------------------------------------------------------------- 60 89 ! … … 62 91 ipl = L_SIZE(ptab) ! 4th - 63 92 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 93 llsend_we = lsend(1); llsend_ea = lsend(2); llsend_so = lsend(3); llsend_no = lsend(4); 94 llrecv_we = lrecv(1); llrecv_ea = lrecv(2); llrecv_so = lrecv(3); llrecv_no = lrecv(4); 64 95 ! 65 96 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 66 ! 67 ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2), & 68 & zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) ) 69 70 zland = 0._wp 97 71 98 72 99 ! 1. standard boundary treatment 73 100 ! ------------------------------ 74 ! 101 ! Bdy treatment does not update land points 75 102 DO jf = 1, ipf ! number of arrays to be treated 76 ! 77 ! ! East-West boundaries 78 ! 79 IF( nbondi == 2) THEN ! neither subdomain to the east nor to the west 80 ! !* Cyclic 103 IF( nbondi == 2 ) THEN ! neither subdomain to the east nor to the west 104 ! !* Cyclic East-West boundaries 81 105 IF( l_Iperio ) THEN 82 106 ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf) 83 107 ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN( 2 ,:,:,:,jf) 84 ELSE !* Closed 85 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN( 1 :nn_hls,:,:,:,jf) = zland ! east except F-point 86 ARRAY_IN(nlci-nn_hls+1:jpi ,:,:,:,jf) = zland ! west 87 ENDIF 88 ELSEIF(nbondi == -1) THEN ! subdomain to the east only 89 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(1:nn_hls,:,:,:,jf) = zland ! south except F-point 90 ! 91 ELSEIF(nbondi == 1) THEN ! subdomain to the west only 92 ARRAY_IN(nlci-nn_hls+1:jpi,:,:,:,jf) = zland ! north 93 ENDIF 94 ! ! North-South boundaries 95 ! 108 END IF 109 END IF 96 110 IF( nbondj == 2) THEN ! neither subdomain to the north nor to the south 97 ! !* Cyclic 111 ! !* Cyclic North-South boundaries 98 112 IF( l_Jperio ) THEN 99 113 ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:,jpjm1,:,:,jf) 100 114 ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:, 2 ,:,:,jf) 101 ELSE !* Closed 102 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:, 1 :nn_hls,:,:,jf) = zland ! east except F-point 103 ARRAY_IN(:,nlcj-nn_hls+1:jpj ,:,:,jf) = zland ! west 104 ENDIF 105 ELSEIF(nbondj == -1) THEN ! subdomain to the east only 106 IF( .NOT. NAT_IN(jf) == 'F' ) ARRAY_IN(:,1:nn_hls,:,:,jf) = zland ! south except F-point 107 ! 108 ELSEIF(nbondj == 1) THEN ! subdomain to the west only 109 ARRAY_IN(:,nlcj-nn_hls+1:jpj,:,:,jf) = zland ! north 110 ENDIF 111 ! 115 END IF 116 END IF 112 117 END DO 118 113 119 114 120 ! 2. East and west directions exchange … … 116 122 ! we play with the neigbours AND the row number because of the periodicity 117 123 ! 118 ! 119 DO jf = 1, ipf 120 SELECT CASE ( nbondi_bdy(IBD_IN(jf)) ) ! Read Dirichlet lateral conditions 121 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 122 iihom = nlci-nreci 123 DO jl = 1, ipl 124 DO jk = 1, ipk 125 DO jh = 1, nn_hls 126 zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf) 127 zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf) 128 END DO 129 END DO 130 END DO 131 END SELECT 132 ! 133 ! ! Migrations 134 !!gm imigr = nn_hls * jpj * ipk * ipl * ipf 135 imigr = nn_hls * jpj * ipk * ipl 136 ! 137 IF( ln_timing ) CALL tic_tac(.TRUE.) 138 ! 139 SELECT CASE ( nbondi_bdy(IBD_IN(jf)) ) 140 CASE ( -1 ) 141 CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 ) 142 CASE ( 0 ) 143 CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 ) 144 CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 ) 145 CASE ( 1 ) 146 CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 ) 147 END SELECT 148 ! 149 SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) ) 150 CASE ( -1 ) 151 CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea ) 152 CASE ( 0 ) 153 CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea ) 154 CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe ) 155 CASE ( 1 ) 156 CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe ) 157 END SELECT 158 ! 159 SELECT CASE ( nbondi_bdy(IBD_IN(jf)) ) 160 CASE ( -1 ) 161 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 162 CASE ( 0 ) 163 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 164 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 165 CASE ( 1 ) 166 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 167 END SELECT 168 ! 169 IF( ln_timing ) CALL tic_tac(.FALSE.) 170 ! 171 ! ! Write Dirichlet lateral conditions 124 IF( llsend_we ) ALLOCATE( zsend_we(jpj,nn_hls,ipk,ipl,ipf) ) 125 IF( llsend_ea ) ALLOCATE( zsend_ea(jpj,nn_hls,ipk,ipl,ipf) ) 126 IF( llrecv_we ) ALLOCATE( zrecv_we(jpj,nn_hls,ipk,ipl,ipf) ) 127 IF( llrecv_ea ) ALLOCATE( zrecv_ea(jpj,nn_hls,ipk,ipl,ipf) ) 128 ! 129 ! Load arrays to the east and to the west to be sent 130 IF( llsend_we ) THEN ! Read Dirichlet lateral conditions 131 DO jf = 1, ipf 132 DO jl = 1, ipl 133 DO jk = 1, ipk 134 DO jh = 1, nn_hls 135 zsend_we(:,jh,jk,jl,jf) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf) 136 END DO 137 END DO 138 END DO 139 END DO 140 END IF 141 ! 142 IF( llsend_ea ) THEN ! Read Dirichlet lateral conditions 143 iihom = nlci-nreci 144 DO jf = 1, ipf 145 DO jl = 1, ipl 146 DO jk = 1, ipk 147 DO jh = 1, nn_hls 148 zsend_ea(:,jh,jk,jl,jf) = ARRAY_IN(iihom +jh,:,jk,jl,jf) 149 END DO 150 END DO 151 END DO 152 END DO 153 END IF 154 ! 155 ! Send/receive arrays to the east and to the west 156 imigr = nn_hls * jpj * ipk * ipl * ipf ! Migrations 157 ! 158 IF( ln_timing ) CALL tic_tac(.TRUE.) 159 ! 160 IF( llsend_ea ) CALL mppsend( 2, zsend_ea(1,1,1,1,1), imigr, noea, ml_req1 ) 161 IF( llsend_we ) CALL mppsend( 1, zsend_we(1,1,1,1,1), imigr, nowe, ml_req2 ) 162 ! 163 IF( llrecv_ea ) CALL mpprecv( 1, zrecv_ea(1,1,1,1,1), imigr, noea ) 164 IF( llrecv_we ) CALL mpprecv( 2, zrecv_we(1,1,1,1,1), imigr, nowe ) 165 ! 166 IF( l_isend .AND. llsend_ea ) CALL mpi_wait(ml_req1, ml_stat, ml_err) 167 IF( l_isend .AND. llsend_we ) CALL mpi_wait(ml_req2, ml_stat, ml_err) 168 ! 169 IF( ln_timing ) CALL tic_tac(.FALSE.) 170 ! 171 ! ! Write Dirichlet lateral conditions 172 ! Update with the received arrays 173 IF( llrecv_we ) THEN 174 DO jf = 1, ipf 175 DO jl = 1, ipl 176 DO jk = 1, ipk 177 DO jh = 1, nn_hls 178 ARRAY_IN( jh,:,jk,jl,jf) = zrecv_we(:,jh,jk,jl,jf) 179 END DO 180 END DO 181 END DO 182 END DO 183 END IF 184 ! 185 IF( llrecv_ea ) THEN 172 186 iihom = nlci-nn_hls 173 ! 174 ! 175 SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) ) 176 CASE ( -1 ) 177 DO jl = 1, ipl 178 DO jk = 1, ipk 179 DO jh = 1, nn_hls 180 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2) 181 END DO 182 END DO 183 END DO 184 CASE ( 0 ) 185 DO jl = 1, ipl 186 DO jk = 1, ipk 187 DO jh = 1, nn_hls 188 ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 189 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2) 190 END DO 191 END DO 192 END DO 193 CASE ( 1 ) 194 DO jl = 1, ipl 195 DO jk = 1, ipk 196 DO jh = 1, nn_hls 197 ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 198 END DO 199 END DO 200 END DO 201 END SELECT 202 ! 203 END DO 187 DO jf = 1, ipf 188 DO jl = 1, ipl 189 DO jk = 1, ipk 190 DO jh = 1, nn_hls 191 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zrecv_ea(:,jh,jk,jl,jf) 192 END DO 193 END DO 194 END DO 195 END DO 196 END IF 197 ! 198 ! Clean up 199 IF( llsend_we ) DEALLOCATE( zsend_we ) 200 IF( llsend_ea ) DEALLOCATE( zsend_ea ) 201 IF( llrecv_we ) DEALLOCATE( zrecv_we ) 202 IF( llrecv_ea ) DEALLOCATE( zrecv_ea ) 204 203 205 204 ! 3. north fold treatment … … 220 219 ! always closed : we play only with the neigbours 221 220 ! 222 DO jf = 1, ipf 223 IF( nbondj_bdy(IBD_IN(jf)) /= 2 ) THEN ! Read Dirichlet lateral conditions 224 ijhom = nlcj-nrecj 225 DO jl = 1, ipl 226 DO jk = 1, ipk 227 DO jh = 1, nn_hls 228 zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf) 229 zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf) 230 END DO 231 END DO 232 END DO 233 ENDIF 234 ! 235 ! ! Migrations 236 !!gm imigr = nn_hls * jpi * ipk * ipl * ipf 237 imigr = nn_hls * jpi * ipk * ipl 238 ! 239 IF( ln_timing ) CALL tic_tac(.TRUE.) 240 ! 241 SELECT CASE ( nbondj_bdy(IBD_IN(jf)) ) 242 CASE ( -1 ) 243 CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 ) 244 CASE ( 0 ) 245 CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 ) 246 CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 ) 247 CASE ( 1 ) 248 CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 ) 249 END SELECT 250 ! 251 SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) ) 252 CASE ( -1 ) 253 CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono ) 254 CASE ( 0 ) 255 CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono ) 256 CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso ) 257 CASE ( 1 ) 258 CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso ) 259 END SELECT 260 ! 261 SELECT CASE ( nbondj_bdy(IBD_IN(jf)) ) 262 CASE ( -1 ) 263 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 264 CASE ( 0 ) 265 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 266 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 267 CASE ( 1 ) 268 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 269 END SELECT 270 ! 271 IF( ln_timing ) CALL tic_tac(.FALSE.) 272 ! 273 ! ! Write Dirichlet lateral conditions 221 IF( llsend_so ) ALLOCATE( zsend_so(jpi,nn_hls,ipk,ipl,ipf) ) 222 IF( llsend_no ) ALLOCATE( zsend_no(jpi,nn_hls,ipk,ipl,ipf) ) 223 IF( llrecv_so ) ALLOCATE( zrecv_so(jpi,nn_hls,ipk,ipl,ipf) ) 224 IF( llrecv_no ) ALLOCATE( zrecv_no(jpi,nn_hls,ipk,ipl,ipf) ) 225 ! 226 ! Load arrays to the south and to the north to be sent 227 IF( llsend_so ) THEN ! Read Dirichlet lateral conditions 228 DO jf = 1, ipf 229 DO jl = 1, ipl 230 DO jk = 1, ipk 231 DO jh = 1, nn_hls 232 zsend_so(:,jh,jk,jl,jf) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf) 233 END DO 234 END DO 235 END DO 236 END DO 237 END IF 238 ! 239 IF( llsend_no ) THEN ! Read Dirichlet lateral conditions 240 ijhom = nlcj-nrecj 241 DO jf = 1, ipf 242 DO jl = 1, ipl 243 DO jk = 1, ipk 244 DO jh = 1, nn_hls 245 zsend_no(:,jh,jk,jl,jf) = ARRAY_IN(:,ijhom +jh,jk,jl,jf) 246 END DO 247 END DO 248 END DO 249 END DO 250 END IF 251 ! 252 ! Send/receive arrays to the south and to the north 253 imigr = nn_hls * jpi * ipk * ipl * ipf ! Migrations 254 ! 255 IF( ln_timing ) CALL tic_tac(.TRUE.) 256 ! 257 IF( llsend_no ) CALL mppsend( 4, zsend_no(1,1,1,1,1), imigr, nono, ml_req1 ) 258 IF( llsend_so ) CALL mppsend( 3, zsend_so(1,1,1,1,1), imigr, noso, ml_req2 ) 259 ! 260 IF( llrecv_no ) CALL mpprecv( 3, zrecv_no(1,1,1,1,1), imigr, nono ) 261 IF( llrecv_so ) CALL mpprecv( 4, zrecv_so(1,1,1,1,1), imigr, noso ) 262 ! 263 IF( l_isend .AND. llsend_no ) CALL mpi_wait(ml_req1, ml_stat, ml_err) 264 IF( l_isend .AND. llsend_so ) CALL mpi_wait(ml_req2, ml_stat, ml_err) 265 ! 266 IF( ln_timing ) CALL tic_tac(.FALSE.) 267 ! 268 ! ! Write Dirichlet lateral conditions 269 ! Update with the received arrays 270 IF( llrecv_so ) THEN 271 DO jf = 1, ipf 272 DO jl = 1, ipl 273 DO jk = 1, ipk 274 DO jh = 1, nn_hls 275 ARRAY_IN(:, jh,jk,jl,jf) = zrecv_so(:,jh,jk,jl,jf) 276 END DO 277 END DO 278 END DO 279 END DO 280 END IF 281 IF( llrecv_no ) THEN 274 282 ijhom = nlcj-nn_hls 275 ! 276 SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) ) 277 CASE ( -1 ) 278 DO jl = 1, ipl 279 DO jk = 1, ipk 280 DO jh = 1, nn_hls 281 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2) 282 END DO 283 END DO 284 END DO 285 CASE ( 0 ) 286 DO jl = 1, ipl 287 DO jk = 1, ipk 288 DO jh = 1, nn_hls 289 ARRAY_IN(:, jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 290 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2) 291 END DO 292 END DO 293 END DO 294 CASE ( 1 ) 295 DO jl = 1, ipl 296 DO jk = 1, ipk 297 DO jh = 1, nn_hls 298 ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 299 END DO 300 END DO 301 END DO 302 END SELECT 303 END DO 304 ! 305 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 283 DO jf = 1, ipf 284 DO jl = 1, ipl 285 DO jk = 1, ipk 286 DO jh = 1, nn_hls 287 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zrecv_no(:,jh,jk,jl,jf) 288 END DO 289 END DO 290 END DO 291 END DO 292 END IF 293 ! 294 ! Clean up 295 IF( llsend_so ) DEALLOCATE( zsend_so ) 296 IF( llsend_no ) DEALLOCATE( zsend_no ) 297 IF( llrecv_so ) DEALLOCATE( zrecv_so ) 298 IF( llrecv_no ) DEALLOCATE( zrecv_no ) 306 299 ! 307 300 END SUBROUTINE ROUTINE_BDY … … 310 303 #undef NAT_IN 311 304 #undef SGN_IN 312 #undef IBD_IN313 305 #undef ARRAY_IN 314 306 #undef K_SIZE … … 316 308 #undef F_SIZE 317 309 #undef OPT_K 310
Note: See TracChangeset
for help on using the changeset viewer.
