[3326] | 1 | MODULE m_g2d |
---|
| 2 | !>--------------------------------------------------------------------- |
---|
| 3 | !!- elements algebriques 2d |
---|
| 4 | !!--------------------------------------------------------------------- |
---|
| 5 | !!- type : c2d : couple de composantes (x,y) |
---|
| 6 | !!- |
---|
| 7 | !!- operations : |
---|
| 8 | !!- v = r v = (r,r) |
---|
| 9 | !!- v = r(1:2) v = (r(1),r(2)) |
---|
| 10 | !!- r(1:2) = v r(1:2) = (/v%x,v%y/) |
---|
| 11 | !!- v1+v2 addition |
---|
| 12 | !!- v1-v2 soustraction |
---|
| 13 | !!- -v changement de signe |
---|
| 14 | !!- v*r, r*v reel*vecteur |
---|
| 15 | !!- v1.s.v2 produit scalaire |
---|
| 16 | !!- v1.v.v2 produit vectoriel |
---|
| 17 | !!- v1.a.v2 angle (en radians) entre v1 et v2 |
---|
| 18 | !!- |
---|
| 19 | !!- fonctions : |
---|
| 20 | !!- v2 = vn_2d(v1) v2 est v1 normalise a 1. |
---|
| 21 | !!--------------------------------------------------------------------- |
---|
| 22 | USE poly_types |
---|
| 23 | USE mt_c2d |
---|
| 24 | IMPLICIT NONE |
---|
| 25 | !- |
---|
| 26 | !> Affection |
---|
| 27 | INTERFACE ASSIGNMENT(=) |
---|
| 28 | MODULE PROCEDURE c2d_equ_c2d, c2d_equ_r, c2d_equ_v2, v2_equ_c2d |
---|
| 29 | END INTERFACE |
---|
| 30 | !> Add |
---|
| 31 | INTERFACE OPERATOR(+) |
---|
| 32 | MODULE PROCEDURE add_c2d |
---|
| 33 | END INTERFACE |
---|
| 34 | !> Substract |
---|
| 35 | INTERFACE OPERATOR(-) |
---|
| 36 | MODULE PROCEDURE sub_c2d,inv_c2d |
---|
| 37 | END INTERFACE |
---|
| 38 | !> Multiply |
---|
| 39 | INTERFACE OPERATOR(*) |
---|
| 40 | MODULE PROCEDURE mul_c2d_r,mul_r_c2d |
---|
| 41 | END INTERFACE |
---|
| 42 | !> Scalar product |
---|
| 43 | INTERFACE OPERATOR(.s.) |
---|
| 44 | MODULE PROCEDURE ps_c2d |
---|
| 45 | END INTERFACE |
---|
| 46 | !> Vector product |
---|
| 47 | INTERFACE OPERATOR(.v.) |
---|
| 48 | MODULE PROCEDURE pv_c2d |
---|
| 49 | END INTERFACE |
---|
| 50 | !> Normalize |
---|
| 51 | INTERFACE OPERATOR(.a.) |
---|
| 52 | MODULE PROCEDURE av_c2d |
---|
| 53 | END INTERFACE |
---|
| 54 | !- |
---|
| 55 | CONTAINS |
---|
| 56 | !> affectation |
---|
| 57 | SUBROUTINE c2d_equ_c2d (vs,ve) !> affectation |
---|
| 58 | !> affectation |
---|
| 59 | ! |
---|
| 60 | !> Output vector (left hand) |
---|
| 61 | TYPE(c2d),INTENT(out) :: vs |
---|
| 62 | !> Output vector (right hand) |
---|
| 63 | TYPE(c2d),INTENT(in) :: ve |
---|
| 64 | vs%x = ve%x; vs%y = ve%y; |
---|
| 65 | END SUBROUTINE c2d_equ_c2d |
---|
| 66 | ! |
---|
| 67 | SUBROUTINE c2d_equ_r (vs,re) |
---|
| 68 | !> affectation |
---|
| 69 | !> Output vector (left hand) |
---|
| 70 | TYPE(c2d),INTENT(out) :: vs |
---|
| 71 | !> Input real (right hand) |
---|
| 72 | REAL (kind=rp),INTENT(in) :: re |
---|
| 73 | vs%x = re; vs%y = re; |
---|
| 74 | END SUBROUTINE c2d_equ_r |
---|
| 75 | SUBROUTINE c2d_equ_v2 (vs,te) |
---|
| 76 | !> affectation |
---|
| 77 | !> Output vector (left hand) |
---|
| 78 | TYPE(c2d),INTENT(out) :: vs |
---|
| 79 | !> Input real array (2 reals), (right hand) |
---|
| 80 | REAL (kind=rp),DIMENSION(2),INTENT(in) :: te |
---|
| 81 | vs%x = te(1); vs%y = te(2); |
---|
| 82 | END SUBROUTINE c2d_equ_v2 |
---|
| 83 | SUBROUTINE v2_equ_c2d (ts,ve) |
---|
| 84 | !> affectation |
---|
| 85 | ! |
---|
| 86 | !> Input vector (right hand) |
---|
| 87 | TYPE(c2d),INTENT(in) :: ve |
---|
| 88 | !> Output real array (2 reals), (left hand) |
---|
| 89 | REAL (kind=rp),DIMENSION(2),INTENT(out) :: ts |
---|
| 90 | ts(1) = ve%x; ts(2) = ve%y; |
---|
| 91 | END SUBROUTINE v2_equ_c2d |
---|
| 92 | !> addition |
---|
| 93 | TYPE(c2d) FUNCTION add_c2d (v1,v2) |
---|
| 94 | TYPE(c2d),INTENT(in):: v1,v2 |
---|
| 95 | add_c2d%x = v1%x+v2%x; add_c2d%y = v1%y+v2%y; |
---|
| 96 | END FUNCTION add_c2d |
---|
| 97 | !> soustraction |
---|
| 98 | TYPE(c2d) FUNCTION sub_c2d (v1,v2) |
---|
| 99 | TYPE(c2d),INTENT(in):: v1,v2 |
---|
| 100 | sub_c2d%x = v1%x-v2%x; sub_c2d%y = v1%y-v2%y; |
---|
| 101 | END FUNCTION sub_c2d |
---|
| 102 | !> changement de signe |
---|
| 103 | TYPE(c2d) FUNCTION inv_c2d (v1) |
---|
| 104 | TYPE(c2d),INTENT(in):: v1 |
---|
| 105 | inv_c2d%x = -v1%x; inv_c2d%y = -v1%y; |
---|
| 106 | END FUNCTION inv_c2d |
---|
| 107 | !> multiplication |
---|
| 108 | TYPE(c2d) FUNCTION mul_c2d_r (v1,r2) |
---|
| 109 | TYPE(c2d),INTENT(in) :: v1 |
---|
| 110 | REAL (kind=rp) ,INTENT(in) :: r2 |
---|
| 111 | mul_c2d_r%x = v1%x*r2; mul_c2d_r%y = v1%y*r2; |
---|
| 112 | END FUNCTION mul_c2d_r |
---|
| 113 | TYPE(c2d) FUNCTION mul_r_c2d (r1,v2) |
---|
| 114 | TYPE(c2d),INTENT(in) :: v2 |
---|
| 115 | REAL (kind=rp),INTENT(in) :: r1 |
---|
| 116 | mul_r_c2d%x = v2%x*r1; mul_r_c2d%y = v2%y*r1; |
---|
| 117 | END FUNCTION mul_r_c2d |
---|
| 118 | !> produit scalaire |
---|
| 119 | FUNCTION ps_c2d (v1,v2) |
---|
| 120 | REAL (kind=rp) :: ps_c2d |
---|
| 121 | TYPE(c2d),INTENT(in) :: v1,v2 |
---|
| 122 | ps_c2d = v1%x*v2%x+v1%y*v2%y |
---|
| 123 | END FUNCTION ps_c2d |
---|
| 124 | !> produit vectoriel |
---|
| 125 | FUNCTION pv_c2d (v1,v2) |
---|
| 126 | real (kind=rp) :: pv_c2d |
---|
| 127 | TYPE(c2d),INTENT(in) :: v1,v2 |
---|
| 128 | pv_c2d = v1%x*v2%y-v1%y*v2%x |
---|
| 129 | END FUNCTION pv_c2d |
---|
| 130 | !> angle |
---|
| 131 | FUNCTION av_c2d (v1,v2) |
---|
| 132 | REAL (kind=rp) :: av_c2d |
---|
| 133 | TYPE(c2d),INTENT(in) :: v1,v2 |
---|
| 134 | REAL (kind=rp) :: ps,pv |
---|
| 135 | ps = v1.s.v2; pv = v1.v.v2 |
---|
| 136 | IF ( (ps == 0.).AND.(pv == 0.) ) THEN |
---|
| 137 | av_c2d = 0. |
---|
| 138 | ELSE |
---|
| 139 | av_c2d = ATAN2(pv,ps) |
---|
| 140 | END IF |
---|
| 141 | END FUNCTION av_c2d |
---|
| 142 | !> vecteur normalise |
---|
| 143 | TYPE(c2d) FUNCTION vn_2d (v) |
---|
| 144 | TYPE(c2d),INTENT(in) ::v |
---|
| 145 | REAL (kind=rp) :: n |
---|
| 146 | n = SQRT(v.s.v) |
---|
| 147 | IF (n>0) THEN |
---|
| 148 | vn_2d%x = v%x/n |
---|
| 149 | vn_2d%y = v%y/n |
---|
| 150 | END IF |
---|
| 151 | END FUNCTION vn_2d |
---|
| 152 | !------------------ |
---|
| 153 | END MODULE m_g2d |
---|