Changeset 15376 for NEMO/trunk/src/OCE/lib_fortran.F90
 Timestamp:
 20211014T22:41:23+02:00 (12 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

NEMO/trunk/src/OCE/lib_fortran.F90
r15145 r15376 34 34 PUBLIC glob_sum_vec 35 35 PUBLIC glob_sum_full_vec 36 PUBLIC glob_min_vec, glob_max_vec 36 37 #if defined key_nosignedzero 37 38 PUBLIC SIGN … … 61 62 INTERFACE glob_sum_full_vec 62 63 MODULE PROCEDURE glob_sum_full_vec_3d, glob_sum_full_vec_4d 64 END INTERFACE 65 INTERFACE glob_min_vec 66 MODULE PROCEDURE glob_min_vec_3d, glob_min_vec_4d 67 END INTERFACE 68 INTERFACE glob_max_vec 69 MODULE PROCEDURE glob_max_vec_3d, glob_max_vec_4d 63 70 END INTERFACE 64 71 … … 503 510 END FUNCTION glob_sum_full_vec_4d 504 511 512 FUNCTION glob_min_vec_3d( cdname, ptab ) RESULT( ptmp ) 513 !! 514 CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine 515 REAL(wp), INTENT(in) :: ptab(:,:,:) ! array on which operation is applied 516 REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp 517 ! 518 INTEGER :: jk ! dummy loop indice & dimension 519 INTEGER :: ipk ! dimension 520 !! 521 ! 522 ipk = SIZE(ptab,3) 523 DO jk = 1, ipk 524 ptmp(jk) = MINVAL( ptab(:,:,jk) * tmask_i(:,:) ) 525 ENDDO 526 ! 527 CALL mpp_min( cdname, ptmp (:) ) 528 ! 529 END FUNCTION glob_min_vec_3d 530 531 FUNCTION glob_min_vec_4d( cdname, ptab ) RESULT( ptmp ) 532 !! 533 CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine 534 REAL(wp), INTENT(in) :: ptab(:,:,:,:) ! array on which operation is applied 535 REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp 536 ! 537 INTEGER :: jk , jl ! dummy loop indice & dimension 538 INTEGER :: ipk, ipl ! dimension 539 !! 540 ! 541 ipk = SIZE(ptab,3) 542 ipl = SIZE(ptab,4) 543 DO jl = 1, ipl 544 ptmp(jl) = MINVAL( ptab(:,:,1,jl) * tmask_i(:,:) ) 545 DO jk = 2, ipk 546 ptmp(jl) = MIN( ptmp(jl), MINVAL( ptab(:,:,jk,jl) * tmask_i(:,:) ) ) 547 ENDDO 548 ENDDO 549 ! 550 CALL mpp_min( cdname, ptmp (:) ) 551 ! 552 END FUNCTION glob_min_vec_4d 553 554 FUNCTION glob_max_vec_3d( cdname, ptab ) RESULT( ptmp ) 555 !! 556 CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine 557 REAL(wp), INTENT(in) :: ptab(:,:,:) ! array on which operation is applied 558 REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp 559 ! 560 INTEGER :: jk ! dummy loop indice & dimension 561 INTEGER :: ipk ! dimension 562 !! 563 ! 564 ipk = SIZE(ptab,3) 565 DO jk = 1, ipk 566 ptmp(jk) = MAXVAL( ptab(:,:,jk) * tmask_i(:,:) ) 567 ENDDO 568 ! 569 CALL mpp_max( cdname, ptmp (:) ) 570 ! 571 END FUNCTION glob_max_vec_3d 572 573 FUNCTION glob_max_vec_4d( cdname, ptab ) RESULT( ptmp ) 574 !! 575 CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine 576 REAL(wp), INTENT(in) :: ptab(:,:,:,:) ! array on which operation is applied 577 REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp 578 ! 579 INTEGER :: jk , jl ! dummy loop indice & dimension 580 INTEGER :: ipk, ipl ! dimension 581 !! 582 ! 583 ipk = SIZE(ptab,3) 584 ipl = SIZE(ptab,4) 585 DO jl = 1, ipl 586 ptmp(jl) = MAXVAL( ptab(:,:,1,jl) * tmask_i(:,:) ) 587 DO jk = 2, ipk 588 ptmp(jl) = MAX( ptmp(jl), MAXVAL( ptab(:,:,jk,jl) * tmask_i(:,:) ) ) 589 ENDDO 590 ENDDO 591 ! 592 CALL mpp_max( cdname, ptmp (:) ) 593 ! 594 END FUNCTION glob_max_vec_4d 595 505 596 SUBROUTINE DDPDD( ydda, yddb ) 506 597 !!
Note: See TracChangeset
for help on using the changeset viewer.