Changeset 6924
- Timestamp:
- 2016-09-09T09:18:21+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_HPC_Gyre_benchmark_test/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r6140 r6924 82 82 END INTERFACE 83 83 ! 84 INTERFACE lbc_sum 85 MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 86 END INTERFACE 87 84 ! INTERFACE lbc_sum 85 ! MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 86 ! END INTERFACE 87 ! 88 INTERFACE lbc_lnk_multi 89 MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 90 END INTERFACE 91 ! 88 92 INTERFACE lbc_lnk_e 89 93 MODULE PROCEDURE lbc_lnk_2d_e … … 97 101 MODULE PROCEDURE lbc_lnk_2d_e 98 102 END INTERFACE 103 104 TYPE arrayptr 105 REAL , DIMENSION (:,:), POINTER :: pt2d 106 END TYPE arrayptr 107 PUBLIC arrayptr 99 108 100 109 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions … … 102 111 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 103 112 PUBLIC lbc_lnk_icb ! 113 PUBLIC lbc_lnk_multi 104 114 105 115 !!---------------------------------------------------------------------- … … 380 390 END SUBROUTINE lbc_lnk_2d 381 391 392 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 393 !! 394 INTEGER :: num_fields 395 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 396 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 397 ! ! = T , U , V , F , W and I points 398 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 399 ! ! = 1. , the sign is kept 400 ! 401 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 402 ! 403 DO ii = 1, num_fields 404 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 405 END DO 406 ! 407 END SUBROUTINE lbc_lnk_2d_multiple 408 409 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 410 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 411 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 412 !!--------------------------------------------------------------------- 413 ! Second 2D array on which the boundary condition is applied 414 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 415 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 416 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 417 ! define the nature of ptab array grid-points 418 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 419 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 420 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 421 ! =-1 the sign change across the north fold boundary 422 REAL(wp) , INTENT(in ) :: psgnA 423 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 424 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 425 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 426 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 427 !! 428 !!--------------------------------------------------------------------- 429 430 !!The first array 431 CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 432 433 !! Look if more arrays to process 434 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 435 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 436 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 437 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 438 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 439 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 440 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 441 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 442 443 END SUBROUTINE lbc_lnk_2d_9 444 382 445 #endif 383 446
Note: See TracChangeset
for help on using the changeset viewer.