source: TOOLS/MOZAIC/src/POLY/m_g2d.f90 @ 5877

MODULE m_g2d
   !>---------------------------------------------------------------------
   !!- elements algebriques 2d
   !!---------------------------------------------------------------------
   !!- type :    c2d : couple de composantes (x,y)
   !!-
   !!- operations :
   !!-   v    = r         v = (r,r)
   !!-   v    = r(1:2)    v = (r(1),r(2))
   !!-   r(1:2) = v       r(1:2) = (/v%x,v%y/)
   !!-   v1+v2            addition
   !!-   v1-v2            soustraction
   !!-   -v               changement de signe
   !!-   v*r, r*v         reel*vecteur
   !!-   v1.s.v2          produit scalaire
   !!-   v1.v.v2          produit vectoriel
   !!-   v1.a.v2          angle (en radians) entre v1 et v2
   !!-
   !!- fonctions : 
   !!-   v2 = vn_2d(v1)   v2 est v1 normalise a 1.
   !!---------------------------------------------------------------------
   USE poly_types
   USE mt_c2d
   IMPLICIT NONE
   !-
   !> Affection
   INTERFACE ASSIGNMENT(=)
      MODULE PROCEDURE c2d_equ_c2d, c2d_equ_r, c2d_equ_v2, v2_equ_c2d
   END INTERFACE
   !> Add 
   INTERFACE OPERATOR(+)
      MODULE PROCEDURE add_c2d
   END INTERFACE
   !> Substract
   INTERFACE OPERATOR(-)
      MODULE PROCEDURE sub_c2d,inv_c2d
   END INTERFACE
   !> Multiply
   INTERFACE OPERATOR(*)
      MODULE PROCEDURE mul_c2d_r,mul_r_c2d
   END INTERFACE
   !> Scalar product
   INTERFACE OPERATOR(.s.)
      MODULE PROCEDURE ps_c2d
   END INTERFACE
   !> Vector product
   INTERFACE OPERATOR(.v.)
      MODULE PROCEDURE pv_c2d
   END INTERFACE
   !> Normalize
   INTERFACE OPERATOR(.a.)
      MODULE PROCEDURE av_c2d
   END INTERFACE
   !-
CONTAINS
   !> affectation
   SUBROUTINE c2d_equ_c2d (vs,ve) !> affectation
      !> affectation
      !
      !> Output vector (left hand)
      TYPE(c2d),INTENT(out) :: vs
      !> Output vector (right hand)
      TYPE(c2d),INTENT(in)  :: ve
      vs%x = ve%x; vs%y = ve%y;
   END SUBROUTINE c2d_equ_c2d
   !
   SUBROUTINE c2d_equ_r (vs,re)
      !> affectation
      !> Output vector (left hand)
      TYPE(c2d),INTENT(out) :: vs 
      !> Input real (right hand)
      REAL (kind=rp),INTENT(in) :: re
      vs%x = re; vs%y = re;
   END SUBROUTINE c2d_equ_r
   SUBROUTINE c2d_equ_v2 (vs,te)
      !> affectation
      !> Output vector (left hand)
      TYPE(c2d),INTENT(out)        :: vs
      !> Input real array (2 reals), (right hand)
      REAL (kind=rp),DIMENSION(2),INTENT(in) :: te
      vs%x  = te(1); vs%y = te(2);
   END SUBROUTINE c2d_equ_v2
   SUBROUTINE v2_equ_c2d (ts,ve)
      !> affectation
      !
      !> Input vector (right hand)
      TYPE(c2d),INTENT(in)          :: ve
      !> Output real array (2 reals), (left hand)
      REAL (kind=rp),DIMENSION(2),INTENT(out) :: ts 
      ts(1) = ve%x; ts(2) = ve%y;
   END SUBROUTINE v2_equ_c2d
   !> addition
   TYPE(c2d) FUNCTION add_c2d (v1,v2)
      TYPE(c2d),INTENT(in):: v1,v2
      add_c2d%x = v1%x+v2%x; add_c2d%y = v1%y+v2%y;
   END FUNCTION add_c2d
   !> soustraction
   TYPE(c2d) FUNCTION sub_c2d (v1,v2)
      TYPE(c2d),INTENT(in):: v1,v2
      sub_c2d%x = v1%x-v2%x; sub_c2d%y = v1%y-v2%y;
   END FUNCTION sub_c2d
   !> changement de signe
   TYPE(c2d) FUNCTION inv_c2d (v1)
      TYPE(c2d),INTENT(in):: v1
      inv_c2d%x = -v1%x; inv_c2d%y = -v1%y;
   END FUNCTION inv_c2d
   !> multiplication
   TYPE(c2d) FUNCTION mul_c2d_r (v1,r2)
      TYPE(c2d),INTENT(in) :: v1
      REAL (kind=rp) ,INTENT(in)      :: r2
      mul_c2d_r%x = v1%x*r2; mul_c2d_r%y = v1%y*r2;
   END FUNCTION mul_c2d_r
   TYPE(c2d) FUNCTION mul_r_c2d (r1,v2)
      TYPE(c2d),INTENT(in) :: v2
      REAL (kind=rp),INTENT(in)      :: r1
      mul_r_c2d%x = v2%x*r1; mul_r_c2d%y = v2%y*r1;
   END FUNCTION mul_r_c2d
   !> produit scalaire
   FUNCTION ps_c2d (v1,v2)
      REAL (kind=rp) :: ps_c2d
      TYPE(c2d),INTENT(in) :: v1,v2
      ps_c2d = v1%x*v2%x+v1%y*v2%y
   END FUNCTION ps_c2d
   !> produit vectoriel
   FUNCTION pv_c2d (v1,v2)
      real (kind=rp) :: pv_c2d
      TYPE(c2d),INTENT(in) :: v1,v2
      pv_c2d = v1%x*v2%y-v1%y*v2%x
   END FUNCTION pv_c2d
   !> angle
   FUNCTION av_c2d (v1,v2)
      REAL (kind=rp) :: av_c2d
      TYPE(c2d),INTENT(in) :: v1,v2
      REAL (kind=rp) :: ps,pv
      ps = v1.s.v2; pv = v1.v.v2
      IF ( (ps == 0.).AND.(pv == 0.) ) THEN
         av_c2d = 0.
      ELSE
         av_c2d = ATAN2(pv,ps)
      END IF
   END FUNCTION av_c2d
   !> vecteur normalise
   TYPE(c2d) FUNCTION vn_2d (v)
      TYPE(c2d),INTENT(in) ::v
      REAL (kind=rp) :: n
      n = SQRT(v.s.v)
      IF (n>0) THEN
         vn_2d%x = v%x/n
         vn_2d%y = v%y/n
      END IF
   END  FUNCTION vn_2d
   !------------------
END MODULE m_g2d