- Timestamp:
- 2017-04-13T09:10:07+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r7646 r7904 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 15 !! mpp_lbc_nfd_2d 15 !! mpp_lbc_nfd_3d: North fold treatment for a 3D arrays optimized for MPP 16 !! mpp_lbc_nfd_2d: North fold treatment for a 2D arrays optimized for MPP 16 17 !!---------------------------------------------------------------------- 17 18 USE dom_oce ! ocean space and time domain … … 54 55 !! ** Action : pt3d with updated values along the north fold 55 56 !!---------------------------------------------------------------------- 56 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points57 ! ! = T , U , V , F , W points58 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change59 ! ! = -1. , the sign is changed if north fold boundary60 ! ! = 1. , the sign is kept if north fold boundary61 57 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3d ! 3D array on which the boundary condition is applied 58 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-point 59 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 62 60 ! 63 61 INTEGER :: ji, jk 64 62 INTEGER :: ijt, iju, ijpj, ijpjm1 65 63 !!---------------------------------------------------------------------- 66 64 ! 67 65 SELECT CASE ( jpni ) 68 66 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction … … 71 69 ijpjm1 = ijpj-1 72 70 73 DO jk = 1, jpk71 DO jk = 1, SIZE( pt3d, 3 ) 74 72 ! 75 73 SELECT CASE ( npolj ) … … 155 153 SELECT CASE ( cd_type) 156 154 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 157 pt3d(:, 1 ,jk) = 0. e0158 pt3d(:,ijpj,jk) = 0. e0155 pt3d(:, 1 ,jk) = 0._wp 156 pt3d(:,ijpj,jk) = 0._wp 159 157 CASE ( 'F' ) ! F-point 160 pt3d(:,ijpj,jk) = 0. e0158 pt3d(:,ijpj,jk) = 0._wp 161 159 END SELECT 162 160 ! … … 179 177 !! ** Action : pt2d with updated values along the north fold 180 178 !!---------------------------------------------------------------------- 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 179 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied 180 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt2d grid-point 181 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 187 182 INTEGER , OPTIONAL , INTENT(in ) :: pr2dj ! number of additional halos 188 183 ! … … 265 260 END DO 266 261 END DO 267 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 262 END SELECT 284 263 ! … … 325 304 END DO 326 305 CASE ( 'I' ) ! ice U-V point (I-point) 327 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0. e0306 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0._wp 328 307 DO jl = 0, ipr2dj 329 308 DO ji = 2 , jpiglo-1 … … 332 311 END DO 333 312 END DO 334 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 313 END SELECT 351 314 ! … … 354 317 SELECT CASE ( cd_type) 355 318 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 356 pt2d(:, 1:1-ipr2dj ) = 0. e0357 pt2d(:,ijpj:ijpj+ipr2dj) = 0. e0319 pt2d(:, 1:1-ipr2dj ) = 0._wp 320 pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 358 321 CASE ( 'F' ) ! F-point 359 pt2d(:,ijpj:ijpj+ipr2dj) = 0. e0322 pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 360 323 CASE ( 'I' ) ! ice U-V point 361 pt2d(:, 1:1-ipr2dj ) = 0.e0 362 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 363 CASE ( 'J' ) ! first ice U-V point 364 pt2d(:, 1:1-ipr2dj ) = 0.e0 365 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 366 CASE ( 'K' ) ! second ice U-V point 367 pt2d(:, 1:1-ipr2dj ) = 0.e0 368 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 324 pt2d(:, 1:1-ipr2dj ) = 0._wp 325 pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 369 326 END SELECT 370 327 ! … … 385 342 !! ** Action : pt3d with updated values along the north fold 386 343 !!---------------------------------------------------------------------- 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 344 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3dl ! 3D array on which the boundary condition is applied 393 345 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pt3dr ! 3D array on which the boundary condition is applied 394 ! 395 INTEGER :: ji, jk 346 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d(l/r) grid-point 347 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 348 ! 349 INTEGER :: ji, jk ! dummy loop indices 350 INTEGER :: ipk ! 3rd dimension of the input array 396 351 INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 397 352 !!---------------------------------------------------------------------- 353 ! 354 ipk = SIZE( pt3dl, 3 ) 398 355 ! 399 356 SELECT CASE ( jpni ) … … 402 359 END SELECT 403 360 ijpjm1 = ijpj-1 404 405 406 407 408 409 410 361 ! 362 ! 363 SELECT CASE ( npolj ) 364 ! 365 CASE ( 3 , 4 ) ! * North fold T-point pivot 366 ! 367 SELECT CASE ( cd_type ) 411 368 CASE ( 'T' , 'W' ) ! T-, W-point 412 IF (nimpp .ne. 1) THEN 413 startloop = 1 414 ELSE 415 startloop = 2 416 ENDIF 417 418 DO jk = 1, jpk 369 IF ( nimpp /= 1 ) THEN ; startloop = 1 370 ELSE ; startloop = 2 371 ENDIF 372 ! 373 DO jk = 1, ipk 419 374 DO ji = startloop, nlci 420 375 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 … … 426 381 END DO 427 382 428 IF( nimpp .ge. (jpiglo/2+1)) THEN383 IF( nimpp >= jpiglo/2+1 ) THEN 429 384 startloop = 1 430 ELSEIF( ((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN385 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 431 386 startloop = jpiglo/2+1 - nimpp + 1 432 387 ELSE 433 388 startloop = nlci + 1 434 389 ENDIF 435 IF(startloop .le.nlci) THEN436 DO jk = 1, jpk390 IF(startloop <= nlci) THEN 391 DO jk = 1, ipk 437 392 DO ji = startloop, nlci 438 393 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 439 394 jia = ji + nimpp - 1 440 395 ijta = jpiglo - jia + 2 441 IF( (ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN396 IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 442 397 pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk) 443 398 ELSE … … 447 402 END DO 448 403 ENDIF 449 450 404 ! 451 405 CASE ( 'U' ) ! U-point 452 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN406 IF( nimpp + nlci - 1 /= jpiglo ) THEN 453 407 endloop = nlci 454 408 ELSE 455 409 endloop = nlci - 1 456 410 ENDIF 457 DO jk = 1, jpk411 DO jk = 1, ipk 458 412 DO ji = 1, endloop 459 413 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 467 421 ENDIF 468 422 END DO 469 470 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN423 ! 424 IF( nimpp + nlci - 1 /= jpiglo ) THEN 471 425 endloop = nlci 472 426 ELSE 473 427 endloop = nlci - 1 474 428 ENDIF 475 IF( nimpp .ge. (jpiglo/2)) THEN429 IF( nimpp >= jpiglo/2 ) THEN 476 430 startloop = 1 477 ELSEIF( ((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN431 ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 478 432 startloop = jpiglo/2 - nimpp + 1 479 433 ELSE 480 434 startloop = endloop + 1 481 435 ENDIF 482 IF (startloop .le. endloop) THEN483 DO jk = 1, jpk436 IF( startloop <= endloop ) THEN 437 DO jk = 1, ipk 484 438 DO ji = startloop, endloop 485 439 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 486 440 jia = ji + nimpp - 1 487 441 ijua = jpiglo - jia + 1 488 IF( (ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN442 IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 489 443 pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk) 490 444 ELSE … … 494 448 END DO 495 449 ENDIF 496 450 ! 497 451 CASE ( 'V' ) ! V-point 498 IF (nimpp .ne. 1) THEN452 IF( nimpp /= 1 ) THEN 499 453 startloop = 1 500 454 ELSE 501 455 startloop = 2 502 456 ENDIF 503 DO jk = 1, jpk457 DO jk = 1, ipk 504 458 DO ji = startloop, nlci 505 459 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 … … 512 466 END DO 513 467 CASE ( 'F' ) ! F-point 514 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN468 IF( nimpp + nlci - 1 /= jpiglo ) THEN 515 469 endloop = nlci 516 470 ELSE 517 471 endloop = nlci - 1 518 472 ENDIF 519 DO jk = 1, jpk473 DO jk = 1, ipk 520 474 DO ji = 1, endloop 521 475 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 530 484 ENDIF 531 485 END DO 532 END SELECT 533 ! 534 535 CASE ( 5 , 6 ) ! * North fold F-point pivot 536 ! 537 SELECT CASE ( cd_type ) 486 END SELECT 487 ! 488 CASE ( 5 , 6 ) ! * North fold F-point pivot 489 ! 490 SELECT CASE ( cd_type ) 538 491 CASE ( 'T' , 'W' ) ! T-, W-point 539 DO jk = 1, jpk492 DO jk = 1, ipk 540 493 DO ji = 1, nlci 541 494 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 543 496 END DO 544 497 END DO 545 498 ! 546 499 CASE ( 'U' ) ! U-point 547 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN500 IF( nimpp + nlci - 1 /= jpiglo ) THEN 548 501 endloop = nlci 549 502 ELSE 550 503 endloop = nlci - 1 551 504 ENDIF 552 DO jk = 1, jpk505 DO jk = 1, ipk 553 506 DO ji = 1, endloop 554 507 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 … … 559 512 ENDIF 560 513 END DO 561 514 ! 562 515 CASE ( 'V' ) ! V-point 563 DO jk = 1, jpk516 DO jk = 1, ipk 564 517 DO ji = 1, nlci 565 518 ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 567 520 END DO 568 521 END DO 569 570 IF( nimpp .ge. (jpiglo/2+1)) THEN522 ! 523 IF( nimpp >= jpiglo/2+1 ) THEN 571 524 startloop = 1 572 ELSEIF( ((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN525 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 573 526 startloop = jpiglo/2+1 - nimpp + 1 574 527 ELSE 575 528 startloop = nlci + 1 576 529 ENDIF 577 IF( startloop .le. nlci) THEN578 DO jk = 1, jpk530 IF( startloop <= nlci ) THEN 531 DO jk = 1, ipk 579 532 DO ji = startloop, nlci 580 533 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 … … 583 536 END DO 584 537 ENDIF 585 538 ! 586 539 CASE ( 'F' ) ! F-point 587 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN540 IF( nimpp + nlci - 1 /= jpiglo ) THEN 588 541 endloop = nlci 589 542 ELSE 590 543 endloop = nlci - 1 591 544 ENDIF 592 DO jk = 1, jpk545 DO jk = 1, ipk 593 546 DO ji = 1, endloop 594 547 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 … … 599 552 ENDIF 600 553 END DO 601 602 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN554 ! 555 IF( nimpp + nlci - 1 /= jpiglo ) THEN 603 556 endloop = nlci 604 557 ELSE 605 558 endloop = nlci - 1 606 559 ENDIF 607 IF( nimpp .ge. (jpiglo/2+1)) THEN560 IF( nimpp >= jpiglo/2+1 ) THEN 608 561 startloop = 1 609 ELSEIF( ((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN562 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 610 563 startloop = jpiglo/2+1 - nimpp + 1 611 564 ELSE 612 565 startloop = endloop + 1 613 566 ENDIF 614 IF (startloop .le. endloop) THEN615 DO jk = 1, jpk567 IF( startloop <= endloop ) THEN 568 DO jk = 1, ipk 616 569 DO ji = startloop, endloop 617 570 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 … … 620 573 END DO 621 574 ENDIF 622 623 624 625 626 627 575 ! 576 END SELECT 577 ! 578 CASE DEFAULT ! * closed : the code probably never go through 579 ! 580 SELECT CASE ( cd_type) 628 581 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 629 pt3dl(:, 1 ,jk) = 0. e0630 pt3dl(:,ijpj,jk) = 0. e0582 pt3dl(:, 1 ,jk) = 0._wp 583 pt3dl(:,ijpj,jk) = 0._wp 631 584 CASE ( 'F' ) ! F-point 632 pt3dl(:,ijpj,jk) = 0.e0 633 END SELECT 634 ! 635 END SELECT ! npolj 636 ! 585 pt3dl(:,ijpj,jk) = 0._wp 586 END SELECT 587 ! 588 END SELECT ! npolj 637 589 ! 638 590 END SUBROUTINE mpp_lbc_nfd_3d … … 644 596 !! 645 597 !! ** Purpose : 2D lateral boundary condition : North fold treatment 646 !! without processor exchanges.598 !! without processor exchanges. 647 599 !! 648 600 !! ** Method : 649 601 !! 650 !! ** Action : pt2d with updated values along the north fold 651 !!---------------------------------------------------------------------- 652 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 653 ! ! = T , U , V , F , W points 654 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change 655 ! ! = -1. , the sign is changed if north fold boundary 656 ! ! = 1. , the sign is kept if north fold boundary 602 !! ** Action : pt2dl with updated values along the north fold 603 !!---------------------------------------------------------------------- 657 604 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2dl ! 2D array on which the boundary condition is applied 658 605 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pt2dr ! 2D array on which the boundary condition is applied 606 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d(l/r) grid-point 607 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 659 608 ! 660 609 INTEGER :: ji … … 668 617 ! 669 618 ijpjm1 = ijpj-1 670 671 619 ! 620 ! 672 621 SELECT CASE ( npolj ) 673 622 ! … … 677 626 ! 678 627 CASE ( 'T' , 'W' ) ! T- , W-points 679 IF (nimpp .ne. 1) THEN628 IF( nimpp /= 1 ) THEN 680 629 startloop = 1 681 630 ELSE … … 686 635 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 687 636 END DO 688 IF (nimpp .eq. 1) THEN689 pt2dl(1,ijpj) 690 ENDIF 691 692 IF( nimpp .ge. (jpiglo/2+1)) THEN637 IF( nimpp == 1 ) THEN 638 pt2dl(1,ijpj) = psgn * pt2dl(3,ijpj-2) 639 ENDIF 640 ! 641 IF( nimpp >= jpiglo/2+1 ) THEN 693 642 startloop = 1 694 ELSEIF( ((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN643 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 695 644 startloop = jpiglo/2+1 - nimpp + 1 696 645 ELSE … … 698 647 ENDIF 699 648 DO ji = startloop, nlci 700 ijt =jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4649 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 701 650 jia = ji + nimpp - 1 702 651 ijta = jpiglo - jia + 2 703 IF( (ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN652 IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 704 653 pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1) 705 654 ELSE … … 707 656 ENDIF 708 657 END DO 709 658 ! 710 659 CASE ( 'U' ) ! U-point 711 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN660 IF( nimpp + nlci - 1 /= jpiglo ) THEN 712 661 endloop = nlci 713 662 ELSE … … 718 667 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 719 668 END DO 720 669 ! 721 670 IF (nimpp .eq. 1) THEN 722 671 pt2dl( 1 ,ijpj ) = psgn * pt2dl( 2 ,ijpj-2) … … 726 675 pt2dl(nlci,ijpj ) = psgn * pt2dl(nlci-1,ijpj-2) 727 676 ENDIF 728 729 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN677 ! 678 IF( nimpp + nlci - 1 /= jpiglo ) THEN 730 679 endloop = nlci 731 680 ELSE 732 681 endloop = nlci - 1 733 682 ENDIF 734 IF( nimpp .ge. (jpiglo/2)) THEN683 IF( nimpp >= jpiglo/2 ) THEN 735 684 startloop = 1 736 ELSEIF( ((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN685 ELSEIF( nimpp+nlci-1 >= jpiglo/2 .AND. nimpp < jpiglo/2 ) THEN 737 686 startloop = jpiglo/2 - nimpp + 1 738 687 ELSE … … 743 692 jia = ji + nimpp - 1 744 693 ijua = jpiglo - jia + 1 745 IF( (ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN694 IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 746 695 pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1) 747 696 ELSE … … 749 698 ENDIF 750 699 END DO 751 700 ! 752 701 CASE ( 'V' ) ! V-point 753 IF (nimpp .ne. 1) THEN702 IF( nimpp /= 1 ) THEN 754 703 startloop = 1 755 704 ELSE … … 764 713 pt2dl( 1 ,ijpj) = psgn * pt2dl( 3 ,ijpj-3) 765 714 ENDIF 766 715 ! 767 716 CASE ( 'F' ) ! F-point 768 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN717 IF( nimpp + nlci - 1 /= jpiglo ) THEN 769 718 endloop = nlci 770 719 ELSE … … 784 733 pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 785 734 ENDIF 786 735 ! 787 736 CASE ( 'I' ) ! ice U-V point (I-point) 788 IF (nimpp .ne. 1) THEN737 IF( nimpp /= 1 ) THEN 789 738 startloop = 1 790 739 ELSE … … 796 745 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 797 746 END DO 798 799 CASE ( 'J' ) ! first ice U-V point 800 IF (nimpp .ne. 1) THEN 801 startloop = 1 802 ELSE 803 startloop = 3 804 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 805 ENDIF 806 DO ji = startloop, nlci 807 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 808 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 809 END DO 810 811 CASE ( 'K' ) ! second ice U-V point 812 IF (nimpp .ne. 1) THEN 813 startloop = 1 814 ELSE 815 startloop = 3 816 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 817 ENDIF 818 DO ji = startloop, nlci 819 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 820 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 821 END DO 822 747 ! 823 748 END SELECT 824 749 ! … … 831 756 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 832 757 END DO 833 758 ! 834 759 CASE ( 'U' ) ! U-point 835 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN760 IF( nimpp + nlci - 1 /= jpiglo ) THEN 836 761 endloop = nlci 837 762 ELSE … … 845 770 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1) 846 771 ENDIF 847 772 ! 848 773 CASE ( 'V' ) ! V-point 849 774 DO ji = 1, nlci … … 851 776 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 852 777 END DO 853 IF( nimpp .ge. (jpiglo/2+1)) THEN778 IF( nimpp >= jpiglo/2+1 ) THEN 854 779 startloop = 1 855 ELSEIF( ((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN780 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 856 781 startloop = jpiglo/2+1 - nimpp + 1 857 782 ELSE … … 862 787 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 863 788 END DO 864 789 ! 865 790 CASE ( 'F' ) ! F-point 866 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN791 IF( nimpp + nlci - 1 /= jpiglo ) THEN 867 792 endloop = nlci 868 793 ELSE … … 876 801 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2) 877 802 ENDIF 878 879 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN803 ! 804 IF( nimpp + nlci - 1 /= jpiglo ) THEN 880 805 endloop = nlci 881 806 ELSE 882 807 endloop = nlci - 1 883 808 ENDIF 884 IF( nimpp .ge. (jpiglo/2+1)) THEN809 IF( nimpp >= jpiglo/2+1 ) THEN 885 810 startloop = 1 886 ELSEIF( ((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN811 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 887 812 startloop = jpiglo/2+1 - nimpp + 1 888 813 ELSE 889 814 startloop = endloop + 1 890 815 ENDIF 891 816 ! 892 817 DO ji = startloop, endloop 893 818 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 894 819 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 895 820 END DO 896 821 ! 897 822 CASE ( 'I' ) ! ice U-V point (I-point) 898 IF (nimpp .ne. 1) THEN823 IF( nimpp /= 1 ) THEN 899 824 startloop = 1 900 825 ELSE 901 826 startloop = 2 902 827 ENDIF 903 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN828 IF( nimpp + nlci - 1 /= jpiglo ) THEN 904 829 endloop = nlci 905 830 ELSE … … 908 833 DO ji = startloop , endloop 909 834 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 910 pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 911 END DO 912 913 CASE ( 'J' ) ! first ice U-V point 914 IF (nimpp .ne. 1) THEN 915 startloop = 1 916 ELSE 917 startloop = 2 918 ENDIF 919 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 920 endloop = nlci 921 ELSE 922 endloop = nlci - 1 923 ENDIF 924 DO ji = startloop , endloop 925 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 926 pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1) 927 END DO 928 929 CASE ( 'K' ) ! second ice U-V point 930 IF (nimpp .ne. 1) THEN 931 startloop = 1 932 ELSE 933 startloop = 2 934 ENDIF 935 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 936 endloop = nlci 937 ELSE 938 endloop = nlci - 1 939 ENDIF 940 DO ji = startloop, endloop 941 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 942 pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 943 END DO 944 835 pt2dl(ji,ijpj) = 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 836 END DO 837 ! 945 838 END SELECT 946 839 ! … … 949 842 SELECT CASE ( cd_type) 950 843 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 951 pt2dl(:, 1 ) = 0.e0952 pt2dl(:,ijpj) = 0. e0844 pt2dl(:, 1 ) = 0._wp 845 pt2dl(:,ijpj) = 0._wp 953 846 CASE ( 'F' ) ! F-point 954 pt2dl(:,ijpj) = 0. e0847 pt2dl(:,ijpj) = 0._wp 955 848 CASE ( 'I' ) ! ice U-V point 956 pt2dl(:, 1 ) = 0.e0 957 pt2dl(:,ijpj) = 0.e0 958 CASE ( 'J' ) ! first ice U-V point 959 pt2dl(:, 1 ) = 0.e0 960 pt2dl(:,ijpj) = 0.e0 961 CASE ( 'K' ) ! second ice U-V point 962 pt2dl(:, 1 ) = 0.e0 963 pt2dl(:,ijpj) = 0.e0 849 pt2dl(:, 1 ) = 0._wp 850 pt2dl(:,ijpj) = 0._wp 964 851 END SELECT 965 852 !
Note: See TracChangeset
for help on using the changeset viewer.
