Statistiques
| Révision :

root / src / PrintGeomVasp.f90 @ 2

Historique | Voir | Annoter | Télécharger (2,88 ko)

1 1 equemene
SUBROUTINE PrintGeomVasp(Title,geom,LatrLoc,FrozAt,IoUnit)
2 1 equemene
3 1 equemene
! this subroutine prints a cartesian geometry in the VASP POSCAR format
4 1 equemene
5 1 equemene
  Use Path_module
6 1 equemene
  Use Io_module
7 1 equemene
8 1 equemene
  IMPLICIT NONE
9 1 equemene
10 1 equemene
  CHARACTER(*), INTENT(IN) :: TITLE
11 1 equemene
  REAL(KREAL),INTENT(IN) :: LatrLoc(3,3),Geom(3*Nat)
12 1 equemene
  LOGICAL, INTENT(IN) :: FrozAt(Nat)
13 1 equemene
  INTEGER(KINT), INTENT(IN) :: IoUnit
14 1 equemene
15 1 equemene
  INTEGER(KINT) :: IGeom, Idx, Iat, I,J
16 1 equemene
  REAL(KREAL), ALLOCATABLE :: GeomTmpC2(:,:),GeomTmpC(:,:)
17 1 equemene
  REAL(KREAL) :: MRot(3,3)
18 1 equemene
19 1 equemene
  REAL(KREAL) :: X,Y,Z
20 1 equemene
21 1 equemene
  LOGICAL :: Debug
22 1 equemene
23 1 equemene
  INTERFACE
24 1 equemene
     function valid(string) result (isValid)
25 1 equemene
       CHARACTER(*), intent(in) :: string
26 1 equemene
       logical                  :: isValid
27 1 equemene
     END function VALID
28 1 equemene
  END INTERFACE
29 1 equemene
30 1 equemene
  debug=valid('printgeomvasp')
31 1 equemene
 if (debug) WRITE(*,*) '================ Entering PrintGeomVasp ===================='
32 1 equemene
33 1 equemene
  ALLOCATE(GeomTmpC2(Nat,3),GeomTmpC(3,Nat))
34 1 equemene
35 1 equemene
  GeomTmpC=reshape(Geom,SHAPE=(/3,Nat/),ORDER=(/2,1/))
36 1 equemene
37 1 equemene
     DO I=1,Nat
38 1 equemene
        Iat=Order(I)
39 1 equemene
!        if (debug) WRITE(*,*) "WriteVASP I,Order(I)",I,Iat
40 1 equemene
        GeomTmpC2(I,1:3)=GeomTmpC(1:3,Iat)
41 1 equemene
     END DO
42 1 equemene
43 1 equemene
     if (debug) THEN
44 1 equemene
        WRITe(*,*) Nat
45 1 equemene
        WRITe(*,*) "Original"
46 1 equemene
        DO I=1,Nat
47 1 equemene
           WRITE(*,'(1X,A4,3(1X,F12.6))') AtName(I), &
48 1 equemene
                x0_vasp(I),Y0_vasp(I),z0_vasp(I)
49 1 equemene
        END DO
50 1 equemene
        WRITE(*,*) Nat
51 1 equemene
        WRITe(*,*) "Before align"
52 1 equemene
        DO I=1,Nat
53 1 equemene
           WRITE(*,'(1X,A4,3(1X,F12.6))') AtName(I), &
54 1 equemene
                GeomTmpC2(I,1), GeomTmpC2(I,2), GeomTmpC2(I,3)
55 1 equemene
        END DO
56 1 equemene
     ENDIF
57 1 equemene
58 1 equemene
59 1 equemene
     IF ((COORD.EQ.'ZMAT').AND.(Nat.GE.4)) THEN
60 1 equemene
        Call  AlignPartial(Nat,x0_vasp,y0_vasp,z0_vasp,     &
61 1 equemene
             GeomTmpC2(1,1),GeomTmpC2(1,2),GeomTMPC2(1,3),       &
62 1 equemene
             FrozAt,MRot)
63 1 equemene
        if (debug) THEN
64 1 equemene
           WRITE(*,*) NAt
65 1 equemene
           WRITe(*,*) "Aligned ?"
66 1 equemene
           DO I=1,Nat
67 1 equemene
              WRITE(*,'(1X,A4,3(1X,F12.6))') AtName(I), &
68 1 equemene
                   GeomTmpC2(I,1), GeomTmpC2(I,2), GeomTmpC2(I,3)
69 1 equemene
           END DO
70 1 equemene
        ENDIF
71 1 equemene
     END IF
72 1 equemene
73 1 equemene
     ! We print the corresponding file
74 1 equemene
     WRITE(IOUNIT,'(A)') Trim(Title)
75 1 equemene
     WRITE(IOUNIT,'(1X,F18.14)') Vasp_Param
76 1 equemene
     WRITE(IOUNIT,'(3(1X,F21.16))')  Lat_a(1)/Vasp_param,Lat_a(2)/Vasp_param,Lat_a(3)/Vasp_param
77 1 equemene
     WRITE(IOUNIT,'(3(1X,F21.16))')  Lat_b(1)/Vasp_param,Lat_b(2)/Vasp_param,Lat_b(3)/Vasp_param
78 1 equemene
     WRITE(IOUNIT,'(3(1X,F21.16))')  Lat_c(1)/Vasp_param,Lat_c(2)/Vasp_param,Lat_c(3)/Vasp_param
79 1 equemene
     WRITE(IOUNIT,'(A)') TRIM(Vasp_Types)
80 1 equemene
     WRITE(IOUNIT,'(A)') TRIM(Vasp_comment)
81 1 equemene
     WRITE(IOUNIT,'(A)') TRIM(Vasp_direct)
82 1 equemene
     DO I=1,Nat
83 1 equemene
        X=0.
84 1 equemene
        Y=0.
85 1 equemene
        Z=0.
86 1 equemene
        DO J=1,3
87 1 equemene
           X=X+GeomTmpC2(I,J)*LatrLoc(1,J)
88 1 equemene
           Y=Y+GeomTmpC2(I,J)*LatrLoc(2,J)
89 1 equemene
           Z=Z+GeomTmpC2(I,J)*LatrLoc(3,J)
90 1 equemene
        END DO
91 1 equemene
        WRITE(IOUNIT,'(3F20.16,1X,3A4)') X,Y,Z,FFF(1:3,I)
92 1 equemene
     END DO
93 1 equemene
94 1 equemene
  DeALLOCATE(GeomTmpC2)
95 1 equemene
 if (debug) WRITE(*,*) '================  PrintGeomVasp OVER ===================='
96 1 equemene
97 1 equemene
END SUBROUTINE PrintGeomVasp