Changeset 10425 for NEMO/trunk/src/OCE/LBC/mpp_lnk_generic.h90
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/LBC/mpp_lnk_generic.h90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/LBC/mpp_lnk_generic.h90
r10068 r10425 46 46 47 47 #if defined MULTI 48 SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn, kfld, cd_mpp, pval )48 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, cd_mpp, pval ) 49 49 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 50 50 #else 51 SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn , cd_mpp, pval )51 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn , cd_mpp, pval ) 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 54 55 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 55 56 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary … … 61 62 INTEGER :: imigr, iihom, ijhom ! local integers 62 63 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 64 INTEGER :: ierr 63 65 REAL(wp) :: zland 64 66 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend … … 71 73 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 72 74 ! 73 ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2), & 74 & zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) ) 75 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 75 76 ! 76 77 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value … … 82 83 ! ------------------------------- ! 83 84 ! 84 IF( PRESENT( cd_mpp ) ) THEN !== halos filled with inner values ==! 85 ! 86 DO jf = 1, ipf ! number of arrays to be treated 87 ! 88 DO jl = 1, ipl ! CAUTION: ptab is defined only between nld and nle 89 DO jk = 1, ipk 90 DO jj = nlcj+1, jpj ! added line(s) (inner only) 91 ARRAY_IN(nldi :nlei ,jj,jk,jl,jf) = ARRAY_IN(nldi:nlei,nlej,jk,jl,jf) 92 ARRAY_IN(1 :nldi-1,jj,jk,jl,jf) = ARRAY_IN(nldi ,nlej,jk,jl,jf) 93 ARRAY_IN(nlei+1:nlci ,jj,jk,jl,jf) = ARRAY_IN( nlei,nlej,jk,jl,jf) 94 END DO 95 DO ji = nlci+1, jpi ! added column(s) (full) 96 ARRAY_IN(ji,nldj :nlej ,jk,jl,jf) = ARRAY_IN(nlei,nldj:nlej,jk,jl,jf) 97 ARRAY_IN(ji,1 :nldj-1,jk,jl,jf) = ARRAY_IN(nlei,nldj ,jk,jl,jf) 98 ARRAY_IN(ji,nlej+1:jpj ,jk,jl,jf) = ARRAY_IN(nlei, nlej,jk,jl,jf) 99 END DO 100 END DO 101 END DO 102 ! 103 END DO 104 ! 105 ELSE !== standard close or cyclic treatment ==! 85 IF( .NOT. PRESENT( cd_mpp ) ) THEN !== standard close or cyclic treatment ==! 106 86 ! 107 87 DO jf = 1, ipf ! number of arrays to be treated … … 132 112 ! we play with the neigbours AND the row number because of the periodicity 133 113 ! 114 IF( ABS(nbondi) == 1 ) ALLOCATE( zt3ew(jpj,nn_hls,ipk,ipl,ipf,1), zt3we(jpj,nn_hls,ipk,ipl,ipf,1) ) 115 IF( nbondi == 0 ) ALLOCATE( zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2) ) 116 ! 134 117 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 135 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 118 CASE ( -1 ) 119 iihom = nlci-nreci 120 DO jf = 1, ipf 121 DO jl = 1, ipl 122 DO jk = 1, ipk 123 DO jh = 1, nn_hls 124 zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf) 125 END DO 126 END DO 127 END DO 128 END DO 129 CASE ( 0 ) 136 130 iihom = nlci-nreci 137 131 DO jf = 1, ipf … … 145 139 END DO 146 140 END DO 147 END SELECT 148 ! 141 CASE ( 1 ) 142 iihom = nlci-nreci 143 DO jf = 1, ipf 144 DO jl = 1, ipl 145 DO jk = 1, ipk 146 DO jh = 1, nn_hls 147 zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf) 148 END DO 149 END DO 150 END DO 151 END DO 152 END SELECT 149 153 ! ! Migrations 150 imigr = nn_hls * jpj * ipk * ipl * ipf 154 imigr = nn_hls * jpj * ipk * ipl * ipf 155 ! 156 IF( ln_timing ) CALL tic_tac(.TRUE.) 151 157 ! 152 158 SELECT CASE ( nbondi ) 153 159 CASE ( -1 ) 154 160 CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 ) 155 CALL mpprecv( 1, zt3ew(1,1,1,1,1, 2), imigr, noea )161 CALL mpprecv( 1, zt3ew(1,1,1,1,1,1), imigr, noea ) 156 162 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 157 163 CASE ( 0 ) … … 164 170 CASE ( 1 ) 165 171 CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 ) 166 CALL mpprecv( 2, zt3we(1,1,1,1,1, 2), imigr, nowe )172 CALL mpprecv( 2, zt3we(1,1,1,1,1,1), imigr, nowe ) 167 173 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err ) 168 174 END SELECT 175 ! 176 IF( ln_timing ) CALL tic_tac(.FALSE.) 169 177 ! 170 178 ! ! Write Dirichlet lateral conditions … … 177 185 DO jk = 1, ipk 178 186 DO jh = 1, nn_hls 179 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf, 2)187 ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,1) 180 188 END DO 181 189 END DO … … 198 206 DO jk = 1, ipk 199 207 DO jh = 1, nn_hls 200 ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2) 201 END DO 202 END DO 203 END DO 204 END DO 205 END SELECT 208 ARRAY_IN(jh ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,1) 209 END DO 210 END DO 211 END DO 212 END DO 213 END SELECT 214 ! 215 IF( nbondi /= 2 ) DEALLOCATE( zt3ew, zt3we ) 206 216 207 217 ! 3. North and south directions … … 209 219 ! always closed : we play only with the neigbours 210 220 ! 211 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 221 IF( ABS(nbondj) == 1 ) ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,1), zt3sn(jpi,nn_hls,ipk,ipl,ipf,1) ) 222 IF( nbondj == 0 ) ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2) ) 223 ! 224 SELECT CASE ( nbondj ) 225 CASE ( -1 ) 226 ijhom = nlcj-nrecj 227 DO jf = 1, ipf 228 DO jl = 1, ipl 229 DO jk = 1, ipk 230 DO jh = 1, nn_hls 231 zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf) 232 END DO 233 END DO 234 END DO 235 END DO 236 CASE ( 0 ) 212 237 ijhom = nlcj-nrecj 213 238 DO jf = 1, ipf … … 221 246 END DO 222 247 END DO 223 ENDIF 248 CASE ( 1 ) 249 ijhom = nlcj-nrecj 250 DO jf = 1, ipf 251 DO jl = 1, ipl 252 DO jk = 1, ipk 253 DO jh = 1, nn_hls 254 zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf) 255 END DO 256 END DO 257 END DO 258 END DO 259 END SELECT 224 260 ! 225 261 ! ! Migrations 226 262 imigr = nn_hls * jpi * ipk * ipl * ipf 227 263 ! 264 IF( ln_timing ) CALL tic_tac(.TRUE.) 265 ! 228 266 SELECT CASE ( nbondj ) 229 267 CASE ( -1 ) 230 268 CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 ) 231 CALL mpprecv( 3, zt3ns(1,1,1,1,1, 2), imigr, nono )269 CALL mpprecv( 3, zt3ns(1,1,1,1,1,1), imigr, nono ) 232 270 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err ) 233 271 CASE ( 0 ) … … 240 278 CASE ( 1 ) 241 279 CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 ) 242 CALL mpprecv( 4, zt3sn(1,1,1,1,1, 2), imigr, noso )280 CALL mpprecv( 4, zt3sn(1,1,1,1,1,1), imigr, noso ) 243 281 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err ) 244 282 END SELECT 245 283 ! 284 IF( ln_timing ) CALL tic_tac(.FALSE.) 246 285 ! ! Write Dirichlet lateral conditions 247 286 ijhom = nlcj-nn_hls … … 253 292 DO jk = 1, ipk 254 293 DO jh = 1, nn_hls 255 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf, 2)294 ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,1) 256 295 END DO 257 296 END DO … … 274 313 DO jk = 1, ipk 275 314 DO jh = 1, nn_hls 276 ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2) 277 END DO 278 END DO 279 END DO 280 END DO 281 END SELECT 315 ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,1) 316 END DO 317 END DO 318 END DO 319 END DO 320 END SELECT 321 ! 322 IF( nbondj /= 2 ) DEALLOCATE( zt3ns, zt3sn ) 282 323 283 324 ! 4. north fold treatment … … 293 334 ENDIF 294 335 ! 295 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )296 !297 336 END SUBROUTINE ROUTINE_LNK 298 337
Note: See TracChangeset
for help on using the changeset viewer.
