Changeset 1344 for trunk/NEMO/OPA_SRC/lbclnk.F90
- Timestamp:
- 2009-03-27T15:02:19+01:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/lbclnk.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/lbclnk.F90
r1146 r1344 4 4 !! Ocean : lateral boundary conditions 5 5 !!===================================================================== 6 !! OPA 9.0 , LOCEAN-IPSL (2005) 7 !! $Id$ 8 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 9 !!---------------------------------------------------------------------- 6 10 #if defined key_mpp_mpi || defined key_mpp_shmem 7 11 !!---------------------------------------------------------------------- … … 44 48 USE dom_oce ! ocean space and time domain 45 49 USE in_out_manager ! I/O manager 50 USE lbcnfd ! north fold 46 51 47 52 IMPLICIT NONE … … 71 76 !! 72 77 !! History : 73 !! ! 97-06 (G. Madec) Original code 74 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 78 !! ! 97-06 (G. Madec) Original code 79 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 80 !! ! 09-03 (R. Benshila) External north fold treatment 75 81 !!---------------------------------------------------------------------- 76 82 !! * Arguments 77 83 CHARACTER(len=1), INTENT( in ) :: & 78 84 cd_type1, cd_type2 ! nature of pt3d grid-points 79 85 ! ! = T , U , V , F or W gridpoints 80 86 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: & 81 87 pt3d1, pt3d2 ! 3D array on which the boundary condition is applied 82 88 REAL(wp), INTENT( in ) :: & 83 89 psgn ! control of the sign change 84 ! ! =-1 , the sign is changed if north fold boundary 85 ! ! = 1 , no sign change 86 ! ! = 0 , no sign change and > 0 required (use the inner 87 ! ! row/column if closed boundary) 88 89 90 !! * Local declarations 91 INTEGER :: ji, jk 92 INTEGER :: ijt, iju 93 !!---------------------------------------------------------------------- 94 !! OPA 9.0 , LOCEAN-IPSL (2005) 95 !! $Id$ 96 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 97 !!---------------------------------------------------------------------- 98 99 ! ! =============== 100 DO jk = 1, jpk ! Horizontal slab 101 ! ! =============== 102 103 ! ! East-West boundaries 104 ! ! ==================== 105 SELECT CASE ( nperio ) 106 107 CASE ( 1 , 4 , 6 ) ! * cyclic east-west 108 pt3d1( 1 ,:,jk) = pt3d1(jpim1,:,jk) ! all points 109 pt3d1(jpi,:,jk) = pt3d1( 2 ,:,jk) 110 pt3d2( 1 ,:,jk) = pt3d2(jpim1,:,jk) 111 pt3d2(jpi,:,jk) = pt3d2( 2 ,:,jk) 112 113 CASE DEFAULT ! * closed 114 SELECT CASE ( cd_type1 ) 115 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 116 pt3d1( 1 ,:,jk) = 0.e0 117 pt3d1(jpi,:,jk) = 0.e0 118 CASE ( 'F' ) ! F-point 119 pt3d1(jpi,:,jk) = 0.e0 120 END SELECT 121 SELECT CASE ( cd_type2 ) 122 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 123 pt3d2( 1 ,:,jk) = 0.e0 124 pt3d2(jpi,:,jk) = 0.e0 125 CASE ( 'F' ) ! F-point 126 pt3d2(jpi,:,jk) = 0.e0 127 END SELECT 128 129 END SELECT 130 131 ! ! North-South boundaries 132 ! ! ====================== 133 SELECT CASE ( nperio ) 134 135 CASE ( 2 ) ! * south symmetric 136 137 SELECT CASE ( cd_type1 ) 138 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 139 pt3d1(:, 1 ,jk) = pt3d1(:,3,jk) 140 pt3d1(:,jpj,jk) = 0.e0 141 CASE ( 'V' , 'F' ) ! V-, F-points 142 pt3d1(:, 1 ,jk) = psgn * pt3d1(:,2,jk) 143 pt3d1(:,jpj,jk) = 0.e0 144 END SELECT 145 SELECT CASE ( cd_type2 ) 146 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 147 pt3d2(:, 1 ,jk) = pt3d2(:,3,jk) 148 pt3d2(:,jpj,jk) = 0.e0 149 CASE ( 'V' , 'F' ) ! V-, F-points 150 pt3d2(:, 1 ,jk) = psgn * pt3d2(:,2,jk) 151 pt3d2(:,jpj,jk) = 0.e0 152 END SELECT 153 154 CASE ( 3 , 4 ) ! * North fold T-point pivot 155 156 pt3d1( 1 ,jpj,jk) = 0.e0 157 pt3d1(jpi,jpj,jk) = 0.e0 158 pt3d2( 1 ,jpj,jk) = 0.e0 159 pt3d2(jpi,jpj,jk) = 0.e0 160 161 SELECT CASE ( cd_type1 ) 162 CASE ( 'T' , 'W' ) ! T-, W-point 163 DO ji = 2, jpi 164 ijt = jpi-ji+2 165 pt3d1(ji, 1 ,jk) = 0.e0 166 pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-2,jk) 167 END DO 168 DO ji = jpi/2+1, jpi 169 ijt = jpi-ji+2 170 pt3d1(ji,jpjm1,jk) = psgn * pt3d1(ijt,jpjm1,jk) 171 END DO 172 CASE ( 'U' ) ! U-point 173 DO ji = 1, jpi-1 174 iju = jpi-ji+1 175 pt3d1(ji, 1 ,jk) = 0.e0 176 pt3d1(ji,jpj,jk) = psgn * pt3d1(iju,jpj-2,jk) 177 END DO 178 DO ji = jpi/2, jpi-1 179 iju = jpi-ji+1 180 pt3d1(ji,jpjm1,jk) = psgn * pt3d1(iju,jpjm1,jk) 181 END DO 182 CASE ( 'V' ) ! V-point 183 DO ji = 2, jpi 184 ijt = jpi-ji+2 185 pt3d1(ji, 1 ,jk) = 0.e0 186 pt3d1(ji,jpj-1,jk) = psgn * pt3d1(ijt,jpj-2,jk) 187 pt3d1(ji,jpj ,jk) = psgn * pt3d1(ijt,jpj-3,jk) 188 END DO 189 CASE ( 'F' ) ! F-point 190 DO ji = 1, jpi-1 191 iju = jpi-ji+1 192 pt3d1(ji,jpj-1,jk) = psgn * pt3d1(iju,jpj-2,jk) 193 pt3d1(ji,jpj ,jk) = psgn * pt3d1(iju,jpj-3,jk) 194 END DO 195 END SELECT 196 SELECT CASE ( cd_type2 ) 197 CASE ( 'T' , 'W' ) ! T-, W-point 198 DO ji = 2, jpi 199 ijt = jpi-ji+2 200 pt3d2(ji, 1 ,jk) = 0.e0 201 pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-2,jk) 202 END DO 203 DO ji = jpi/2+1, jpi 204 ijt = jpi-ji+2 205 pt3d2(ji,jpjm1,jk) = psgn * pt3d2(ijt,jpjm1,jk) 206 END DO 207 CASE ( 'U' ) ! U-point 208 DO ji = 1, jpi-1 209 iju = jpi-ji+1 210 pt3d2(ji, 1 ,jk) = 0.e0 211 pt3d2(ji,jpj,jk) = psgn * pt3d2(iju,jpj-2,jk) 212 END DO 213 DO ji = jpi/2, jpi-1 214 iju = jpi-ji+1 215 pt3d2(ji,jpjm1,jk) = psgn * pt3d2(iju,jpjm1,jk) 216 END DO 217 CASE ( 'V' ) ! V-point 218 DO ji = 2, jpi 219 ijt = jpi-ji+2 220 pt3d2(ji, 1 ,jk) = 0.e0 221 pt3d2(ji,jpj-1,jk) = psgn * pt3d2(ijt,jpj-2,jk) 222 pt3d2(ji,jpj ,jk) = psgn * pt3d2(ijt,jpj-3,jk) 223 END DO 224 CASE ( 'F' ) ! F-point 225 DO ji = 1, jpi-1 226 iju = jpi-ji+1 227 pt3d2(ji,jpj-1,jk) = psgn * pt3d2(iju,jpj-2,jk) 228 pt3d2(ji,jpj ,jk) = psgn * pt3d2(iju,jpj-3,jk) 229 END DO 230 END SELECT 231 232 CASE ( 5 , 6 ) ! * North fold F-point pivot 233 234 pt3d1( 1 ,jpj,jk) = 0.e0 235 pt3d1(jpi,jpj,jk) = 0.e0 236 pt3d2( 1 ,jpj,jk) = 0.e0 237 pt3d2(jpi,jpj,jk) = 0.e0 238 239 SELECT CASE ( cd_type1 ) 240 CASE ( 'T' , 'W' ) ! T-, W-point 241 DO ji = 1, jpi 242 ijt = jpi-ji+1 243 pt3d1(ji, 1 ,jk) = 0.e0 244 pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-1,jk) 245 END DO 246 CASE ( 'U' ) ! U-point 247 DO ji = 1, jpi-1 248 iju = jpi-ji 249 pt3d1(ji, 1 ,jk) = 0.e0 250 pt3d1(ji,jpj,jk) = psgn * pt3d1(iju,jpj-1,jk) 251 END DO 252 CASE ( 'V' ) ! V-point 253 DO ji = 1, jpi 254 ijt = jpi-ji+1 255 pt3d1(ji, 1 ,jk) = 0.e0 256 pt3d1(ji,jpj,jk) = psgn * pt3d1(ijt,jpj-2,jk) 257 END DO 258 DO ji = jpi/2+1, jpi 259 ijt = jpi-ji+1 260 pt3d1(ji,jpjm1,jk) = psgn * pt3d1(ijt,jpjm1,jk) 261 END DO 262 CASE ( 'F' ) ! F-point 263 DO ji = 1, jpi-1 264 iju = jpi-ji 265 pt3d1(ji,jpj ,jk) = psgn * pt3d1(iju,jpj-2,jk) 266 END DO 267 DO ji = jpi/2+1, jpi-1 268 iju = jpi-ji 269 pt3d1(ji,jpjm1,jk) = psgn * pt3d1(iju,jpjm1,jk) 270 END DO 271 END SELECT 272 SELECT CASE ( cd_type2 ) 273 CASE ( 'T' , 'W' ) ! T-, W-point 274 DO ji = 1, jpi 275 ijt = jpi-ji+1 276 pt3d2(ji, 1 ,jk) = 0.e0 277 pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-1,jk) 278 END DO 279 CASE ( 'U' ) ! U-point 280 DO ji = 1, jpi-1 281 iju = jpi-ji 282 pt3d2(ji, 1 ,jk) = 0.e0 283 pt3d2(ji,jpj,jk) = psgn * pt3d2(iju,jpj-1,jk) 284 END DO 285 CASE ( 'V' ) ! V-point 286 DO ji = 1, jpi 287 ijt = jpi-ji+1 288 pt3d2(ji, 1 ,jk) = 0.e0 289 pt3d2(ji,jpj,jk) = psgn * pt3d2(ijt,jpj-2,jk) 290 END DO 291 DO ji = jpi/2+1, jpi 292 ijt = jpi-ji+1 293 pt3d2(ji,jpjm1,jk) = psgn * pt3d2(ijt,jpjm1,jk) 294 END DO 295 CASE ( 'F' ) ! F-point 296 DO ji = 1, jpi-1 297 iju = jpi-ji 298 pt3d2(ji,jpj ,jk) = psgn * pt3d2(iju,jpj-2,jk) 299 END DO 300 DO ji = jpi/2+1, jpi-1 301 iju = jpi-ji 302 pt3d2(ji,jpjm1,jk) = psgn * pt3d2(iju,jpjm1,jk) 303 END DO 304 END SELECT 305 306 CASE DEFAULT ! * closed 307 308 SELECT CASE ( cd_type1 ) 309 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 310 pt3d1(:, 1 ,jk) = 0.e0 311 pt3d1(:,jpj,jk) = 0.e0 312 CASE ( 'F' ) ! F-point 313 pt3d1(:,jpj,jk) = 0.e0 314 END SELECT 315 SELECT CASE ( cd_type2 ) 316 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 317 pt3d2(:, 1 ,jk) = 0.e0 318 pt3d2(:,jpj,jk) = 0.e0 319 CASE ( 'F' ) ! F-point 320 pt3d2(:,jpj,jk) = 0.e0 321 END SELECT 322 323 END SELECT 324 ! ! =============== 325 END DO ! End of slab 326 ! ! =============== 90 ! ! =-1 , the sign is changed if north fold boundary 91 ! ! = 1 , no sign change 92 ! ! = 0 , no sign change and > 0 required (use the inner 93 ! ! row/column if closed boundary) 94 95 CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 96 CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 327 97 328 98 END SUBROUTINE lbc_lnk_3d_gather … … 340 110 !! ! 97-06 (G. Madec) Original code 341 111 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 112 !! ! 09-03 (R. Benshila) External north fold treatment 342 113 !!---------------------------------------------------------------------- 343 114 !! * Arguments 344 115 CHARACTER(len=1), INTENT( in ) :: & 345 116 cd_type ! nature of pt3d grid-points 346 117 ! ! = T , U , V , F or W gridpoints 347 118 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: & 348 119 pt3d ! 3D array on which the boundary condition is applied 349 120 REAL(wp), INTENT( in ) :: & 350 121 psgn ! control of the sign change 351 352 353 354 122 ! ! =-1 , the sign is changed if north fold boundary 123 ! ! = 1 , no sign change 124 ! ! = 0 , no sign change and > 0 required (use the inner 125 ! ! row/column if closed boundary) 355 126 CHARACTER(len=3), INTENT( in ), OPTIONAL :: & 356 127 cd_mpp ! fill the overlap area only (here do nothing) … … 358 129 359 130 !! * Local declarations 360 INTEGER :: ji, jk361 INTEGER :: ijt, iju362 131 REAL(wp) :: zland 363 !!----------------------------------------------------------------------364 !! OPA 9.0 , LOCEAN-IPSL (2005)365 !! $Id$366 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt367 !!----------------------------------------------------------------------368 132 369 133 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) … … 378 142 ! this is in mpp case. In this module, just do nothing 379 143 ELSE 380 381 ! ! =============== 382 DO jk = 1, jpk ! Horizontal slab 383 ! ! =============== 384 385 ! ! East-West boundaries 386 ! ! ==================== 144 145 ! ! East-West boundaries 146 ! ! ====================== 387 147 SELECT CASE ( nperio ) 388 389 CASE ( 1 , 4 , 6 ) ! *cyclic east-west390 pt3d( 1 ,:, jk) = pt3d(jpim1,:,jk)! all points391 pt3d(jpi,:, jk) = pt3d( 2 ,:,jk)392 393 CASE DEFAULT ! *closed148 ! 149 CASE ( 1 , 4 , 6 ) !** cyclic east-west 150 pt3d( 1 ,:,:) = pt3d(jpim1,:,:) ! all points 151 pt3d(jpi,:,:) = pt3d( 2 ,:,:) 152 ! 153 CASE DEFAULT !** East closed -- West closed 394 154 SELECT CASE ( cd_type ) 395 155 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 396 pt3d( 1 ,:, jk) = zland397 pt3d(jpi,:, jk) = zland156 pt3d( 1 ,:,:) = zland 157 pt3d(jpi,:,:) = zland 398 158 CASE ( 'F' ) ! F-point 399 pt3d(jpi,:, jk) = zland400 END SELECT 401 159 pt3d(jpi,:,:) = zland 160 END SELECT 161 ! 402 162 END SELECT 403 163 … … 405 165 ! ! ====================== 406 166 SELECT CASE ( nperio ) 407 408 CASE ( 2 ) ! * south symmetric 409 167 ! 168 CASE ( 2 ) !** South symmetric -- North closed 410 169 SELECT CASE ( cd_type ) 411 170 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 412 pt3d(:, 1 , jk) = pt3d(:,3,jk)413 pt3d(:,jpj, jk) = zland171 pt3d(:, 1 ,:) = pt3d(:,3,:) 172 pt3d(:,jpj,:) = zland 414 173 CASE ( 'V' , 'F' ) ! V-, F-points 415 pt3d(:, 1 ,jk) = psgn * pt3d(:,2,jk) 416 pt3d(:,jpj,jk) = zland 417 END SELECT 418 419 CASE ( 3 , 4 ) ! * North fold T-point pivot 420 421 pt3d( 1 ,jpj,jk) = zland 422 pt3d(jpi,jpj,jk) = zland 423 424 SELECT CASE ( cd_type ) 425 CASE ( 'T' , 'W' ) ! T-, W-point 426 DO ji = 2, jpi 427 ijt = jpi-ji+2 428 pt3d(ji, 1 ,jk) = zland 429 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 430 END DO 431 DO ji = jpi/2+1, jpi 432 ijt = jpi-ji+2 433 pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk) 434 END DO 435 CASE ( 'U' ) ! U-point 436 DO ji = 1, jpi-1 437 iju = jpi-ji+1 438 pt3d(ji, 1 ,jk) = zland 439 pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-2,jk) 440 END DO 441 DO ji = jpi/2, jpi-1 442 iju = jpi-ji+1 443 pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk) 444 END DO 445 CASE ( 'V' ) ! V-point 446 DO ji = 2, jpi 447 ijt = jpi-ji+2 448 pt3d(ji, 1 ,jk) = zland 449 pt3d(ji,jpj-1,jk) = psgn * pt3d(ijt,jpj-2,jk) 450 pt3d(ji,jpj ,jk) = psgn * pt3d(ijt,jpj-3,jk) 451 END DO 174 pt3d(:, 1 ,:) = psgn * pt3d(:,2,:) 175 pt3d(:,jpj,:) = zland 176 END SELECT 177 ! 178 CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed 179 SELECT CASE ( cd_type ) ! South : closed 180 CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point 181 pt3d(:, 1 ,:) = zland 182 END SELECT 183 ! ! North fold 184 pt3d( 1 ,jpj,:) = zland 185 pt3d(jpi,jpj,:) = zland 186 CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn ) 187 ! 188 CASE DEFAULT !** North closed -- South closed 189 SELECT CASE ( cd_type ) 190 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 191 pt3d(:, 1 ,:) = zland 192 pt3d(:,jpj,:) = zland 452 193 CASE ( 'F' ) ! F-point 453 DO ji = 1, jpi-1 454 iju = jpi-ji+1 455 pt3d(ji,jpj-1,jk) = psgn * pt3d(iju,jpj-2,jk) 456 pt3d(ji,jpj ,jk) = psgn * pt3d(iju,jpj-3,jk) 457 END DO 458 END SELECT 459 460 CASE ( 5 , 6 ) ! * North fold F-point pivot 461 462 pt3d( 1 ,jpj,jk) = zland 463 pt3d(jpi,jpj,jk) = zland 464 465 SELECT CASE ( cd_type ) 466 CASE ( 'T' , 'W' ) ! T-, W-point 467 DO ji = 1, jpi 468 ijt = jpi-ji+1 469 pt3d(ji, 1 ,jk) = zland 470 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-1,jk) 471 END DO 472 CASE ( 'U' ) ! U-point 473 DO ji = 1, jpi-1 474 iju = jpi-ji 475 pt3d(ji, 1 ,jk) = zland 476 pt3d(ji,jpj,jk) = psgn * pt3d(iju,jpj-1,jk) 477 END DO 478 CASE ( 'V' ) ! V-point 479 DO ji = 1, jpi 480 ijt = jpi-ji+1 481 pt3d(ji, 1 ,jk) = zland 482 pt3d(ji,jpj,jk) = psgn * pt3d(ijt,jpj-2,jk) 483 END DO 484 DO ji = jpi/2+1, jpi 485 ijt = jpi-ji+1 486 pt3d(ji,jpjm1,jk) = psgn * pt3d(ijt,jpjm1,jk) 487 END DO 488 CASE ( 'F' ) ! F-point 489 DO ji = 1, jpi-1 490 iju = jpi-ji 491 pt3d(ji,jpj ,jk) = psgn * pt3d(iju,jpj-2,jk) 492 END DO 493 DO ji = jpi/2+1, jpi-1 494 iju = jpi-ji 495 pt3d(ji,jpjm1,jk) = psgn * pt3d(iju,jpjm1,jk) 496 END DO 497 END SELECT 498 499 CASE DEFAULT ! * closed 500 501 SELECT CASE ( cd_type ) 502 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 503 pt3d(:, 1 ,jk) = zland 504 pt3d(:,jpj,jk) = zland 505 CASE ( 'F' ) ! F-point 506 pt3d(:,jpj,jk) = zland 507 END SELECT 508 194 pt3d(:,jpj,:) = zland 195 END SELECT 196 ! 509 197 END SELECT 510 ! ! =============== 511 END DO ! End of slab 512 ! ! =============== 513 ENDIF 198 199 ENDIF 200 514 201 END SUBROUTINE lbc_lnk_3d 515 202 … … 527 214 !! ! 01-05 (E. Durand) correction 528 215 !! 8.5 ! 02-09 (G. Madec) F90: Free form and module 216 !! ! 09-03 (R. Benshila) External north fold treatment 529 217 !!---------------------------------------------------------------------- 530 218 !! * Arguments … … 544 232 545 233 !! * Local declarations 546 INTEGER :: ji547 INTEGER :: ijt, iju548 234 REAL(wp) :: zland 549 !!----------------------------------------------------------------------550 235 551 236 IF( PRESENT( pval ) ) THEN ! set land value (zero by default) … … 560 245 ELSE 561 246 562 ! ! East-West boundaries 563 ! ! ==================== 564 SELECT CASE ( nperio ) 565 566 CASE ( 1 , 4 , 6 ) ! * cyclic east-west 567 pt2d( 1 ,:) = pt2d(jpim1,:) 568 pt2d(jpi,:) = pt2d( 2 ,:) 569 570 CASE DEFAULT ! * closed 571 SELECT CASE ( cd_type ) 572 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 573 pt2d( 1 ,:) = zland 574 pt2d(jpi,:) = zland 575 CASE ( 'F' ) ! F-point, ice U-V point 576 pt2d(jpi,:) = zland 577 CASE ( 'I' ) ! F-point, ice U-V point 578 pt2d( 1 ,:) = zland 579 pt2d(jpi,:) = zland 247 ! ! East-West boundaries 248 ! ! ==================== 249 SELECT CASE ( nperio ) 250 ! 251 CASE ( 1 , 4 , 6 ) !** cyclic east-west 252 pt2d( 1 ,:) = pt2d(jpim1,:) ! all points 253 pt2d(jpi,:) = pt2d( 2 ,:) 254 ! 255 CASE DEFAULT !** East closed -- West closed 256 SELECT CASE ( cd_type ) 257 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 258 pt2d( 1 ,:) = zland 259 pt2d(jpi,:) = zland 260 CASE ( 'F' ) ! F-point 261 pt2d(jpi,:) = zland 262 END SELECT 263 ! 580 264 END SELECT 581 582 END SELECT 583 584 ! ! North-South boundaries 585 ! ! ====================== 586 SELECT CASE ( nperio ) 587 588 CASE ( 2 ) ! * South symmetric 589 590 SELECT CASE ( cd_type ) 591 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 592 pt2d(:, 1 ) = pt2d(:,3) 593 pt2d(:,jpj) = zland 594 CASE ( 'V' , 'F' , 'I' ) ! V-, F-points, ice U-V point 595 pt2d(:, 1 ) = psgn * pt2d(:,2) 596 pt2d(:,jpj) = zland 265 266 ! ! North-South boundaries 267 ! ! ====================== 268 SELECT CASE ( nperio ) 269 ! 270 CASE ( 2 ) !** South symmetric -- North closed 271 SELECT CASE ( cd_type ) 272 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 273 pt2d(:, 1 ) = pt2d(:,3) 274 pt2d(:,jpj) = zland 275 CASE ( 'V' , 'F' ) ! V-, F-points 276 pt2d(:, 1 ) = psgn * pt2d(:,2) 277 pt2d(:,jpj) = zland 278 END SELECT 279 ! 280 CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed 281 SELECT CASE ( cd_type ) ! South : closed 282 CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point 283 pt2d(:, 1 ) = zland 284 END SELECT 285 ! ! North fold 286 pt2d( 1 ,1 ) = zland 287 pt2d( 1 ,jpj) = zland 288 pt2d(jpi,jpj) = zland 289 CALL lbc_nfd( pt2d(:,:), cd_type, psgn ) 290 ! 291 CASE DEFAULT !** North closed -- South closed 292 SELECT CASE ( cd_type ) 293 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 294 pt2d(:, 1 ) = zland 295 pt2d(:,jpj) = zland 296 CASE ( 'F' ) ! F-point 297 pt2d(:,jpj) = zland 298 END SELECT 299 ! 597 300 END SELECT 598 599 CASE ( 3 , 4 ) ! * North fold T-point pivot600 601 pt2d( 1 , 1 ) = zland !!!!! bug gm ??? !Edmee602 pt2d( 1 ,jpj) = zland603 pt2d(jpi,jpj) = zland604 605 SELECT CASE ( cd_type )606 607 CASE ( 'T' , 'W' ) ! T-, W-point608 DO ji = 2, jpi609 ijt = jpi-ji+2610 pt2d(ji, 1 ) = zland611 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)612 END DO613 DO ji = jpi/2+1, jpi614 ijt = jpi-ji+2615 pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)616 END DO617 618 CASE ( 'U' ) ! U-point619 DO ji = 1, jpi-1620 iju = jpi-ji+1621 pt2d(ji, 1 ) = zland622 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-2)623 END DO624 DO ji = jpi/2, jpi-1625 iju = jpi-ji+1626 pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)627 END DO628 629 CASE ( 'V' ) ! V-point630 DO ji = 2, jpi631 ijt = jpi-ji+2632 pt2d(ji, 1 ) = zland633 pt2d(ji,jpj-1) = psgn * pt2d(ijt,jpj-2)634 pt2d(ji,jpj ) = psgn * pt2d(ijt,jpj-3)635 END DO636 637 CASE ( 'F' ) ! F-point638 DO ji = 1, jpi-1639 iju = jpi - ji + 1640 pt2d(ji,jpj-1) = psgn * pt2d(iju,jpj-2)641 pt2d(ji,jpj ) = psgn * pt2d(iju,jpj-3)642 END DO643 644 CASE ( 'I' ) ! ice U-V point645 pt2d(:, 1 ) = zland646 pt2d(2,jpj) = psgn * pt2d(3,jpj-1)647 DO ji = 3, jpi648 iju = jpi - ji + 3649 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)650 END DO651 652 END SELECT653 654 CASE ( 5 , 6 ) ! * North fold F-point pivot655 656 pt2d( 1 , 1 ) = zland !!bug ???657 pt2d( 1 ,jpj) = zland658 pt2d(jpi,jpj) = zland659 660 SELECT CASE ( cd_type )661 662 CASE ( 'T' , 'W' ) ! T-, W-point663 DO ji = 1, jpi664 ijt = jpi-ji+1665 pt2d(ji, 1 ) = zland666 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-1)667 END DO668 669 CASE ( 'U' ) ! U-point670 DO ji = 1, jpi-1671 iju = jpi-ji672 pt2d(ji, 1 ) = zland673 pt2d(ji,jpj) = psgn * pt2d(iju,jpj-1)674 END DO675 676 CASE ( 'V' ) ! V-point677 DO ji = 1, jpi678 ijt = jpi-ji+1679 pt2d(ji, 1 ) = zland680 pt2d(ji,jpj) = psgn * pt2d(ijt,jpj-2)681 END DO682 DO ji = jpi/2+1, jpi683 ijt = jpi-ji+1684 pt2d(ji,jpjm1) = psgn * pt2d(ijt,jpjm1)685 END DO686 687 CASE ( 'F' ) ! F-point688 DO ji = 1, jpi-1689 iju = jpi-ji690 pt2d(ji,jpj ) = psgn * pt2d(iju,jpj-2)691 END DO692 DO ji = jpi/2+1, jpi-1693 iju = jpi-ji694 pt2d(ji,jpjm1) = psgn * pt2d(iju,jpjm1)695 END DO696 697 CASE ( 'I' ) ! ice U-V point698 pt2d( : , 1 ) = zland699 pt2d( 2 ,jpj) = zland700 DO ji = 2 , jpim1701 ijt = jpi - ji + 2702 pt2d(ji,jpj)= 0.5 * ( pt2d(ji,jpjm1) + psgn * pt2d(ijt,jpjm1) )703 END DO704 705 END SELECT706 707 CASE DEFAULT ! * closed708 709 SELECT CASE ( cd_type )710 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points711 pt2d(:, 1 ) = zland712 pt2d(:,jpj) = zland713 CASE ( 'F' ) ! F-point714 pt2d(:,jpj) = zland715 CASE ( 'I' ) ! ice U-V point716 pt2d(:, 1 ) = zland717 pt2d(:,jpj) = zland718 END SELECT719 720 END SELECT721 301 722 302 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
