Changeset 11067 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/mpp_bdy_generic.h90
- Timestamp:
- 2019-05-29T11:34:32+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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.
