- Timestamp:
- 2017-12-13T15:58:53+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r7646 r9019 5 5 !!====================================================================== 6 6 !! History : 3.2 ! 2009-03 (R. Benshila) Original code 7 !! 3.5 ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 7 !! 3.5 ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 8 !! 4.0 ! 2017-04 (G. Madec) automatique allocation of array argument (use any 3rd dimension) 8 9 !!---------------------------------------------------------------------- 9 10 … … 12 13 !! lbc_nfd_3d : lateral boundary condition: North fold treatment for a 3D arrays (lbc_nfd) 13 14 !! lbc_nfd_2d : lateral boundary condition: North fold treatment for a 2D arrays (lbc_nfd) 14 !! mpp_lbc_nfd_3d : North fold treatment for a 3D arrays optimized for MPP 15 !! mpp_lbc_nfd_2d : North fold treatment for a 2D arrays optimized for MPP 15 !! lbc_nfd_nogather : generic interface for lbc_nfd_nogather_3d and 16 !! lbc_nfd_nogather_2d routines (designed for use 17 !! with ln_nnogather to avoid global width arrays 18 !! mpi all gather operations) 16 19 !!---------------------------------------------------------------------- 17 20 USE dom_oce ! ocean space and time domain … … 22 25 23 26 INTERFACE lbc_nfd 24 MODULE PROCEDURE lbc_nfd_3d, lbc_nfd_2d 27 MODULE PROCEDURE lbc_nfd_2d , lbc_nfd_3d , lbc_nfd_4d 28 MODULE PROCEDURE lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr 29 MODULE PROCEDURE lbc_nfd_2d_ext 25 30 END INTERFACE 26 31 ! 27 INTERFACE mpp_lbc_nfd 28 MODULE PROCEDURE mpp_lbc_nfd_3d, mpp_lbc_nfd_2d 32 INTERFACE lbc_nfd_nogather 33 ! ! Currently only 4d array version is needed 34 ! MODULE PROCEDURE lbc_nfd_nogather_2d , lbc_nfd_nogather_3d 35 MODULE PROCEDURE lbc_nfd_nogather_4d 36 ! MODULE PROCEDURE lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr 37 ! MODULE PROCEDURE lbc_nfd_nogather_4d_ptr 29 38 END INTERFACE 30 39 31 PUBLIC lbc_nfd ! north fold conditions 32 PUBLIC mpp_lbc_nfd ! north fold conditions (parallel case) 40 TYPE, PUBLIC :: PTR_2D !: array of 2D pointers (also used in lib_mpp) 41 REAL(wp), DIMENSION (:,:) , POINTER :: pt2d 42 END TYPE PTR_2D 43 TYPE, PUBLIC :: PTR_3D !: array of 3D pointers (also used in lib_mpp) 44 REAL(wp), DIMENSION (:,:,:) , POINTER :: pt3d 45 END TYPE PTR_3D 46 TYPE, PUBLIC :: PTR_4D !: array of 4D pointers (also used in lib_mpp) 47 REAL(wp), DIMENSION (:,:,:,:), POINTER :: pt4d 48 END TYPE PTR_4D 49 50 PUBLIC lbc_nfd ! north fold conditions 51 PUBLIC lbc_nfd_nogather ! north fold conditions (no allgather case) 33 52 34 53 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 3 !: … … 43 62 CONTAINS 44 63 45 SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn ) 46 !!---------------------------------------------------------------------- 47 !! *** routine lbc_nfd_3d *** 48 !! 49 !! ** Purpose : 3D lateral boundary condition : North fold treatment 50 !! without processor exchanges. 51 !! 52 !! ** Method : 53 !! 54 !! ** Action : pt3d with updated values along the north fold 55 !!---------------------------------------------------------------------- 56 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 57 ! ! = T , U , V , F , W points 58 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change 59 ! ! = -1. , the sign is changed if north fold boundary 60 ! ! = 1. , the sign is kept if north fold boundary 61 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3d ! 3D array on which the boundary condition is applied 62 ! 63 INTEGER :: ji, jk 64 INTEGER :: ijt, iju, ijpj, ijpjm1 65 !!---------------------------------------------------------------------- 64 !!---------------------------------------------------------------------- 65 !! *** routine lbc_nfd_(2,3,4)d *** 66 !!---------------------------------------------------------------------- 67 !! 68 !! ** Purpose : lateral boundary condition 69 !! North fold treatment without processor exchanges. 70 !! 71 !! ** Method : 72 !! 73 !! ** Action : ptab with updated values along the north fold 74 !!---------------------------------------------------------------------- 75 ! 76 ! !== 2D array and array of 2D pointer ==! 77 ! 78 # define DIM_2d 79 # define ROUTINE_NFD lbc_nfd_2d 80 # include "lbc_nfd_generic.h90" 81 # undef ROUTINE_NFD 82 # define MULTI 83 # define ROUTINE_NFD lbc_nfd_2d_ptr 84 # include "lbc_nfd_generic.h90" 85 # undef ROUTINE_NFD 86 # undef MULTI 87 # undef DIM_2d 88 ! 89 ! !== 2D array with extra haloes ==! 90 ! 91 # define DIM_2d 92 # define ROUTINE_NFD lbc_nfd_2d_ext 93 # include "lbc_nfd_ext_generic.h90" 94 # undef ROUTINE_NFD 95 # undef DIM_2d 96 ! 97 ! !== 3D array and array of 3D pointer ==! 98 ! 99 # define DIM_3d 100 # define ROUTINE_NFD lbc_nfd_3d 101 # include "lbc_nfd_generic.h90" 102 # undef ROUTINE_NFD 103 # define MULTI 104 # define ROUTINE_NFD lbc_nfd_3d_ptr 105 # include "lbc_nfd_generic.h90" 106 # undef ROUTINE_NFD 107 # undef MULTI 108 # undef DIM_3d 109 ! 110 ! !== 4D array and array of 4D pointer ==! 111 ! 112 # define DIM_4d 113 # define ROUTINE_NFD lbc_nfd_4d 114 # include "lbc_nfd_generic.h90" 115 # undef ROUTINE_NFD 116 # define MULTI 117 # define ROUTINE_NFD lbc_nfd_4d_ptr 118 # include "lbc_nfd_generic.h90" 119 # undef ROUTINE_NFD 120 # undef MULTI 121 # undef DIM_4d 122 ! 123 ! lbc_nfd_nogather routines 124 ! 125 ! !== 2D array and array of 2D pointer ==! 126 ! 127 !# define DIM_2d 128 !# define ROUTINE_NFD lbc_nfd_nogather_2d 129 !# include "lbc_nfd_nogather_generic.h90" 130 !# undef ROUTINE_NFD 131 !# define MULTI 132 !# define ROUTINE_NFD lbc_nfd_nogather_2d_ptr 133 !# include "lbc_nfd_nogather_generic.h90" 134 !# undef ROUTINE_NFD 135 !# undef MULTI 136 !# undef DIM_2d 137 ! 138 ! !== 3D array and array of 3D pointer ==! 139 ! 140 !# define DIM_3d 141 !# define ROUTINE_NFD lbc_nfd_nogather_3d 142 !# include "lbc_nfd_nogather_generic.h90" 143 !# undef ROUTINE_NFD 144 !# define MULTI 145 !# define ROUTINE_NFD lbc_nfd_nogather_3d_ptr 146 !# include "lbc_nfd_nogather_generic.h90" 147 !# undef ROUTINE_NFD 148 !# undef MULTI 149 !# undef DIM_3d 150 ! 151 ! !== 4D array and array of 4D pointer ==! 152 ! 153 # define DIM_4d 154 # define ROUTINE_NFD lbc_nfd_nogather_4d 155 # include "lbc_nfd_nogather_generic.h90" 156 # undef ROUTINE_NFD 157 !# define MULTI 158 !# define ROUTINE_NFD lbc_nfd_nogather_4d_ptr 159 !# include "lbc_nfd_nogather_generic.h90" 160 !# undef ROUTINE_NFD 161 !# undef MULTI 162 # undef DIM_4d 66 163 67 SELECT CASE ( jpni ) 68 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 69 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 70 END SELECT 71 ijpjm1 = ijpj-1 164 !!---------------------------------------------------------------------- 72 165 73 DO jk = 1, jpk74 !75 SELECT CASE ( npolj )76 !77 CASE ( 3 , 4 ) ! * North fold T-point pivot78 !79 SELECT CASE ( cd_type )80 CASE ( 'T' , 'W' ) ! T-, W-point81 DO ji = 2, jpiglo82 ijt = jpiglo-ji+283 pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)84 END DO85 pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)86 DO ji = jpiglo/2+1, jpiglo87 ijt = jpiglo-ji+288 pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)89 END DO90 CASE ( 'U' ) ! U-point91 DO ji = 1, jpiglo-192 iju = jpiglo-ji+193 pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)94 END DO95 pt3d( 1 ,ijpj,jk) = psgn * pt3d( 2 ,ijpj-2,jk)96 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk)97 DO ji = jpiglo/2, jpiglo-198 iju = jpiglo-ji+199 pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)100 END DO101 CASE ( 'V' ) ! V-point102 DO ji = 2, jpiglo103 ijt = jpiglo-ji+2104 pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)105 pt3d(ji,ijpj ,jk) = psgn * pt3d(ijt,ijpj-3,jk)106 END DO107 pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk)108 CASE ( 'F' ) ! F-point109 DO ji = 1, jpiglo-1110 iju = jpiglo-ji+1111 pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)112 pt3d(ji,ijpj ,jk) = psgn * pt3d(iju,ijpj-3,jk)113 END DO114 pt3d( 1 ,ijpj,jk) = psgn * pt3d( 2 ,ijpj-3,jk)115 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk)116 END SELECT117 !118 CASE ( 5 , 6 ) ! * North fold F-point pivot119 !120 SELECT CASE ( cd_type )121 CASE ( 'T' , 'W' ) ! T-, W-point122 DO ji = 1, jpiglo123 ijt = jpiglo-ji+1124 pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)125 END DO126 CASE ( 'U' ) ! U-point127 DO ji = 1, jpiglo-1128 iju = jpiglo-ji129 pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)130 END DO131 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)132 CASE ( 'V' ) ! V-point133 DO ji = 1, jpiglo134 ijt = jpiglo-ji+1135 pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)136 END DO137 DO ji = jpiglo/2+1, jpiglo138 ijt = jpiglo-ji+1139 pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)140 END DO141 CASE ( 'F' ) ! F-point142 DO ji = 1, jpiglo-1143 iju = jpiglo-ji144 pt3d(ji,ijpj ,jk) = psgn * pt3d(iju,ijpj-2,jk)145 END DO146 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)147 DO ji = jpiglo/2+1, jpiglo-1148 iju = jpiglo-ji149 pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)150 END DO151 END SELECT152 !153 CASE DEFAULT ! * closed : the code probably never go through154 !155 SELECT CASE ( cd_type)156 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points157 pt3d(:, 1 ,jk) = 0.e0158 pt3d(:,ijpj,jk) = 0.e0159 CASE ( 'F' ) ! F-point160 pt3d(:,ijpj,jk) = 0.e0161 END SELECT162 !163 END SELECT ! npolj164 !165 END DO166 !167 END SUBROUTINE lbc_nfd_3d168 169 170 SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )171 !!----------------------------------------------------------------------172 !! *** routine lbc_nfd_2d ***173 !!174 !! ** Purpose : 2D lateral boundary condition : North fold treatment175 !! without processor exchanges.176 !!177 !! ** Method :178 !!179 !! ** Action : pt2d with updated values along the north fold180 !!----------------------------------------------------------------------181 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points182 ! ! = T , U , V , F , W points183 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change184 ! ! = -1. , the sign is changed if north fold boundary185 ! ! = 1. , the sign is kept if north fold boundary186 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied187 INTEGER , OPTIONAL , INTENT(in ) :: pr2dj ! number of additional halos188 !189 INTEGER :: ji, jl, ipr2dj190 INTEGER :: ijt, iju, ijpj, ijpjm1191 !!----------------------------------------------------------------------192 193 SELECT CASE ( jpni )194 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction195 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction196 END SELECT197 !198 IF( PRESENT(pr2dj) ) THEN ! use of additional halos199 ipr2dj = pr2dj200 IF( jpni > 1 ) ijpj = ijpj + ipr2dj201 ELSE202 ipr2dj = 0203 ENDIF204 !205 ijpjm1 = ijpj-1206 207 208 SELECT CASE ( npolj )209 !210 CASE ( 3, 4 ) ! * North fold T-point pivot211 !212 SELECT CASE ( cd_type )213 !214 CASE ( 'T' , 'W' ) ! T- , W-points215 DO jl = 0, ipr2dj216 DO ji = 2, jpiglo217 ijt=jpiglo-ji+2218 pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)219 END DO220 END DO221 pt2d(1,ijpj) = psgn * pt2d(3,ijpj-2)222 DO ji = jpiglo/2+1, jpiglo223 ijt=jpiglo-ji+2224 pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)225 END DO226 CASE ( 'U' ) ! U-point227 DO jl = 0, ipr2dj228 DO ji = 1, jpiglo-1229 iju = jpiglo-ji+1230 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)231 END DO232 END DO233 pt2d( 1 ,ijpj ) = psgn * pt2d( 2 ,ijpj-2)234 pt2d(jpiglo,ijpj ) = psgn * pt2d(jpiglo-1,ijpj-2)235 pt2d(1 ,ijpj-1) = psgn * pt2d(jpiglo ,ijpj-1)236 DO ji = jpiglo/2, jpiglo-1237 iju = jpiglo-ji+1238 pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)239 END DO240 CASE ( 'V' ) ! V-point241 DO jl = -1, ipr2dj242 DO ji = 2, jpiglo243 ijt = jpiglo-ji+2244 pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)245 END DO246 END DO247 pt2d( 1 ,ijpj) = psgn * pt2d( 3 ,ijpj-3)248 CASE ( 'F' ) ! F-point249 DO jl = -1, ipr2dj250 DO ji = 1, jpiglo-1251 iju = jpiglo-ji+1252 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)253 END DO254 END DO255 pt2d( 1 ,ijpj) = psgn * pt2d( 2 ,ijpj-3)256 pt2d(jpiglo,ijpj) = psgn * pt2d(jpiglo-1,ijpj-3)257 pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)258 pt2d( 1 ,ijpj-1) = psgn * pt2d( 2 ,ijpj-2)259 CASE ( 'I' ) ! ice U-V point (I-point)260 DO jl = 0, ipr2dj261 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)262 DO ji = 3, jpiglo263 iju = jpiglo - ji + 3264 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)265 END DO266 END DO267 CASE ( 'J' ) ! first ice U-V point268 DO jl =0, ipr2dj269 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)270 DO ji = 3, jpiglo271 iju = jpiglo - ji + 3272 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)273 END DO274 END DO275 CASE ( 'K' ) ! second ice U-V point276 DO jl =0, ipr2dj277 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)278 DO ji = 3, jpiglo279 iju = jpiglo - ji + 3280 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)281 END DO282 END DO283 END SELECT284 !285 CASE ( 5, 6 ) ! * North fold F-point pivot286 !287 SELECT CASE ( cd_type )288 CASE ( 'T' , 'W' ) ! T-, W-point289 DO jl = 0, ipr2dj290 DO ji = 1, jpiglo291 ijt = jpiglo-ji+1292 pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)293 END DO294 END DO295 CASE ( 'U' ) ! U-point296 DO jl = 0, ipr2dj297 DO ji = 1, jpiglo-1298 iju = jpiglo-ji299 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)300 END DO301 END DO302 pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)303 CASE ( 'V' ) ! V-point304 DO jl = 0, ipr2dj305 DO ji = 1, jpiglo306 ijt = jpiglo-ji+1307 pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)308 END DO309 END DO310 DO ji = jpiglo/2+1, jpiglo311 ijt = jpiglo-ji+1312 pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)313 END DO314 CASE ( 'F' ) ! F-point315 DO jl = 0, ipr2dj316 DO ji = 1, jpiglo-1317 iju = jpiglo-ji318 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)319 END DO320 END DO321 pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)322 DO ji = jpiglo/2+1, jpiglo-1323 iju = jpiglo-ji324 pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)325 END DO326 CASE ( 'I' ) ! ice U-V point (I-point)327 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0328 DO jl = 0, ipr2dj329 DO ji = 2 , jpiglo-1330 ijt = jpiglo - ji + 2331 pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )332 END DO333 END DO334 CASE ( 'J' ) ! first ice U-V point335 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0336 DO jl = 0, ipr2dj337 DO ji = 2 , jpiglo-1338 ijt = jpiglo - ji + 2339 pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl)340 END DO341 END DO342 CASE ( 'K' ) ! second ice U-V point343 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0344 DO jl = 0, ipr2dj345 DO ji = 2 , jpiglo-1346 ijt = jpiglo - ji + 2347 pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl)348 END DO349 END DO350 END SELECT351 !352 CASE DEFAULT ! * closed : the code probably never go through353 !354 SELECT CASE ( cd_type)355 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points356 pt2d(:, 1:1-ipr2dj ) = 0.e0357 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0358 CASE ( 'F' ) ! F-point359 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0360 CASE ( 'I' ) ! ice U-V point361 pt2d(:, 1:1-ipr2dj ) = 0.e0362 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0363 CASE ( 'J' ) ! first ice U-V point364 pt2d(:, 1:1-ipr2dj ) = 0.e0365 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0366 CASE ( 'K' ) ! second ice U-V point367 pt2d(:, 1:1-ipr2dj ) = 0.e0368 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0369 END SELECT370 !371 END SELECT372 !373 END SUBROUTINE lbc_nfd_2d374 375 376 SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn )377 !!----------------------------------------------------------------------378 !! *** routine mpp_lbc_nfd_3d ***379 !!380 !! ** Purpose : 3D lateral boundary condition : North fold treatment381 !! without processor exchanges.382 !!383 !! ** Method :384 !!385 !! ** Action : pt3d with updated values along the north fold386 !!----------------------------------------------------------------------387 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points388 ! ! = T , U , V , F , W points389 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change390 ! ! = -1. , the sign is changed if north fold boundary391 ! ! = 1. , the sign is kept if north fold boundary392 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3dl ! 3D array on which the boundary condition is applied393 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pt3dr ! 3D array on which the boundary condition is applied394 !395 INTEGER :: ji, jk396 INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop397 !!----------------------------------------------------------------------398 !399 SELECT CASE ( jpni )400 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction401 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction402 END SELECT403 ijpjm1 = ijpj-1404 405 !406 SELECT CASE ( npolj )407 !408 CASE ( 3 , 4 ) ! * North fold T-point pivot409 !410 SELECT CASE ( cd_type )411 CASE ( 'T' , 'W' ) ! T-, W-point412 IF (nimpp .ne. 1) THEN413 startloop = 1414 ELSE415 startloop = 2416 ENDIF417 418 DO jk = 1, jpk419 DO ji = startloop, nlci420 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4421 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)422 END DO423 IF(nimpp .eq. 1) THEN424 pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk)425 ENDIF426 END DO427 428 IF(nimpp .ge. (jpiglo/2+1)) THEN429 startloop = 1430 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN431 startloop = jpiglo/2+1 - nimpp + 1432 ELSE433 startloop = nlci + 1434 ENDIF435 IF(startloop .le. nlci) THEN436 DO jk = 1, jpk437 DO ji = startloop, nlci438 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4439 jia = ji + nimpp - 1440 ijta = jpiglo - jia + 2441 IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN442 pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk)443 ELSE444 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)445 ENDIF446 END DO447 END DO448 ENDIF449 450 451 CASE ( 'U' ) ! U-point452 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN453 endloop = nlci454 ELSE455 endloop = nlci - 1456 ENDIF457 DO jk = 1, jpk458 DO ji = 1, endloop459 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3460 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk)461 END DO462 IF(nimpp .eq. 1) THEN463 pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-2,jk)464 ENDIF465 IF((nimpp + nlci - 1) .eq. jpiglo) THEN466 pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk)467 ENDIF468 END DO469 470 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN471 endloop = nlci472 ELSE473 endloop = nlci - 1474 ENDIF475 IF(nimpp .ge. (jpiglo/2)) THEN476 startloop = 1477 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN478 startloop = jpiglo/2 - nimpp + 1479 ELSE480 startloop = endloop + 1481 ENDIF482 IF (startloop .le. endloop) THEN483 DO jk = 1, jpk484 DO ji = startloop, endloop485 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3486 jia = ji + nimpp - 1487 ijua = jpiglo - jia + 1488 IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN489 pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk)490 ELSE491 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)492 ENDIF493 END DO494 END DO495 ENDIF496 497 CASE ( 'V' ) ! V-point498 IF (nimpp .ne. 1) THEN499 startloop = 1500 ELSE501 startloop = 2502 ENDIF503 DO jk = 1, jpk504 DO ji = startloop, nlci505 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4506 pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk)507 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(ijt,ijpj-3,jk)508 END DO509 IF(nimpp .eq. 1) THEN510 pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk)511 ENDIF512 END DO513 CASE ( 'F' ) ! F-point514 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN515 endloop = nlci516 ELSE517 endloop = nlci - 1518 ENDIF519 DO jk = 1, jpk520 DO ji = 1, endloop521 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3522 pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk)523 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-3,jk)524 END DO525 IF(nimpp .eq. 1) THEN526 pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-3,jk)527 ENDIF528 IF((nimpp + nlci - 1) .eq. jpiglo) THEN529 pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk)530 ENDIF531 END DO532 END SELECT533 !534 535 CASE ( 5 , 6 ) ! * North fold F-point pivot536 !537 SELECT CASE ( cd_type )538 CASE ( 'T' , 'W' ) ! T-, W-point539 DO jk = 1, jpk540 DO ji = 1, nlci541 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3542 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk)543 END DO544 END DO545 546 CASE ( 'U' ) ! U-point547 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN548 endloop = nlci549 ELSE550 endloop = nlci - 1551 ENDIF552 DO jk = 1, jpk553 DO ji = 1, endloop554 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2555 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk)556 END DO557 IF((nimpp + nlci - 1) .eq. jpiglo) THEN558 pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk)559 ENDIF560 END DO561 562 CASE ( 'V' ) ! V-point563 DO jk = 1, jpk564 DO ji = 1, nlci565 ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3566 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk)567 END DO568 END DO569 570 IF(nimpp .ge. (jpiglo/2+1)) THEN571 startloop = 1572 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN573 startloop = jpiglo/2+1 - nimpp + 1574 ELSE575 startloop = nlci + 1576 ENDIF577 IF(startloop .le. nlci) THEN578 DO jk = 1, jpk579 DO ji = startloop, nlci580 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3581 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk)582 END DO583 END DO584 ENDIF585 586 CASE ( 'F' ) ! F-point587 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN588 endloop = nlci589 ELSE590 endloop = nlci - 1591 ENDIF592 DO jk = 1, jpk593 DO ji = 1, endloop594 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2595 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk)596 END DO597 IF((nimpp + nlci - 1) .eq. jpiglo) THEN598 pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk)599 ENDIF600 END DO601 602 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN603 endloop = nlci604 ELSE605 endloop = nlci - 1606 ENDIF607 IF(nimpp .ge. (jpiglo/2+1)) THEN608 startloop = 1609 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN610 startloop = jpiglo/2+1 - nimpp + 1611 ELSE612 startloop = endloop + 1613 ENDIF614 IF (startloop .le. endloop) THEN615 DO jk = 1, jpk616 DO ji = startloop, endloop617 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2618 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk)619 END DO620 END DO621 ENDIF622 623 END SELECT624 625 CASE DEFAULT ! * closed : the code probably never go through626 !627 SELECT CASE ( cd_type)628 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points629 pt3dl(:, 1 ,jk) = 0.e0630 pt3dl(:,ijpj,jk) = 0.e0631 CASE ( 'F' ) ! F-point632 pt3dl(:,ijpj,jk) = 0.e0633 END SELECT634 !635 END SELECT ! npolj636 !637 !638 END SUBROUTINE mpp_lbc_nfd_3d639 640 641 SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn )642 !!----------------------------------------------------------------------643 !! *** routine mpp_lbc_nfd_2d ***644 !!645 !! ** Purpose : 2D lateral boundary condition : North fold treatment646 !! without processor exchanges.647 !!648 !! ** Method :649 !!650 !! ** Action : pt2d with updated values along the north fold651 !!----------------------------------------------------------------------652 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points653 ! ! = T , U , V , F , W points654 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change655 ! ! = -1. , the sign is changed if north fold boundary656 ! ! = 1. , the sign is kept if north fold boundary657 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2dl ! 2D array on which the boundary condition is applied658 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pt2dr ! 2D array on which the boundary condition is applied659 !660 INTEGER :: ji661 INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop662 !!----------------------------------------------------------------------663 664 SELECT CASE ( jpni )665 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction666 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction667 END SELECT668 !669 ijpjm1 = ijpj-1670 671 672 SELECT CASE ( npolj )673 !674 CASE ( 3, 4 ) ! * North fold T-point pivot675 !676 SELECT CASE ( cd_type )677 !678 CASE ( 'T' , 'W' ) ! T- , W-points679 IF (nimpp .ne. 1) THEN680 startloop = 1681 ELSE682 startloop = 2683 ENDIF684 DO ji = startloop, nlci685 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4686 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)687 END DO688 IF (nimpp .eq. 1) THEN689 pt2dl(1,ijpj) = psgn * pt2dl(3,ijpj-2)690 ENDIF691 692 IF(nimpp .ge. (jpiglo/2+1)) THEN693 startloop = 1694 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN695 startloop = jpiglo/2+1 - nimpp + 1696 ELSE697 startloop = nlci + 1698 ENDIF699 DO ji = startloop, nlci700 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4701 jia = ji + nimpp - 1702 ijta = jpiglo - jia + 2703 IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN704 pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1)705 ELSE706 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)707 ENDIF708 END DO709 710 CASE ( 'U' ) ! U-point711 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN712 endloop = nlci713 ELSE714 endloop = nlci - 1715 ENDIF716 DO ji = 1, endloop717 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3718 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)719 END DO720 721 IF (nimpp .eq. 1) THEN722 pt2dl( 1 ,ijpj ) = psgn * pt2dl( 2 ,ijpj-2)723 pt2dl(1 ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1)724 ENDIF725 IF((nimpp + nlci - 1) .eq. jpiglo) THEN726 pt2dl(nlci,ijpj ) = psgn * pt2dl(nlci-1,ijpj-2)727 ENDIF728 729 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN730 endloop = nlci731 ELSE732 endloop = nlci - 1733 ENDIF734 IF(nimpp .ge. (jpiglo/2)) THEN735 startloop = 1736 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN737 startloop = jpiglo/2 - nimpp + 1738 ELSE739 startloop = endloop + 1740 ENDIF741 DO ji = startloop, endloop742 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3743 jia = ji + nimpp - 1744 ijua = jpiglo - jia + 1745 IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN746 pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1)747 ELSE748 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)749 ENDIF750 END DO751 752 CASE ( 'V' ) ! V-point753 IF (nimpp .ne. 1) THEN754 startloop = 1755 ELSE756 startloop = 2757 ENDIF758 DO ji = startloop, nlci759 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4760 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1)761 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2)762 END DO763 IF (nimpp .eq. 1) THEN764 pt2dl( 1 ,ijpj) = psgn * pt2dl( 3 ,ijpj-3)765 ENDIF766 767 CASE ( 'F' ) ! F-point768 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN769 endloop = nlci770 ELSE771 endloop = nlci - 1772 ENDIF773 DO ji = 1, endloop774 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3775 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1)776 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2)777 END DO778 IF (nimpp .eq. 1) THEN779 pt2dl( 1 ,ijpj) = psgn * pt2dl( 2 ,ijpj-3)780 pt2dl( 1 ,ijpj-1) = psgn * pt2dl( 2 ,ijpj-2)781 ENDIF782 IF((nimpp + nlci - 1) .eq. jpiglo) THEN783 pt2dl(nlci,ijpj) = psgn * pt2dl(nlci-1,ijpj-3)784 pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2)785 ENDIF786 787 CASE ( 'I' ) ! ice U-V point (I-point)788 IF (nimpp .ne. 1) THEN789 startloop = 1790 ELSE791 startloop = 3792 pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1)793 ENDIF794 DO ji = startloop, nlci795 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5796 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)797 END DO798 799 CASE ( 'J' ) ! first ice U-V point800 IF (nimpp .ne. 1) THEN801 startloop = 1802 ELSE803 startloop = 3804 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)805 ENDIF806 DO ji = startloop, nlci807 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5808 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)809 END DO810 811 CASE ( 'K' ) ! second ice U-V point812 IF (nimpp .ne. 1) THEN813 startloop = 1814 ELSE815 startloop = 3816 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1)817 ENDIF818 DO ji = startloop, nlci819 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5820 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)821 END DO822 823 END SELECT824 !825 CASE ( 5, 6 ) ! * North fold F-point pivot826 !827 SELECT CASE ( cd_type )828 CASE ( 'T' , 'W' ) ! T-, W-point829 DO ji = 1, nlci830 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3831 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1)832 END DO833 834 CASE ( 'U' ) ! U-point835 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN836 endloop = nlci837 ELSE838 endloop = nlci - 1839 ENDIF840 DO ji = 1, endloop841 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2842 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1)843 END DO844 IF((nimpp + nlci - 1) .eq. jpiglo) THEN845 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1)846 ENDIF847 848 CASE ( 'V' ) ! V-point849 DO ji = 1, nlci850 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3851 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1)852 END DO853 IF(nimpp .ge. (jpiglo/2+1)) THEN854 startloop = 1855 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN856 startloop = jpiglo/2+1 - nimpp + 1857 ELSE858 startloop = nlci + 1859 ENDIF860 DO ji = startloop, nlci861 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3862 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1)863 END DO864 865 CASE ( 'F' ) ! F-point866 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN867 endloop = nlci868 ELSE869 endloop = nlci - 1870 ENDIF871 DO ji = 1, endloop872 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2873 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1)874 END DO875 IF((nimpp + nlci - 1) .eq. jpiglo) THEN876 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2)877 ENDIF878 879 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN880 endloop = nlci881 ELSE882 endloop = nlci - 1883 ENDIF884 IF(nimpp .ge. (jpiglo/2+1)) THEN885 startloop = 1886 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN887 startloop = jpiglo/2+1 - nimpp + 1888 ELSE889 startloop = endloop + 1890 ENDIF891 892 DO ji = startloop, endloop893 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2894 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1)895 END DO896 897 CASE ( 'I' ) ! ice U-V point (I-point)898 IF (nimpp .ne. 1) THEN899 startloop = 1900 ELSE901 startloop = 2902 ENDIF903 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN904 endloop = nlci905 ELSE906 endloop = nlci - 1907 ENDIF908 DO ji = startloop , endloop909 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4910 pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))911 END DO912 913 CASE ( 'J' ) ! first ice U-V point914 IF (nimpp .ne. 1) THEN915 startloop = 1916 ELSE917 startloop = 2918 ENDIF919 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN920 endloop = nlci921 ELSE922 endloop = nlci - 1923 ENDIF924 DO ji = startloop , endloop925 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4926 pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1)927 END DO928 929 CASE ( 'K' ) ! second ice U-V point930 IF (nimpp .ne. 1) THEN931 startloop = 1932 ELSE933 startloop = 2934 ENDIF935 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN936 endloop = nlci937 ELSE938 endloop = nlci - 1939 ENDIF940 DO ji = startloop, endloop941 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4942 pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1)943 END DO944 945 END SELECT946 !947 CASE DEFAULT ! * closed : the code probably never go through948 !949 SELECT CASE ( cd_type)950 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points951 pt2dl(:, 1 ) = 0.e0952 pt2dl(:,ijpj) = 0.e0953 CASE ( 'F' ) ! F-point954 pt2dl(:,ijpj) = 0.e0955 CASE ( 'I' ) ! ice U-V point956 pt2dl(:, 1 ) = 0.e0957 pt2dl(:,ijpj) = 0.e0958 CASE ( 'J' ) ! first ice U-V point959 pt2dl(:, 1 ) = 0.e0960 pt2dl(:,ijpj) = 0.e0961 CASE ( 'K' ) ! second ice U-V point962 pt2dl(:, 1 ) = 0.e0963 pt2dl(:,ijpj) = 0.e0964 END SELECT965 !966 END SELECT967 !968 END SUBROUTINE mpp_lbc_nfd_2d969 166 970 167 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.