Changeset 6483 for trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
- Timestamp:
- 2016-04-19T17:11:00+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r6478 r6483 9 9 !! 3.5 ! 2012 (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 10 10 !! 3.4 ! 2012-12 (R. Bourdalle-Badie, G. Reffray) add a C1D case 11 !! 3.6 ! 2015-06 (O. Tintó and M. Castrillo) add lbc_lnk_multi12 11 !!---------------------------------------------------------------------- 13 12 #if defined key_mpp_mpi … … 23 22 24 23 INTERFACE lbc_lnk_multi 25 MODULE PROCEDURE mpp_lnk_2d_9 , mpp_lnk_2d_multiple24 MODULE PROCEDURE mpp_lnk_2d_9 26 25 END INTERFACE 27 26 ! … … 91 90 END INTERFACE 92 91 ! 93 INTERFACE lbc_lnk_multi94 MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple95 END INTERFACE96 97 92 INTERFACE lbc_bdy_lnk 98 93 MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d … … 102 97 MODULE PROCEDURE lbc_lnk_2d_e 103 98 END INTERFACE 104 105 TYPE arrayptr106 REAL , DIMENSION (:,:), POINTER :: pt2d107 END TYPE arrayptr108 PUBLIC arrayptr109 99 110 100 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 111 101 PUBLIC lbc_lnk_e ! 112 PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions113 102 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 114 103 PUBLIC lbc_lnk_icb ! … … 192 181 ! 193 182 END SUBROUTINE lbc_lnk_2d 194 195 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )196 !!197 INTEGER :: num_fields198 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array199 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points200 ! ! = T , U , V , F , W and I points201 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary202 ! ! = 1. , the sign is kept203 !204 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES205 !206 DO ii = 1, num_fields207 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )208 END DO209 !210 END SUBROUTINE lbc_lnk_2d_multiple211 212 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC &213 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF &214 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)215 !!---------------------------------------------------------------------216 ! Second 2D array on which the boundary condition is applied217 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA218 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE219 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI220 ! define the nature of ptab array grid-points221 CHARACTER(len=1) , INTENT(in ) :: cd_typeA222 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE223 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI224 ! =-1 the sign change across the north fold boundary225 REAL(wp) , INTENT(in ) :: psgnA226 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE227 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI228 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only229 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries)230 !!231 !!---------------------------------------------------------------------232 233 !!The first array234 CALL lbc_lnk( pt2dA, cd_typeA, psgnA )235 236 !! Look if more arrays to process237 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )238 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )239 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )240 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )241 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )242 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )243 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )244 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )245 246 END SUBROUTINE lbc_lnk_2d_9247 248 249 250 251 183 252 184 #else … … 447 379 ! 448 380 END SUBROUTINE lbc_lnk_2d 449 450 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )451 !!452 INTEGER :: num_fields453 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array454 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points455 ! ! = T , U , V , F , W and I points456 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary457 ! ! = 1. , the sign is kept458 !459 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES460 !461 DO ii = 1, num_fields462 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )463 END DO464 !465 END SUBROUTINE lbc_lnk_2d_multiple466 467 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC &468 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF &469 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)470 !!---------------------------------------------------------------------471 ! Second 2D array on which the boundary condition is applied472 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA473 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE474 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI475 ! define the nature of ptab array grid-points476 CHARACTER(len=1) , INTENT(in ) :: cd_typeA477 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE478 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI479 ! =-1 the sign change across the north fold boundary480 REAL(wp) , INTENT(in ) :: psgnA481 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE482 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI483 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only484 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries)485 !!486 !!---------------------------------------------------------------------487 488 !!The first array489 CALL lbc_lnk( pt2dA, cd_typeA, psgnA )490 491 !! Look if more arrays to process492 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA )493 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )494 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )495 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )496 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )497 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )498 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )499 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )500 501 END SUBROUTINE lbc_lnk_2d_9502 503 381 504 382 #endif … … 570 448 !!====================================================================== 571 449 END MODULE lbclnk 572
Note: See TracChangeset
for help on using the changeset viewer.