Changeset 4328 for branches/2013/dev_MERGE_2013/NEMOGCM/NEMO
- Timestamp:
- 2013-12-06T11:25:13+01:00 (10 years ago)
- Location:
- branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 1 deleted
- 16 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r4234 r4328 19 19 USE lib_mpp ! distributed memory computing library 20 20 USE trabbc ! bottom boundary condition 21 USE obc_par ! (for lk_obc)22 21 USE bdy_par ! (for lk_bdy) 23 22 USE timing ! preformance summary … … 263 262 ! ----------------------------------------------- ! 264 263 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated" 265 IF( lk_ obc .or. lk_bdy ) THEN264 IF( lk_bdy ) THEN 266 265 CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) 267 266 ENDIF -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r4147 r4328 115 115 !! even IF nperio is not zero. 116 116 !! 117 !! In case of open boundaries (lk_ obc=T):117 !! In case of open boundaries (lk_bdy=T): 118 118 !! - tmask is set to 1 on the points to be computed bay the open 119 119 !! boundaries routines. -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
r4147 r4328 24 24 USE oce ! ocean dynamics and tracers 25 25 USE dom_oce ! ocean space and time domain 26 USE obc_oce ! ocean lateral open boundary condition27 26 USE in_out_manager ! I/O manager 28 27 USE lib_mpp ! distributed memory computing … … 419 418 END DO 420 419 421 #if defined key_obc422 IF( Agrif_Root() ) THEN423 ! open boundaries (div must be zero behind the open boundary)424 ! mpp remark: The zeroing of zhdivnep can probably be extended to 1->jpi/jpj for the correct row/column425 IF( lp_obc_east ) zhdivnep(nie0p1:nie1p1,nje0 :nje1 ,jk) = 0.0_wp ! east426 IF( lp_obc_west ) zhdivnep(niw0 :niw1 ,njw0 :njw1 ,jk) = 0.0_wp ! west427 IF( lp_obc_north ) zhdivnep(nin0 :nin1 ,njn0p1:njn1p1,jk) = 0.0_wp ! north428 IF( lp_obc_south ) zhdivnep(nis0 :nis1 ,njs0 :njs1 ,jk) = 0.0_wp ! south429 ENDIF430 #endif431 420 IF( .NOT. AGRIF_Root() ) THEN 432 421 IF ((nbondi == 1).OR.(nbondi == 2)) zhdivnep(nlci-1 , : ,jk) = 0.0_wp ! east -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r4312 r4328 30 30 USE dynadv ! dynamics: vector invariant versus flux form 31 31 USE domvvl ! variable volume 32 USE obc_oce ! ocean open boundary conditions33 USE obcdyn ! open boundary condition for momentum (obc_dyn routine)34 USE obcdyn_bt ! 2D open boundary condition for momentum (obc_dyn_bt routine)35 USE obcvol ! ocean open boundary condition (obc_vol routines)36 32 USE bdy_oce ! ocean open boundary conditions 37 33 USE bdydta ! ocean open boundary conditions … … 83 79 !! * Apply lateral boundary conditions on after velocity 84 80 !! at the local domain boundaries through lbc_lnk call, 85 !! at the one-way open boundaries (lk_ obc=T),81 !! at the one-way open boundaries (lk_bdy=T), 86 82 !! at the AGRIF zoom boundaries (lk_agrif=T) 87 83 !! … … 204 200 CALL lbc_lnk( va, 'V', -1. ) 205 201 ! 206 # if defined key_obc 207 ! !* OBC open boundaries 208 IF( lk_obc ) CALL obc_dyn( kt ) 209 ! 210 IF( .NOT. lk_dynspg_flt ) THEN 211 ! Flather boundary condition : - Update sea surface height on each open boundary 212 ! sshn (= after ssh ) for explicit case (lk_dynspg_exp=T) 213 ! sshn_b (= after ssha_b) for time-splitting case (lk_dynspg_ts=T) 214 ! - Correct the barotropic velocities 215 IF( lk_obc ) CALL obc_dyn_bt( kt ) 216 ! 217 !!gm ERROR - potential BUG: sshn should not be modified at this stage !! ssh_nxt not alrady called 218 CALL lbc_lnk( sshn, 'T', 1. ) ! Boundary conditions on sshn 219 ! 220 IF( lk_obc .AND. ln_vol_cst ) CALL obc_vol( kt ) 221 ! 222 IF(ln_ctl) CALL prt_ctl( tab2d_1=sshn, clinfo1=' ssh : ', mask1=tmask ) 223 ENDIF 224 ! 225 # elif defined key_bdy 202 # if defined key_bdy 226 203 ! !* BDY open boundaries 227 204 IF( lk_bdy .AND. lk_dynspg_exp ) CALL bdy_dyn( kt ) -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r4292 r4328 18 18 USE dom_oce ! ocean space and time domain 19 19 USE sbc_oce ! surface boundary condition: ocean 20 USE obc_oce ! Lateral open boundary condition21 20 USE phycst ! physical constants 22 USE obc_par ! open boundary condition parameters23 USE obcdta ! open boundary condition data (bdy_dta_bt routine)24 21 USE in_out_manager ! I/O manager 25 22 USE lib_mpp ! distributed memory computing library … … 79 76 ENDIF 80 77 81 82 !!gm bug ?? Rachid we have to discuss of the call below. I don't understand why it is here and not in ssh_wzv83 IF( lk_obc ) CALL obc_dta_bt( kt, 0 ) ! OBC: read or estimate ssh and vertically integrated velocities84 !!gm85 86 78 IF( .NOT. lk_vvl ) THEN !* fixed volume : add the surface pressure gradient trend 87 79 ! -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r4153 r4328 25 25 USE zdf_oce ! ocean vertical physics 26 26 USE sbc_oce ! surface boundary condition: ocean 27 USE obc_oce ! Lateral open boundary condition28 27 USE bdy_oce ! Lateral open boundary condition 29 28 USE sol_oce ! ocean elliptic solver … … 34 33 USE solpcg ! preconditionned conjugate gradient solver 35 34 USE solsor ! Successive Over-relaxation solver 36 USE obcdyn ! ocean open boundary condition on dynamics37 USE obcvol ! ocean open boundary condition (obc_vol routine)38 35 USE bdydyn ! ocean open boundary condition on dynamics 39 36 USE bdyvol ! ocean open boundary condition (bdy_vol routine) … … 184 181 ENDIF 185 182 186 #if defined key_obc187 IF( lk_obc ) CALL obc_dyn( kt ) ! Update velocities on each open boundary with the radiation algorithm188 IF( lk_obc ) CALL obc_vol( kt ) ! Correction of the barotropic componant velocity to control the volume of the system189 #endif190 183 #if defined key_bdy 191 184 IF( lk_bdy ) CALL bdy_dyn( kt ) ! Update velocities on each open boundary … … 304 297 ztdgv = z2dtg * (gcx(ji ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj) 305 298 ! multiplied by z2dt 306 #if defined key_obc 307 IF(lk_obc) THEN 308 ! caution : grad D = 0 along open boundaries 309 ! Remark: The filtering force could be reduced here in the FRS zone 310 ! by multiplying spgu/spgv by (1-alpha) ?? 311 spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 312 spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 313 ELSE 314 spgu(ji,jj) = z2dt * ztdgu 315 spgv(ji,jj) = z2dt * ztdgv 316 ENDIF 317 #elif defined key_bdy 299 #if defined key_bdy 318 300 IF(lk_bdy) THEN 319 301 ! caution : grad D = 0 along open boundaries -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r4327 r4328 28 28 USE lbclnk ! ocean lateral boundary condition (or mpp link) 29 29 USE lib_mpp ! MPP library 30 USE obc_par ! open boundary cond. parameter31 USE obc_oce32 30 USE bdy_oce 33 31 USE bdy_par … … 120 118 CALL agrif_ssh( kt ) 121 119 #endif 122 #if defined key_obc123 IF( Agrif_Root() ) THEN124 ssha(:,:) = ssha(:,:) * obctmsk(:,:)125 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm)126 ENDIF127 #endif128 120 #if defined key_bdy 129 121 ! bg jchanut tschanges -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r3294 r4328 14 14 USE dom_oce ! ocean space and time domain 15 15 USE phycst ! physical constants 16 USE obc_par ! open boundary condition parameters17 16 USE in_out_manager ! I/O manager 18 17 USE lib_mpp ! distribued memory computing library … … 345 344 IF( lk_mpp ) CALL mpp_sum( ijl , jpnfl ) 346 345 347 ! in the case of open boundaries we need to test if the floats don't348 ! go out of the domain. If it goes out, the float is put at the349 ! middle of the mesh in the domain but the trajectory isn't compute350 ! more time.351 # if defined key_obc352 DO jfl = 1, jpnfl353 IF( lp_obc_east ) THEN354 IF( jped <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <= zgifl(jfl) ) THEN355 zgifl (jfl) = INT(zgifl(jfl)) + 0.5356 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5357 zagefl(jfl) = rdt358 END IF359 END IF360 IF( lp_obc_west ) THEN361 IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >= zgifl(jfl) ) THEN362 zgifl (jfl) = INT(zgifl(jfl)) + 0.5363 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5364 zagefl(jfl) = rdt365 END IF366 END IF367 IF( lp_obc_north ) THEN368 IF( jpnd <= zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >= zgjfl(jfl) ) THEN369 zgifl (jfl) = INT(zgifl(jfl)) + 0.5370 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5371 zagefl(jfl) = rdt372 END IF373 END IF374 IF( lp_obc_south ) THEN375 IF( jpsd <= zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND. njsob >= zgjfl(jfl) ) THEN376 zgifl (jfl) = INT(zgifl(jfl)) + 0.5377 zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5378 zagefl(jfl) = rdt379 END IF380 END IF381 END DO382 #endif383 384 346 ! Test to know if a float hasn't integrated enought time 385 347 IF( ln_argo ) THEN -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r4153 r4328 19 19 !! lbc_lnk_e : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 20 20 !! lbc_bdy_lnk : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 21 !! lbc_obc_lnk : generic interface for mpp_lnk_obc_2d and mpp_lnk_obc_3d routines defined in lib_mpp22 21 !!---------------------------------------------------------------------- 23 22 USE lib_mpp ! distributed memory computing library … … 29 28 INTERFACE lbc_bdy_lnk 30 29 MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 31 END INTERFACE32 INTERFACE lbc_obc_lnk33 MODULE PROCEDURE mpp_lnk_obc_2d, mpp_lnk_obc_3d34 30 END INTERFACE 35 31 … … 41 37 PUBLIC lbc_lnk_e 42 38 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 43 PUBLIC lbc_obc_lnk ! ocean lateral BDY boundary conditions44 39 45 40 !!---------------------------------------------------------------------- … … 57 52 !! lbc_lnk_2d : set the lateral boundary condition on a 2D variable on ocean mesh 58 53 !! lbc_bdy_lnk : set the lateral BDY boundary condition 59 !! lbc_obc_lnk : set the lateral OBC boundary condition60 54 !!---------------------------------------------------------------------- 61 55 USE oce ! ocean dynamics and tracers … … 78 72 MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d 79 73 END INTERFACE 80 INTERFACE lbc_obc_lnk81 MODULE PROCEDURE lbc_lnk_2d, lbc_lnk_3d82 END INTERFACE83 74 84 75 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 85 76 PUBLIC lbc_lnk_e 86 77 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 87 PUBLIC lbc_obc_lnk ! ocean lateral OBC boundary conditions88 78 89 79 !!---------------------------------------------------------------------- -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4314 r4328 53 53 !! mppsync : 54 54 !! mppstop : 55 !! mppobc : variant of mpp_lnk for open boundary condition56 55 !! mpp_ini_north : initialisation of north fold 57 56 !! mpp_lbc_north : north fold processors gathering … … 71 70 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 72 71 PUBLIC mppscatter, mppgather 73 PUBLIC mpp obc, mpp_ini_ice, mpp_ini_znl72 PUBLIC mpp_ini_ice, mpp_ini_znl 74 73 PUBLIC mppsize 75 74 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 76 75 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 77 PUBLIC mpp_lnk_obc_2d, mpp_lnk_obc_3d78 76 79 77 !! * Interfaces … … 300 298 END FUNCTION mynode 301 299 302 SUBROUTINE mpp_lnk_ obc_3d( ptab, cd_type, psgn)303 !!---------------------------------------------------------------------- 304 !! *** routine mpp_lnk_ obc_3d ***300 SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 301 !!---------------------------------------------------------------------- 302 !! *** routine mpp_lnk_3d *** 305 303 !! 306 304 !! ** Purpose : Message passing manadgement 307 305 !! 308 !! ** Method : Use mppsend and mpprecv function for passing OBC boundaries306 !! ** Method : Use mppsend and mpprecv function for passing mask 309 307 !! between processors following neighboring subdomains. 310 308 !! domain parameters … … 313 311 !! nbondi : mark for "east-west local boundary" 314 312 !! nbondj : mark for "north-south local boundary" 315 !! noea : number for local neighboring processors 313 !! noea : number for local neighboring processors 316 314 !! nowe : number for local neighboring processors 317 315 !! noso : number for local neighboring processors … … 326 324 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 327 325 ! ! = 1. , the sign is kept 326 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 327 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 328 328 !! 329 329 INTEGER :: ji, jj, jk, jl ! dummy loop indices … … 337 337 338 338 !!---------------------------------------------------------------------- 339 339 340 340 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 341 341 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 342 342 343 zland = 0.e0 ! zero by default 343 ! 344 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 345 ELSE ; zland = 0.e0 ! zero by default 346 ENDIF 344 347 345 348 ! 1. standard boundary treatment 346 349 ! ------------------------------ 347 IF( nbondi == 2) THEN 348 IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 349 ptab( 1 ,:,:) = ptab(jpim1,:,:) 350 ptab(jpi,:,:) = ptab( 2 ,:,:) 351 ELSE 352 IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:,:) = zland ! south except F-point 353 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north 354 ENDIF 355 ELSEIF(nbondi == -1) THEN 356 IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:,:) = zland ! south except F-point 357 ELSEIF(nbondi == 1) THEN 358 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north 359 ENDIF !* closed 360 361 IF (nbondj == 2 .OR. nbondj == -1) THEN 362 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 363 ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 364 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 350 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values 351 ! 352 ! WARNING ptab is defined only between nld and nle 353 DO jk = 1, jpk 354 DO jj = nlcj+1, jpj ! added line(s) (inner only) 355 ptab(nldi :nlei , jj ,jk) = ptab(nldi:nlei, nlej,jk) 356 ptab(1 :nldi-1, jj ,jk) = ptab(nldi , nlej,jk) 357 ptab(nlei+1:nlci , jj ,jk) = ptab( nlei, nlej,jk) 358 END DO 359 DO ji = nlci+1, jpi ! added column(s) (full) 360 ptab(ji ,nldj :nlej ,jk) = ptab( nlei,nldj:nlej,jk) 361 ptab(ji ,1 :nldj-1,jk) = ptab( nlei,nldj ,jk) 362 ptab(ji ,nlej+1:jpj ,jk) = ptab( nlei, nlej,jk) 363 END DO 364 END DO 365 ! 366 ELSE ! standard close or cyclic treatment 367 ! 368 ! ! East-West boundaries 369 ! !* Cyclic east-west 370 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 371 ptab( 1 ,:,:) = ptab(jpim1,:,:) 372 ptab(jpi,:,:) = ptab( 2 ,:,:) 373 ELSE !* closed 374 IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:,:) = zland ! south except F-point 375 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north 376 ENDIF 377 ! ! North-South boundaries (always closed) 378 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 379 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 380 ! 365 381 ENDIF 366 382 367 383 ! 2. East and west directions exchange 368 384 ! ------------------------------------ 369 ! we play with the neigbours AND the row number because of the periodicity 370 ! 371 IF(nbondj .ne. 0) THEN 385 ! we play with the neigbours AND the row number because of the periodicity 386 ! 372 387 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 373 388 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) … … 377 392 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 378 393 END DO 379 END SELECT 394 END SELECT 380 395 ! 381 396 ! ! Migrations 382 397 imigr = jpreci * jpj * jpk 383 398 ! 384 SELECT CASE ( nbondi ) 399 SELECT CASE ( nbondi ) 385 400 CASE ( -1 ) 386 401 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) … … 418 433 END DO 419 434 END SELECT 420 ENDIF421 435 422 436 … … 425 439 ! always closed : we play only with the neigbours 426 440 ! 427 IF(nbondi .ne. 0) THEN428 441 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 429 442 ijhom = nlcj-nrecj … … 437 450 imigr = jprecj * jpi * jpk 438 451 ! 439 SELECT CASE ( nbondj ) 452 SELECT CASE ( nbondj ) 440 453 CASE ( -1 ) 441 454 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) … … 449 462 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 450 463 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 451 CASE ( 1 ) 464 CASE ( 1 ) 452 465 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 453 466 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) … … 473 486 END DO 474 487 END SELECT 475 ENDIF476 488 477 489 … … 479 491 ! ----------------------- 480 492 ! 481 IF( npolj /= 0 ) THEN493 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 482 494 ! 483 495 SELECT CASE ( jpni ) … … 490 502 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 491 503 ! 492 END SUBROUTINE mpp_lnk_ obc_3d493 494 495 SUBROUTINE mpp_lnk_ obc_2d( pt2d, cd_type, psgn)496 !!---------------------------------------------------------------------- 497 !! *** routine mpp_lnk_ obc_2d ***498 !! 504 END SUBROUTINE mpp_lnk_3d 505 506 507 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 508 !!---------------------------------------------------------------------- 509 !! *** routine mpp_lnk_2d *** 510 !! 499 511 !! ** Purpose : Message passing manadgement for 2d array 500 512 !! 501 !! ** Method : Use mppsend and mpprecv function for passing OBC boundaries513 !! ** Method : Use mppsend and mpprecv function for passing mask 502 514 !! between processors following neighboring subdomains. 503 515 !! domain parameters … … 506 518 !! nbondi : mark for "east-west local boundary" 507 519 !! nbondj : mark for "north-south local boundary" 508 !! noea : number for local neighboring processors 520 !! noea : number for local neighboring processors 509 521 !! nowe : number for local neighboring processors 510 522 !! noso : number for local neighboring processors … … 517 529 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 518 530 ! ! = 1. , the sign is kept 531 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 532 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 519 533 !! 520 534 INTEGER :: ji, jj, jl ! dummy loop indices … … 532 546 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 533 547 534 zland = 0.e0 ! zero by default 548 ! 549 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 550 ELSE ; zland = 0.e0 ! zero by default 551 ENDIF 535 552 536 553 ! 1. standard boundary treatment 537 554 ! ------------------------------ 538 555 ! 539 IF( nbondi == 2) THEN 540 IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN 541 pt2d( 1 ,:) = pt2d(jpim1,:) 542 pt2d(jpi,:) = pt2d( 2 ,:) 543 ELSE 544 IF( .NOT. cd_type == 'F' ) pt2d( 1 :jpreci,:) = zland ! south except F-point 545 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north 546 ENDIF 547 ELSEIF(nbondi == -1) THEN 548 IF( .NOT. cd_type == 'F' ) pt2d( 1 :jpreci,:) = zland ! south except F-point 549 ELSEIF(nbondi == 1) THEN 550 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north 551 ENDIF !* closed 552 553 IF (nbondj == 2 .OR. nbondj == -1) THEN 554 IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland ! south except F-point 555 ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN 556 pt2d(:,nlcj-jprecj+1:jpj) = zland ! north 556 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values 557 ! 558 ! WARNING pt2d is defined only between nld and nle 559 DO jj = nlcj+1, jpj ! added line(s) (inner only) 560 pt2d(nldi :nlei , jj ) = pt2d(nldi:nlei, nlej) 561 pt2d(1 :nldi-1, jj ) = pt2d(nldi , nlej) 562 pt2d(nlei+1:nlci , jj ) = pt2d( nlei, nlej) 563 END DO 564 DO ji = nlci+1, jpi ! added column(s) (full) 565 pt2d(ji ,nldj :nlej ) = pt2d( nlei,nldj:nlej) 566 pt2d(ji ,1 :nldj-1) = pt2d( nlei,nldj ) 567 pt2d(ji ,nlej+1:jpj ) = pt2d( nlei, nlej) 568 END DO 569 ! 570 ELSE ! standard close or cyclic treatment 571 ! 572 ! ! East-West boundaries 573 IF( nbondi == 2 .AND. & ! Cyclic east-west 574 & (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 575 pt2d( 1 ,:) = pt2d(jpim1,:) ! west 576 pt2d(jpi,:) = pt2d( 2 ,:) ! east 577 ELSE ! closed 578 IF( .NOT. cd_type == 'F' ) pt2d( 1 :jpreci,:) = zland ! south except F-point 579 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north 580 ENDIF 581 ! ! North-South boundaries (always closed) 582 IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland !south except F-point 583 pt2d(:,nlcj-jprecj+1:jpj ) = zland ! north 584 ! 557 585 ENDIF 558 586 559 587 ! 2. East and west directions exchange 560 588 ! ------------------------------------ 561 ! we play with the neigbours AND the row number because of the periodicity 589 ! we play with the neigbours AND the row number because of the periodicity 562 590 ! 563 591 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions … … 657 685 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 658 686 END DO 659 CASE ( 1 )660 DO jl = 1, jprecj661 pt2d(:,jl ) = zt2sn(:,jl,2)662 END DO663 END SELECT664 665 666 ! 4. north fold treatment667 ! -----------------------668 !669 IF( npolj /= 0 ) THEN670 !671 SELECT CASE ( jpni )672 CASE ( 1 ) ; CALL lbc_nfd ( pt2d, cd_type, psgn ) ! only 1 northern proc, no mpp673 CASE DEFAULT ; CALL mpp_lbc_north( pt2d, cd_type, psgn ) ! for all northern procs.674 END SELECT675 !676 ENDIF677 !678 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )679 !680 END SUBROUTINE mpp_lnk_obc_2d681 682 SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval )683 !!----------------------------------------------------------------------684 !! *** routine mpp_lnk_3d ***685 !!686 !! ** Purpose : Message passing manadgement687 !!688 !! ** Method : Use mppsend and mpprecv function for passing mask689 !! between processors following neighboring subdomains.690 !! domain parameters691 !! nlci : first dimension of the local subdomain692 !! nlcj : second dimension of the local subdomain693 !! nbondi : mark for "east-west local boundary"694 !! nbondj : mark for "north-south local boundary"695 !! noea : number for local neighboring processors696 !! nowe : number for local neighboring processors697 !! noso : number for local neighboring processors698 !! nono : number for local neighboring processors699 !!700 !! ** Action : ptab with update value at its periphery701 !!702 !!----------------------------------------------------------------------703 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied704 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points705 ! ! = T , U , V , F , W points706 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary707 ! ! = 1. , the sign is kept708 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only709 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries)710 !!711 INTEGER :: ji, jj, jk, jl ! dummy loop indices712 INTEGER :: imigr, iihom, ijhom ! temporary integers713 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend714 REAL(wp) :: zland715 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend716 !717 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north718 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east719 720 !!----------------------------------------------------------------------721 722 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), &723 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) )724 725 !726 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value727 ELSE ; zland = 0.e0 ! zero by default728 ENDIF729 730 ! 1. standard boundary treatment731 ! ------------------------------732 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values733 !734 ! WARNING ptab is defined only between nld and nle735 DO jk = 1, jpk736 DO jj = nlcj+1, jpj ! added line(s) (inner only)737 ptab(nldi :nlei , jj ,jk) = ptab(nldi:nlei, nlej,jk)738 ptab(1 :nldi-1, jj ,jk) = ptab(nldi , nlej,jk)739 ptab(nlei+1:nlci , jj ,jk) = ptab( nlei, nlej,jk)740 END DO741 DO ji = nlci+1, jpi ! added column(s) (full)742 ptab(ji ,nldj :nlej ,jk) = ptab( nlei,nldj:nlej,jk)743 ptab(ji ,1 :nldj-1,jk) = ptab( nlei,nldj ,jk)744 ptab(ji ,nlej+1:jpj ,jk) = ptab( nlei, nlej,jk)745 END DO746 END DO747 !748 ELSE ! standard close or cyclic treatment749 !750 ! ! East-West boundaries751 ! !* Cyclic east-west752 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN753 ptab( 1 ,:,:) = ptab(jpim1,:,:)754 ptab(jpi,:,:) = ptab( 2 ,:,:)755 ELSE !* closed756 IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:,:) = zland ! south except F-point757 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north758 ENDIF759 ! ! North-South boundaries (always closed)760 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point761 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north762 !763 ENDIF764 765 ! 2. East and west directions exchange766 ! ------------------------------------767 ! we play with the neigbours AND the row number because of the periodicity768 !769 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions770 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case)771 iihom = nlci-nreci772 DO jl = 1, jpreci773 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)774 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)775 END DO776 END SELECT777 !778 ! ! Migrations779 imigr = jpreci * jpj * jpk780 !781 SELECT CASE ( nbondi )782 CASE ( -1 )783 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )784 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )785 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)786 CASE ( 0 )787 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )788 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )789 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )790 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )791 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)792 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)793 CASE ( 1 )794 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )795 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )796 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)797 END SELECT798 !799 ! ! Write Dirichlet lateral conditions800 iihom = nlci-jpreci801 !802 SELECT CASE ( nbondi )803 CASE ( -1 )804 DO jl = 1, jpreci805 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)806 END DO807 CASE ( 0 )808 DO jl = 1, jpreci809 ptab(jl ,:,:) = zt3we(:,jl,:,2)810 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)811 END DO812 CASE ( 1 )813 DO jl = 1, jpreci814 ptab(jl ,:,:) = zt3we(:,jl,:,2)815 END DO816 END SELECT817 818 819 ! 3. North and south directions820 ! -----------------------------821 ! always closed : we play only with the neigbours822 !823 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions824 ijhom = nlcj-nrecj825 DO jl = 1, jprecj826 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)827 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)828 END DO829 ENDIF830 !831 ! ! Migrations832 imigr = jprecj * jpi * jpk833 !834 SELECT CASE ( nbondj )835 CASE ( -1 )836 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )837 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )838 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)839 CASE ( 0 )840 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )841 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )842 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )843 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )844 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)845 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)846 CASE ( 1 )847 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )848 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )849 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)850 END SELECT851 !852 ! ! Write Dirichlet lateral conditions853 ijhom = nlcj-jprecj854 !855 SELECT CASE ( nbondj )856 CASE ( -1 )857 DO jl = 1, jprecj858 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)859 END DO860 CASE ( 0 )861 DO jl = 1, jprecj862 ptab(:,jl ,:) = zt3sn(:,jl,:,2)863 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)864 END DO865 CASE ( 1 )866 DO jl = 1, jprecj867 ptab(:,jl,:) = zt3sn(:,jl,:,2)868 END DO869 END SELECT870 871 872 ! 4. north fold treatment873 ! -----------------------874 !875 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN876 !877 SELECT CASE ( jpni )878 CASE ( 1 ) ; CALL lbc_nfd ( ptab, cd_type, psgn ) ! only 1 northern proc, no mpp879 CASE DEFAULT ; CALL mpp_lbc_north( ptab, cd_type, psgn ) ! for all northern procs.880 END SELECT881 !882 ENDIF883 !884 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )885 !886 END SUBROUTINE mpp_lnk_3d887 888 889 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )890 !!----------------------------------------------------------------------891 !! *** routine mpp_lnk_2d ***892 !!893 !! ** Purpose : Message passing manadgement for 2d array894 !!895 !! ** Method : Use mppsend and mpprecv function for passing mask896 !! between processors following neighboring subdomains.897 !! domain parameters898 !! nlci : first dimension of the local subdomain899 !! nlcj : second dimension of the local subdomain900 !! nbondi : mark for "east-west local boundary"901 !! nbondj : mark for "north-south local boundary"902 !! noea : number for local neighboring processors903 !! nowe : number for local neighboring processors904 !! noso : number for local neighboring processors905 !! nono : number for local neighboring processors906 !!907 !!----------------------------------------------------------------------908 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied909 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points910 ! ! = T , U , V , F , W and I points911 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary912 ! ! = 1. , the sign is kept913 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only914 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries)915 !!916 INTEGER :: ji, jj, jl ! dummy loop indices917 INTEGER :: imigr, iihom, ijhom ! temporary integers918 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend919 REAL(wp) :: zland920 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend921 !922 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north923 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east924 925 !!----------------------------------------------------------------------926 927 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), &928 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) )929 930 !931 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value932 ELSE ; zland = 0.e0 ! zero by default933 ENDIF934 935 ! 1. standard boundary treatment936 ! ------------------------------937 !938 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values939 !940 ! WARNING pt2d is defined only between nld and nle941 DO jj = nlcj+1, jpj ! added line(s) (inner only)942 pt2d(nldi :nlei , jj ) = pt2d(nldi:nlei, nlej)943 pt2d(1 :nldi-1, jj ) = pt2d(nldi , nlej)944 pt2d(nlei+1:nlci , jj ) = pt2d( nlei, nlej)945 END DO946 DO ji = nlci+1, jpi ! added column(s) (full)947 pt2d(ji ,nldj :nlej ) = pt2d( nlei,nldj:nlej)948 pt2d(ji ,1 :nldj-1) = pt2d( nlei,nldj )949 pt2d(ji ,nlej+1:jpj ) = pt2d( nlei, nlej)950 END DO951 !952 ELSE ! standard close or cyclic treatment953 !954 ! ! East-West boundaries955 IF( nbondi == 2 .AND. & ! Cyclic east-west956 & (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN957 pt2d( 1 ,:) = pt2d(jpim1,:) ! west958 pt2d(jpi,:) = pt2d( 2 ,:) ! east959 ELSE ! closed960 IF( .NOT. cd_type == 'F' ) pt2d( 1 :jpreci,:) = zland ! south except F-point961 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north962 ENDIF963 ! ! North-South boundaries (always closed)964 IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland !south except F-point965 pt2d(:,nlcj-jprecj+1:jpj ) = zland ! north966 !967 ENDIF968 969 ! 2. East and west directions exchange970 ! ------------------------------------971 ! we play with the neigbours AND the row number because of the periodicity972 !973 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions974 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case)975 iihom = nlci-nreci976 DO jl = 1, jpreci977 zt2ew(:,jl,1) = pt2d(jpreci+jl,:)978 zt2we(:,jl,1) = pt2d(iihom +jl,:)979 END DO980 END SELECT981 !982 ! ! Migrations983 imigr = jpreci * jpj984 !985 SELECT CASE ( nbondi )986 CASE ( -1 )987 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )988 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )989 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)990 CASE ( 0 )991 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )992 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )993 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )994 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )995 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)996 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)997 CASE ( 1 )998 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )999 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )1000 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1001 END SELECT1002 !1003 ! ! Write Dirichlet lateral conditions1004 iihom = nlci - jpreci1005 !1006 SELECT CASE ( nbondi )1007 CASE ( -1 )1008 DO jl = 1, jpreci1009 pt2d(iihom+jl,:) = zt2ew(:,jl,2)1010 END DO1011 CASE ( 0 )1012 DO jl = 1, jpreci1013 pt2d(jl ,:) = zt2we(:,jl,2)1014 pt2d(iihom+jl,:) = zt2ew(:,jl,2)1015 END DO1016 CASE ( 1 )1017 DO jl = 1, jpreci1018 pt2d(jl ,:) = zt2we(:,jl,2)1019 END DO1020 END SELECT1021 1022 1023 ! 3. North and south directions1024 ! -----------------------------1025 ! always closed : we play only with the neigbours1026 !1027 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions1028 ijhom = nlcj-nrecj1029 DO jl = 1, jprecj1030 zt2sn(:,jl,1) = pt2d(:,ijhom +jl)1031 zt2ns(:,jl,1) = pt2d(:,jprecj+jl)1032 END DO1033 ENDIF1034 !1035 ! ! Migrations1036 imigr = jprecj * jpi1037 !1038 SELECT CASE ( nbondj )1039 CASE ( -1 )1040 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )1041 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )1042 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1043 CASE ( 0 )1044 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )1045 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )1046 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )1047 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )1048 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1049 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)1050 CASE ( 1 )1051 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )1052 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )1053 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1054 END SELECT1055 !1056 ! ! Write Dirichlet lateral conditions1057 ijhom = nlcj - jprecj1058 !1059 SELECT CASE ( nbondj )1060 CASE ( -1 )1061 DO jl = 1, jprecj1062 pt2d(:,ijhom+jl) = zt2ns(:,jl,2)1063 END DO1064 CASE ( 0 )1065 DO jl = 1, jprecj1066 pt2d(:,jl ) = zt2sn(:,jl,2)1067 pt2d(:,ijhom+jl) = zt2ns(:,jl,2)1068 END DO1069 687 CASE ( 1 ) 1070 688 DO jl = 1, jprecj … … 2102 1720 ! 2103 1721 END SUBROUTINE mppstop 2104 2105 2106 SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout)2107 !!----------------------------------------------------------------------2108 !! *** routine mppobc ***2109 !!2110 !! ** Purpose : Message passing manadgement for open boundary2111 !! conditions array2112 !!2113 !! ** Method : Use mppsend and mpprecv function for passing mask2114 !! between processors following neighboring subdomains.2115 !! domain parameters2116 !! nlci : first dimension of the local subdomain2117 !! nlcj : second dimension of the local subdomain2118 !! nbondi : mark for "east-west local boundary"2119 !! nbondj : mark for "north-south local boundary"2120 !! noea : number for local neighboring processors2121 !! nowe : number for local neighboring processors2122 !! noso : number for local neighboring processors2123 !! nono : number for local neighboring processors2124 !!2125 !!----------------------------------------------------------------------2126 USE wrk_nemo ! Memory allocation2127 !2128 INTEGER , INTENT(in ) :: kd1, kd2 ! starting and ending indices2129 INTEGER , INTENT(in ) :: kl ! index of open boundary2130 INTEGER , INTENT(in ) :: kk ! vertical dimension2131 INTEGER , INTENT(in ) :: ktype ! define north/south or east/west cdt2132 ! ! = 1 north/south ; = 2 east/west2133 INTEGER , INTENT(in ) :: kij ! horizontal dimension2134 INTEGER , INTENT(in ) :: kumout ! ocean.output logical unit2135 REAL(wp), INTENT(inout), DIMENSION(kij,kk) :: ptab ! variable array2136 !2137 INTEGER :: ji, jj, jk, jl ! dummy loop indices2138 INTEGER :: iipt0, iipt1, ilpt1 ! local integers2139 INTEGER :: ijpt0, ijpt1 ! - -2140 INTEGER :: imigr, iihom, ijhom ! - -2141 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend2142 INTEGER :: ml_stat(MPI_STATUS_SIZE) ! for key_mpi_isend2143 REAL(wp), POINTER, DIMENSION(:,:) :: ztab ! temporary workspace2144 !2145 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north2146 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east2147 LOGICAL :: lmigr ! is true for those processors that have to migrate the OB2148 2149 !!----------------------------------------------------------------------2150 2151 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), &2152 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) )2153 2154 CALL wrk_alloc( jpi,jpj, ztab )2155 2156 ! boundary condition initialization2157 ! ---------------------------------2158 ztab(:,:) = 0.e02159 !2160 IF( ktype==1 ) THEN ! north/south boundaries2161 iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci ) )2162 iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )2163 ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci ) )2164 ijpt0 = MAX( 1, MIN(kl - njmpp+1, nlcj ) )2165 ijpt1 = MAX( 0, MIN(kl - njmpp+1, nlcj - 1 ) )2166 ELSEIF( ktype==2 ) THEN ! east/west boundaries2167 iipt0 = MAX( 1, MIN(kl - nimpp+1, nlci ) )2168 iipt1 = MAX( 0, MIN(kl - nimpp+1, nlci - 1 ) )2169 ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj ) )2170 ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )2171 ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj ) )2172 ELSE2173 WRITE(kumout, cform_err)2174 WRITE(kumout,*) 'mppobc : bad ktype'2175 CALL mppstop2176 ENDIF2177 2178 ! Communication level by level2179 ! ----------------------------2180 !!gm Remark : this is very time consumming!!!2181 ! ! ------------------------ !2182 IF(((nbondi .ne. 0) .AND. (ktype .eq. 2)) .OR. ((nbondj .ne. 0) .AND. (ktype .eq. 1))) THEN2183 ! there is nothing to be migrated2184 lmigr = .TRUE.2185 ELSE2186 lmigr = .FALSE.2187 ENDIF2188 2189 IF( lmigr ) THEN2190 2191 DO jk = 1, kk ! Loop over the levels !2192 ! ! ------------------------ !2193 !2194 IF( ktype == 1 ) THEN ! north/south boundaries2195 DO jj = ijpt0, ijpt12196 DO ji = iipt0, iipt12197 ztab(ji,jj) = ptab(ji,jk)2198 END DO2199 END DO2200 ELSEIF( ktype == 2 ) THEN ! east/west boundaries2201 DO jj = ijpt0, ijpt12202 DO ji = iipt0, iipt12203 ztab(ji,jj) = ptab(jj,jk)2204 END DO2205 END DO2206 ENDIF2207 2208 2209 ! 1. East and west directions2210 ! ---------------------------2211 !2212 IF( ktype == 1 ) THEN2213 2214 IF( nbondi /= 2 ) THEN ! Read Dirichlet lateral conditions2215 iihom = nlci-nreci2216 zt2ew(1:jpreci,1,1) = ztab(jpreci+1:nreci, ijpt0)2217 zt2we(1:jpreci,1,1) = ztab(iihom+1:iihom+jpreci, ijpt0)2218 ENDIF2219 !2220 ! ! Migrations2221 imigr = jpreci2222 !2223 IF( nbondi == -1 ) THEN2224 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )2225 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )2226 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )2227 ELSEIF( nbondi == 0 ) THEN2228 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )2229 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )2230 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )2231 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )2232 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )2233 IF(l_isend) CALL mpi_wait( ml_req2, ml_stat, ml_err )2234 ELSEIF( nbondi == 1 ) THEN2235 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )2236 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )2237 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )2238 ENDIF2239 !2240 ! ! Write Dirichlet lateral conditions2241 iihom = nlci-jpreci2242 !2243 IF( nbondi == 0 .OR. nbondi == 1 ) THEN2244 ztab(1:jpreci, ijpt0) = zt2we(1:jpreci,1,2)2245 ENDIF2246 IF( nbondi == -1 .OR. nbondi == 0 ) THEN2247 ztab(iihom+1:iihom+jpreci, ijpt0) = zt2ew(1:jpreci,1,2)2248 ENDIF2249 ENDIF ! (ktype == 1)2250 2251 ! 2. North and south directions2252 ! -----------------------------2253 !2254 IF(ktype == 2 ) THEN2255 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions2256 ijhom = nlcj-nrecj2257 zt2sn(1:jprecj,1,1) = ztab(iipt0, ijhom+1:ijhom+jprecj)2258 zt2ns(1:jprecj,1,1) = ztab(iipt0, jprecj+1:nrecj)2259 ENDIF2260 !2261 ! ! Migrations2262 imigr = jprecj2263 !2264 IF( nbondj == -1 ) THEN2265 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )2266 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )2267 IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )2268 ELSEIF( nbondj == 0 ) THEN2269 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )2270 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )2271 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )2272 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )2273 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err )2274 IF( l_isend ) CALL mpi_wait( ml_req2, ml_stat, ml_err )2275 ELSEIF( nbondj == 1 ) THEN2276 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )2277 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso)2278 IF( l_isend ) CALL mpi_wait( ml_req1, ml_stat, ml_err )2279 ENDIF2280 !2281 ! ! Write Dirichlet lateral conditions2282 ijhom = nlcj - jprecj2283 IF( nbondj == 0 .OR. nbondj == 1 ) THEN2284 ztab(iipt0,1:jprecj) = zt2sn(1:jprecj,1,2)2285 ENDIF2286 IF( nbondj == 0 .OR. nbondj == -1 ) THEN2287 ztab(iipt0, ijhom+1:ijhom+jprecj) = zt2ns(1:jprecj,1,2)2288 ENDIF2289 ENDIF ! (ktype == 2)2290 IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN2291 DO jj = ijpt0, ijpt1 ! north/south boundaries2292 DO ji = iipt0,ilpt12293 ptab(ji,jk) = ztab(ji,jj)2294 END DO2295 END DO2296 ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN2297 DO jj = ijpt0, ilpt1 ! east/west boundaries2298 DO ji = iipt0,iipt12299 ptab(jj,jk) = ztab(ji,jj)2300 END DO2301 END DO2302 ENDIF2303 !2304 END DO2305 !2306 ENDIF ! ( lmigr )2307 !2308 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )2309 CALL wrk_dealloc( jpi,jpj, ztab )2310 !2311 END SUBROUTINE mppobc2312 1722 2313 1723 … … 3490 2900 MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 3491 2901 END INTERFACE 3492 INTERFACE mppobc3493 MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d3494 END INTERFACE3495 2902 INTERFACE mpp_minloc 3496 2903 MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d … … 3619 3026 WRITE(*,*) 'mppmin_int: You should not have seen this print! error?', kint, kcom 3620 3027 END SUBROUTINE mppmin_int 3621 3622 SUBROUTINE mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum )3623 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum3624 REAL, DIMENSION(:) :: parr ! variable array3625 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum3626 END SUBROUTINE mppobc_1d3627 3628 SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum )3629 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum3630 REAL, DIMENSION(:,:) :: parr ! variable array3631 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum3632 END SUBROUTINE mppobc_2d3633 3634 SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum )3635 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum3636 REAL, DIMENSION(:,:,:) :: parr ! variable array3637 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum3638 END SUBROUTINE mppobc_3d3639 3640 SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum )3641 INTEGER :: kd1, kd2, kl , kk, ktype, kij, knum3642 REAL, DIMENSION(:,:,:,:) :: parr ! variable array3643 WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum3644 END SUBROUTINE mppobc_4d3645 3028 3646 3029 SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r4230 r4328 10 10 !! sbc_apr : read atmospheric pressure in netcdf files 11 11 !!---------------------------------------------------------------------- 12 USE obc_par ! open boundary condition parameters13 12 USE dom_oce ! ocean space and time domain 14 13 USE sbc_oce ! surface boundary condition -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r4153 r4328 26 26 USE sol_oce ! ocean solver 27 27 USE phycst ! physical constants 28 USE obc_oce ! ocean open boundary conditions29 28 USE bdy_oce ! unstructured open boundary conditions 30 29 USE lbclnk ! lateral boudary conditions … … 86 85 87 86 #if defined key_dynspg_flt && ! defined key_bdy 88 # if ! defined key_obc89 87 90 88 DO jj = 2, jpjm1 ! matrix of free surface elliptic system … … 103 101 END DO 104 102 END DO 105 # else106 IF ( Agrif_Root() ) THEN107 DO jj = 2, jpjm1 ! matrix of free surface elliptic system with open boundaries108 DO ji = 2, jpim1109 zcoef = z2dt * z2dt * grav * bmask(ji,jj)110 ! ! south coefficient111 IF( lp_obc_south .AND. ( jj == njs0p1 ) ) THEN112 zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1))113 ELSE114 zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)115 END IF116 gcp(ji,jj,1) = zcoefs117 !118 ! ! west coefficient119 IF( lp_obc_west .AND. ( ji == niw0p1 ) ) THEN120 zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1))121 ELSE122 zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)123 END IF124 gcp(ji,jj,2) = zcoefw125 !126 ! ! east coefficient127 IF( lp_obc_east .AND. ( ji == nie0 ) ) THEN128 zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1))129 ELSE130 zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)131 END IF132 gcp(ji,jj,3) = zcoefe133 !134 ! ! north coefficient135 IF( lp_obc_north .AND. ( jj == njn0 ) ) THEN136 zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1))137 ELSE138 zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)139 END IF140 gcp(ji,jj,4) = zcoefn141 !142 ! ! diagonal coefficient143 gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) &144 & - zcoefs -zcoefw -zcoefe -zcoefn145 END DO146 END DO147 ELSE148 DO jj = 2, jpjm1 ! matrix of free surface elliptic system149 DO ji = 2, jpim1150 zcoef = z2dt * z2dt * grav * bmask(ji,jj)151 zcoefs = -zcoef * hv(ji ,jj-1) * e1v(ji ,jj-1) / e2v(ji ,jj-1) ! south coefficient152 zcoefw = -zcoef * hu(ji-1,jj ) * e2u(ji-1,jj ) / e1u(ji-1,jj ) ! west coefficient153 zcoefe = -zcoef * hu(ji ,jj ) * e2u(ji ,jj ) / e1u(ji ,jj ) ! east coefficient154 zcoefn = -zcoef * hv(ji ,jj ) * e1v(ji ,jj ) / e2v(ji ,jj ) ! north coefficient155 gcp(ji,jj,1) = zcoefs156 gcp(ji,jj,2) = zcoefw157 gcp(ji,jj,3) = zcoefe158 gcp(ji,jj,4) = zcoefn159 gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj) & ! diagonal coefficient160 & - zcoefs -zcoefw -zcoefe -zcoefn161 END DO162 END DO163 ENDIF164 # endif165 103 166 104 # elif defined key_dynspg_flt && defined key_bdy -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r4230 r4328 34 34 USE trdtra ! ocean active tracers trends 35 35 USE phycst 36 USE obc_oce37 USE obctra ! open boundary condition (obc_tra routine)38 36 USE bdy_oce 39 37 USE bdytra ! open boundary condition (bdy_tra routine) … … 81 79 !! - Apply lateral boundary conditions on (ta,sa) 82 80 !! at the local domain boundaries through lbc_lnk call, 83 !! at the one-way open boundaries (lk_ obc=T),81 !! at the one-way open boundaries (lk_bdy=T), 84 82 !! at the AGRIF zoom boundaries (lk_agrif=T) 85 83 !! … … 112 110 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 113 111 ! 114 #if defined key_obc115 IF( lk_obc ) CALL obc_tra( kt ) ! OBC open boundaries116 #endif117 112 #if defined key_bdy 118 113 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4319 r4328 51 51 #endif 52 52 USE tideini ! tidal components initialization (tide_ini routine) 53 USE obcini ! open boundary cond. initialization (obc_ini routine)54 53 USE bdyini ! open boundary cond. initialization (bdy_init routine) 55 54 USE bdydta ! open boundary cond. initialization (bdy_dta_init routine) … … 381 380 382 381 IF( ln_ctl ) CALL prt_ctl_init ! Print control 383 384 IF( lk_obc ) CALL obc_init ! Open boundaries385 382 386 383 CALL istate_init ! ocean initial state (Dynamics and tracers) -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/step.F90
r4313 r4328 96 96 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 97 97 IF( lk_tide ) CALL sbc_tide( kstp ) 98 IF( lk_obc ) CALL obc_dta ( kstp ) ! update dynamic and tracer data at open boundaries99 IF( lk_obc ) CALL obc_rad ( kstp ) ! compute phase velocities at open boundaries100 98 IF( lk_bdy ) CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic & tracer data at open boundaries 101 99 … … 315 313 ENDIF 316 314 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file 317 IF( lk_obc ) CALL obc_rst_write( kstp ) ! write open boundary restart file318 315 319 316 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r4292 r4328 53 53 54 54 USE dynnxt ! time-stepping (dyn_nxt routine) 55 56 USE obc_par ! open boundary condition variables57 USE obcdta ! open boundary condition data (obc_dta routine)58 USE obcrst ! open boundary cond. restart (obc_rst routine)59 USE obcrad ! open boundary cond. radiation (obc_rad routine)60 55 61 56 USE bdy_par ! for lk_bdy
Note: See TracChangeset
for help on using the changeset viewer.