root / src / Int2cart.f90 @ 5
Historique | Voir | Annoter | Télécharger (2,74 ko)
| 1 |
SUBROUTINE Int2Cart(Nat,IndZmat,IntCoord,XyzCoord) |
|---|---|
| 2 |
|
| 3 |
Use Path_module, ONLY : Pi |
| 4 |
|
| 5 |
IMPLICIT NONE |
| 6 |
|
| 7 |
INTEGER, PARAMETER :: Kint=Kind(1) |
| 8 |
INTEGER, PARAMETER :: KREAL=Kind(1.0D0) |
| 9 |
|
| 10 |
INTEGER(KINT), INTENT(IN) :: Nat |
| 11 |
INTEGER(KINT), INTENT(IN) :: IndZmat(Nat,5) |
| 12 |
REAL(KREAL), INTENT(IN) :: IntCoord(3*Nat-6) |
| 13 |
REAL(KREAL), INTENT(OUT) :: XyzCoord(Nat,3) |
| 14 |
|
| 15 |
INTEGER(KINT) :: I |
| 16 |
REAl(KREAL), ALLOCATABLE :: ValZmat(:,:),XyzTmp(:,:) |
| 17 |
REAL(KREAL) :: d, a_val |
| 18 |
LOGICAL :: debug |
| 19 |
|
| 20 |
INTERFACE |
| 21 |
function valid(string) result (isValid) |
| 22 |
CHARACTER(*), intent(in) :: string |
| 23 |
logical :: isValid |
| 24 |
END function VALID |
| 25 |
|
| 26 |
END INTERFACE |
| 27 |
|
| 28 |
debug=valid('int2cart')
|
| 29 |
|
| 30 |
if (debug) WRITE(*,*) '================ Entering Int2Cart ===================' |
| 31 |
|
| 32 |
ALLOCATE(ValZmat(Nat,3),XyzTmp(Nat,3)) |
| 33 |
|
| 34 |
ValZmat=0.d0 |
| 35 |
ValZmat(2,1)=IntCoord(1) |
| 36 |
ValZmat(3,1)=IntCoord(2) |
| 37 |
ValZmat(3,2)=IntCoord(3)*180./Pi |
| 38 |
DO I=4,Nat |
| 39 |
ValZmat(I,1)=IntCoord(3*I-8) |
| 40 |
ValZmat(I,2)=IntCoord(3*I-7)*180./Pi |
| 41 |
ValZmat(I,3)=IntCoord(3*I-6)*180./Pi |
| 42 |
END DO |
| 43 |
|
| 44 |
IF (debug) THEN |
| 45 |
WRITE(*,*) 'DBG Int2Cart' |
| 46 |
DO I=1,Nat |
| 47 |
WRITe(*,'(1X,I3,3(1X,I3,1X,F10.4))') IndZmat(I,1), IndZmat(I,2), ValZmat(I,1), IndZmat(I,3),& |
| 48 |
ValZmat(I,2), IndZmat(I,4), Valzmat(I,3) |
| 49 |
END DO |
| 50 |
END IF |
| 51 |
|
| 52 |
Xyztmp=0.d0 |
| 53 |
Xyztmp(2,1)=valzmat(2,1) |
| 54 |
d=valzmat(3,1) |
| 55 |
a_val=valzmat(3,2)/180.*Pi |
| 56 |
! write(*,*) "aval,pi",a_val,valzmat(3,2),pi |
| 57 |
if (Nat.GE.3) THEN |
| 58 |
if (IndZmat(3,2).EQ.1) THEN |
| 59 |
Xyztmp(3,1)=Xyztmp(1,1)+d*cos(a_val) |
| 60 |
ELSE |
| 61 |
Xyztmp(3,1)=Xyztmp(2,1)-d*cos(a_val) |
| 62 |
ENDIF |
| 63 |
Xyztmp(3,2)=d*sin(a_val) |
| 64 |
ENDIF |
| 65 |
! i=1 |
| 66 |
! WRITE(*,*) 'TOTOCart:',i, (Xyztmp(I,J),J=1,3) |
| 67 |
! WRITE(*,*) 'TOTOZma:',i, (valzmat(I,J),J=1,3) |
| 68 |
! i=2 |
| 69 |
! WRITE(*,*) 'TOTOCart:',i, (Xyztmp(I,J),J=1,3) |
| 70 |
! WRITE(*,*) 'TOTOZma:',i, (valzmat(I,J),J=1,3) |
| 71 |
! i=3 |
| 72 |
! WRITE(*,*) 'TOTOCart:',i, (Xyztmp(I,J),J=1,3) |
| 73 |
! WRITE(*,*) 'TOTOZma:',i, (valzmat(I,J),J=1,3) |
| 74 |
|
| 75 |
DO i=4,Nat |
| 76 |
call ConvertZmat_cart(i,IndZmat,valzmat, & |
| 77 |
Xyztmp(1,1), Xyztmp(1,2),Xyztmp(1,3)) |
| 78 |
! WRITE(*,*) 'TOTOZma:',i,IndZmat(I,1), & |
| 79 |
! (IndZmat(I,J+1),valzmat(I,J),J=1,3) |
| 80 |
! WRITE(*,*) 'TOTOCart:',i, (Xyztmp(I,J),J=1,3) |
| 81 |
END DO |
| 82 |
|
| 83 |
IF (debug) THEN |
| 84 |
WRITE(*,*) 'DBG Int2Cart XyzTmp' |
| 85 |
DO I=1,Nat |
| 86 |
WRITe(*,'(1X,I3,3(1X,F10.4))') I, XyzTmp(I,1:3) |
| 87 |
END DO |
| 88 |
END IF |
| 89 |
|
| 90 |
|
| 91 |
! XyzCoord=Reshape(XyzTmp,(/3,Nat/),ORDER=(/2,1/)) |
| 92 |
XyzCoord=XyzTmp |
| 93 |
|
| 94 |
DEALLOCATE(valzmat,xyztmp) |
| 95 |
if (debug) WRITE(*,*) '================ Exiting Int2cart ===================' |
| 96 |
|
| 97 |
END SUBROUTINE Int2Cart |