root / src / ConvXyzZmat.f90 @ 2
Historique | Voir | Annoter | Télécharger (3,57 ko)
| 1 |
SUBROUTINE ConvXyzZmat(nb,x,y,z,ind_zmat,val_zmat) |
|---|---|
| 2 |
|
| 3 |
Use VarTypes |
| 4 |
|
| 5 |
IMPLICIT NONE |
| 6 |
|
| 7 |
integer(KINT) :: i,i1,i2 |
| 8 |
|
| 9 |
integer(KINT) :: n1,n2,n3,n4,nb |
| 10 |
real(KREAL) :: x(Nb),y(Nb),z(Nb) |
| 11 |
real(KREAL) :: val_zmat(Nb,3) |
| 12 |
integer(KINT) :: ind_zmat(Nb,5) |
| 13 |
real(KREAL) :: vx1,vy1,vz1,norm1 |
| 14 |
real(KREAL) :: vx2,vy2,vz2,norm2 |
| 15 |
real(KREAL) :: vx3,vy3,vz3,norm3 |
| 16 |
real(KREAL) :: vx4,vy4,vz4,norm4 |
| 17 |
real(KREAL) :: vx5,vy5,vz5,norm5 |
| 18 |
real(KREAL) :: val,val_d |
| 19 |
|
| 20 |
LOGICAL :: Debug |
| 21 |
|
| 22 |
|
| 23 |
INTERFACE |
| 24 |
function valid(string) result (isValid) |
| 25 |
CHARACTER(*), intent(in) :: string |
| 26 |
logical :: isValid |
| 27 |
END function VALID |
| 28 |
|
| 29 |
FUNCTION angle(v1x,v1y,v1z,norm1,v2x,v2y,v2z,norm2) |
| 30 |
use Path_module, only : Pi,KINT, KREAL |
| 31 |
real(KREAL) :: v1x,v1y,v1z,norm1 |
| 32 |
real(KREAL) :: v2x,v2y,v2z,norm2 |
| 33 |
real(KREAL) :: angle |
| 34 |
END FUNCTION ANGLE |
| 35 |
|
| 36 |
|
| 37 |
FUNCTION angle_d(v1x,v1y,v1z,norm1,v2x,v2y,v2z,norm2,v3x,v3y,v3z,norm3) |
| 38 |
use Path_module, only : Pi,KINT, KREAL |
| 39 |
real(KREAL) :: v1x,v1y,v1z,norm1 |
| 40 |
real(KREAL) :: v2x,v2y,v2z,norm2 |
| 41 |
real(KREAL) :: v3x,v3y,v3z,norm3 |
| 42 |
real(KREAL) :: angle_d,ca,sa |
| 43 |
END FUNCTION ANGLE_D |
| 44 |
|
| 45 |
END INTERFACE |
| 46 |
|
| 47 |
debug=valid("ConvXyzZmat")
|
| 48 |
|
| 49 |
if (debug) THEN |
| 50 |
Call Header("ConvXyz Zmat")
|
| 51 |
WRITe(*,*) Nb |
| 52 |
DO I=1,Nb |
| 53 |
WRITe(*,'(3(1X,F15.8))') x(I),y(i),z(i) |
| 54 |
END DO |
| 55 |
END IF |
| 56 |
IF (nb .GE. 1) THEN |
| 57 |
|
| 58 |
val_zmat(1,1)=0.0 |
| 59 |
val_zmat(1,2)=0.0 |
| 60 |
val_zmat(1,3)=0.0 |
| 61 |
! write(*,*) 'Debut procedure Xyz_Zmat' |
| 62 |
|
| 63 |
IF (nb .GE. 2) THEN |
| 64 |
! write(*,*) 'Debut procedure Xyz_Zmat 2' |
| 65 |
i=2 |
| 66 |
n1=ind_zmat(i,1) |
| 67 |
n2=ind_zmat(i,2) |
| 68 |
|
| 69 |
CALL vecteur(n2,n1,x,y,z,vx1,vy1,vz1,norm1) |
| 70 |
! write(*,11) n1,n2,norm1 |
| 71 |
|
| 72 |
val_zmat(i,1)=norm1 |
| 73 |
val_zmat(i,2)=0.0 |
| 74 |
val_zmat(i,3)=0.0 |
| 75 |
|
| 76 |
IF (nb .GE. 3) THEN |
| 77 |
! write(*,*) 'Debut procedure Xyz_Zmat3' |
| 78 |
i=3 |
| 79 |
n1=ind_zmat(i,1) |
| 80 |
n2=ind_zmat(i,2) |
| 81 |
n3=ind_zmat(i,3) |
| 82 |
|
| 83 |
CALL vecteur(n2,n1,x,y,z,vx1,vy1,vz1,norm1) |
| 84 |
|
| 85 |
CALL vecteur(n2,n3,x,y,z,vx2,vy2,vz2,norm2) |
| 86 |
val=angle(vx1,vy1,vz1,norm1, & |
| 87 |
vx2,vy2,vz2,norm2) |
| 88 |
|
| 89 |
val_zmat(i,1)=norm1 |
| 90 |
val_zmat(i,2)=val |
| 91 |
val_zmat(i,3)=0.0 |
| 92 |
|
| 93 |
DO i=4,nb |
| 94 |
! write(*,*) 'Debut procedure Xyz_Zmat4' |
| 95 |
n1=ind_zmat(i,1) |
| 96 |
n2=ind_zmat(i,2) |
| 97 |
n3=ind_zmat(i,3) |
| 98 |
n4=ind_zmat(i,4) |
| 99 |
|
| 100 |
CALL vecteur(n2,n1,x,y,z,vx1,vy1,vz1,norm1) |
| 101 |
|
| 102 |
! write(*,*) 'Debut procedure Xyz_Zmat42' |
| 103 |
CALL vecteur(n2,n3,x,y,z,vx2,vy2,vz2,norm2) |
| 104 |
val=angle(vx1,vy1,vz1,norm1, & |
| 105 |
vx2,vy2,vz2,norm2) |
| 106 |
|
| 107 |
! write(*,*) 'Debut procedure Xyz_Zmat43' |
| 108 |
CALL vecteur(n3,n4,x,y,z,vx3,vy3,vz3,norm3) |
| 109 |
CALL produit_vect(vx1,vy1,vz1,norm1, & |
| 110 |
vx2,vy2,vz2,norm2, & |
| 111 |
vx4,vy4,vz4,norm4) |
| 112 |
CALL produit_vect(vx3,vy3,vz3,norm3, & |
| 113 |
vx2,vy2,vz2,norm2, & |
| 114 |
vx5,vy5,vz5,norm5) |
| 115 |
val_d=angle_d(vx4,vy4,vz4,norm4, & |
| 116 |
vx5,vy5,vz5,norm5, & |
| 117 |
vx2,vy2,vz2,norm2) |
| 118 |
|
| 119 |
! write(*,11) n1,n2,norm1,n3,val,n4,val_d |
| 120 |
11 format (2(1x,i3),1x,f8.4,2(1x,i3,1x,f8.3)) |
| 121 |
|
| 122 |
val_zmat(i,1)=norm1 |
| 123 |
val_zmat(i,2)=val |
| 124 |
val_zmat(i,3)=val_d |
| 125 |
|
| 126 |
END DO |
| 127 |
END IF |
| 128 |
END IF |
| 129 |
ELSE |
| 130 |
RETURN |
| 131 |
END IF |
| 132 |
RETURN |
| 133 |
END SUBROUTINE ConvXyzZmat |