source: LMDZ5/trunk/tools/Max_diff_nc_with_lib/NR_util/scatter_max.f90

MODULE scatter_max_m

  ! Bug correction: intent of "dest".

  IMPLICIT NONE

  INTERFACE scatter_max
     MODULE PROCEDURE scatter_max_r, scatter_max_d
  END INTERFACE

  private scatter_max_r, scatter_max_d

CONTAINS

  SUBROUTINE scatter_max_r(dest, source, dest_index)
    use assert_eq_m, only: assert_eq
    REAL, DIMENSION(:), INTENT(inOUT) :: dest
    REAL, DIMENSION(:), INTENT(IN) :: source
    INTEGER, DIMENSION(:), INTENT(IN) :: dest_index

    INTEGER :: m, n, j, i
    !--------------------------------------
    n=assert_eq(size(source), size(dest_index), 'scatter_max_r')
    m=size(dest)
    do j=1, n
       i=dest_index(j)
       if (i > 0 .and. i <= m) dest(i)=max(dest(i), source(j))
    end do
  END SUBROUTINE scatter_max_r

  !*******************************************************

  SUBROUTINE scatter_max_d(dest, source, dest_index)
    use assert_eq_m, only: assert_eq
    DOUBLE PRECISION, DIMENSION(:), INTENT(inOUT) :: dest
    DOUBLE PRECISION, DIMENSION(:), INTENT(IN) :: source
    INTEGER, DIMENSION(:), INTENT(IN) :: dest_index

    INTEGER :: m, n, j, i
    !--------------------------------------
    n=assert_eq(size(source), size(dest_index), 'scatter_max_d')
    m=size(dest)
    do j=1, n
       i=dest_index(j)
       if (i > 0 .and. i <= m) dest(i)=max(dest(i), source(j))
    end do
  END SUBROUTINE scatter_max_d

END MODULE scatter_max_m