calcul_aire Subroutine

private subroutine calcul_aire(tab_in, long, larg, hx, hy, aire)

Return the area of a surface

Arguments

Type IntentOptional Attributes Name
real(kind=R8), intent(in), dimension(1:long,1:larg) :: tab_in

surface array

integer(kind=I4), intent(in) :: long

2D array length

integer(kind=I4), intent(in) :: larg

2D array width

real(kind=R8), intent(in) :: hx

increment along x

real(kind=R8), intent(in) :: hy

increment along y

real(kind=R8), intent(out) :: aire

computed area


Called by

proc~~calcul_aire~~CalledByGraph proc~calcul_aire calcul_aire proc~calcul_asfc_lin_all calcul_asfc_lin_all proc~calcul_asfc_lin_all->proc~calcul_aire proc~calcul_asfc_spl_all calcul_asfc_spl_all proc~calcul_asfc_spl_all->proc~calcul_aire proc~calcul_asfc calcul_asfc proc~calcul_asfc->proc~calcul_asfc_lin_all proc~calcul_asfc->proc~calcul_asfc_spl_all

Source Code

   subroutine calcul_aire(tab_in, long, larg, hx, hy, aire)
   !================================================================================================
   !! Return the area of a surface
   implicit none
   integer(kind=I4), intent(in )                            :: long     !! *2D array length*
   integer(kind=I4), intent(in )                            :: larg     !! *2D array width*
   real   (kind=R8), intent(in )                            :: hx       !! *increment along x*
   real   (kind=R8), intent(in )                            :: hy       !! *increment along y*
   real   (kind=R8), intent(out)                            :: aire     !! *computed area*
   real   (kind=R8), intent(in ), dimension(1:long,1:larg)  :: tab_in   !! *surface array*

      integer(kind=I4) :: i, j
      real   (kind=R8) :: z1, z2, z3, z4, si

      si = 1!SCALE_IMG%si

      ! Raisonnement sur chaque carré du domaine
      aire = 0.
      do j = 1, larg -1
      do i = 1, long -1

         z1 = tab_in(i   , j   )*si
         z2 = tab_in(i   , j +1)*si
         z3 = tab_in(i +1, j +1)*si
         z4 = tab_in(i +1, j   )*si

         aire = aire +0.5_R8*( sqrt( UN +((z1-z2)/hx)**2 +((z1-z4)/hy)**2 ) + &
                               sqrt( UN +((z3-z2)/hy)**2 +((z3-z4)/hx)**2 ) )

      enddo
      enddo
      aire = aire/( (long -1)*(larg -1) )

   return
   endsubroutine calcul_aire