New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15376 – NEMO

Changeset 15376


Ignore:
Timestamp:
2021-10-14T22:41:23+02:00 (3 years ago)
Author:
clem
Message:

add functions glob_min_vec and glob_max_vec. They would need to be merged into the generic module lib_fortran_generic.h90 at some point, along with glob_sum_vec

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk/src/OCE/lib_fortran.F90

    r15145 r15376  
    3434   PUBLIC   glob_sum_vec 
    3535   PUBLIC   glob_sum_full_vec 
     36   PUBLIC   glob_min_vec, glob_max_vec 
    3637#if defined key_nosignedzero 
    3738   PUBLIC SIGN 
    … …  
    6162   INTERFACE glob_sum_full_vec 
    6263      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 
    6370   END INTERFACE 
    6471 
    … …  
    503510   END FUNCTION glob_sum_full_vec_4d 
    504511 
     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    
    505596   SUBROUTINE DDPDD( ydda, yddb ) 
    506597      !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.