- Timestamp:
- 2017-05-02T13:29:51+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r6486 r7993 11 11 !! the BDY/OBC communications 12 12 !! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add a C1D case 13 !! 3.6 ! 2015-06 (O. Tintó and M. Castrillo) add lbc_lnk_multi 13 14 !!---------------------------------------------------------------------- 14 15 #if defined key_mpp_mpi … … 24 25 25 26 INTERFACE lbc_lnk_multi 26 MODULE PROCEDURE mpp_lnk_2d_9 27 MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 27 28 END INTERFACE 28 29 … … 80 81 END INTERFACE 81 82 83 INTERFACE lbc_lnk_multi 84 MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 85 END INTERFACE 86 82 87 INTERFACE lbc_bdy_lnk 83 88 MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d … … 87 92 MODULE PROCEDURE lbc_lnk_2d_e 88 93 END INTERFACE 94 95 TYPE arrayptr 96 REAL , DIMENSION (:,:), POINTER :: pt2d 97 END TYPE arrayptr 98 PUBLIC arrayptr 89 99 90 100 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 91 101 PUBLIC lbc_lnk_e 102 PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 92 103 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 93 104 PUBLIC lbc_lnk_icb … … 171 182 ! 172 183 END SUBROUTINE lbc_lnk_2d 184 185 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 186 !! 187 INTEGER :: num_fields 188 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 189 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 190 ! ! = T , U , V , F , W and I points 191 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 192 ! ! = 1. , the sign is kept 193 ! 194 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 195 ! 196 DO ii = 1, num_fields 197 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 198 END DO 199 ! 200 END SUBROUTINE lbc_lnk_2d_multiple 201 202 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 203 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 204 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 205 !!--------------------------------------------------------------------- 206 ! Second 2D array on which the boundary condition is applied 207 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 208 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 209 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 210 ! define the nature of ptab array grid-points 211 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 212 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 213 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 214 ! =-1 the sign change across the north fold boundary 215 REAL(wp) , INTENT(in ) :: psgnA 216 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 217 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 218 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 219 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 220 !! 221 !!--------------------------------------------------------------------- 222 223 !!The first array 224 CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 225 226 !! Look if more arrays to process 227 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 228 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 229 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 230 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 231 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 232 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 233 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 234 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 235 236 END SUBROUTINE lbc_lnk_2d_9 237 238 239 240 173 241 174 242 #else … … 372 440 ! 373 441 END SUBROUTINE lbc_lnk_2d 442 443 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 444 !! 445 INTEGER :: num_fields 446 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 447 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 448 ! ! = T , U , V , F , W and I points 449 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 450 ! ! = 1. , the sign is kept 451 ! 452 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 453 ! 454 DO ii = 1, num_fields 455 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 456 END DO 457 ! 458 END SUBROUTINE lbc_lnk_2d_multiple 459 460 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 461 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 462 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 463 !!--------------------------------------------------------------------- 464 ! Second 2D array on which the boundary condition is applied 465 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 466 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 467 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 468 ! define the nature of ptab array grid-points 469 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 470 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 471 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 472 ! =-1 the sign change across the north fold boundary 473 REAL(wp) , INTENT(in ) :: psgnA 474 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 475 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 476 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 477 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 478 !! 479 !!--------------------------------------------------------------------- 480 481 !!The first array 482 CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 483 484 !! Look if more arrays to process 485 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 486 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 487 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 488 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 489 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 490 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 491 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 492 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 493 494 END SUBROUTINE lbc_lnk_2d_9 495 374 496 375 497 #endif … … 441 563 !!====================================================================== 442 564 END MODULE lbclnk 565
Note: See TracChangeset
for help on using the changeset viewer.
