root / src / Write_vasp.f90 @ 4
Historique | Voir | Annoter | Télécharger (2,52 ko)
1 | 1 | equemene | SUBROUTINE Write_vasp(poscar) |
---|---|---|---|
2 | 1 | equemene | |
3 | 1 | equemene | Use Path_module |
4 | 1 | equemene | Use Io_module |
5 | 1 | equemene | |
6 | 1 | equemene | IMPLICIT NONE |
7 | 1 | equemene | |
8 | 1 | equemene | CHARACTER(SCHARS), INTENT(IN) :: poscar |
9 | 1 | equemene | |
10 | 1 | equemene | INTEGER(KINT) :: IGeom, Idx, Iat, I,J,NFr |
11 | 1 | equemene | REAL(KREAL), ALLOCATABLE :: GeomTmpC(:), GeomTmp(:) |
12 | 1 | equemene | REAL(KREAL) :: MRot(3,3), Rmsd |
13 | 1 | equemene | CHARACTER(SCHARS) :: Line,Line2 |
14 | 1 | equemene | |
15 | 1 | equemene | ! For VMD printing |
16 | 1 | equemene | CHARACTER(SCHARS), PARAMETER :: FirstWord="mol " |
17 | 1 | equemene | CHARACTER(LCHARS), PARAMETER :: LastWords=" type POSCAR first 0 last -1 step 1 filebonds 1 autobonds 1 waitfor all" |
18 | 1 | equemene | |
19 | 1 | equemene | REAL(KREAL) :: X,Y,Z |
20 | 1 | equemene | CHARACTER(LCHARS) :: TITLE |
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('write_vasp') |
31 | 1 | equemene | if (debug) WRITE(*,*) '================ Entering Write_VASP ====================' |
32 | 1 | equemene | |
33 | 1 | equemene | ALLOCATE(GeomTmpC(3*Nat), GeomTmp(NCoord)) |
34 | 1 | equemene | |
35 | 1 | equemene | Line2="00" |
36 | 1 | equemene | DO IGeom=1,NGeomF |
37 | 1 | equemene | WRITE(Line,'(I5)') IGeom-1 |
38 | 1 | equemene | Idx=2-Len_TRIM(ADJUSTL(Line)) |
39 | 1 | equemene | OPEN(IOTMP,File=TRIM(POSCAR) // "_" // Line2(1:Idx) // AdjustL(TRIM(Line))) |
40 | 1 | equemene | ! we convert the coordinates into Cartesian coordinates |
41 | 1 | equemene | SELECT CASE (Coord) |
42 | 1 | equemene | CASE ('CART','HYBRID') |
43 | 1 | equemene | GeomTmpC=Reshape(reshape(XyzGeomF(IGeom,:,:),(/Nat,3/),ORDER=(/2,1/)),(/3*Nat/)) |
44 | 1 | equemene | CASE ('ZMAT') |
45 | 1 | equemene | GeomTmp=IntCoordF(IGeom,:) |
46 | 1 | equemene | ! we have to generate the cartesian coordinates from the internal coordinates |
47 | 1 | equemene | CAll Int2Cart(nat,indzmat,geomtmp,GeomTmpC) |
48 | 1 | equemene | CASE ('MIXED') |
49 | 1 | equemene | GeomTmp=IntCoordF(IGeom,:) |
50 | 1 | equemene | CAll Mixed2Cart(nat,indzmat,geomtmp,GeomTmpC) |
51 | 1 | equemene | END SELECT |
52 | 1 | equemene | |
53 | 1 | equemene | if (debug) WRITE(*,*) "Converting geom ",IGeom," into file ",Trim(POSCAR) // "_" // Line2(1:Idx) // AdjustL(TRIM(Line)) |
54 | 1 | equemene | |
55 | 1 | equemene | WRITE(Title,'(A,I2,"/",I2)') Trim(Vasp_Title) // " - Geom ",IGeom-1,NGeomF-1 |
56 | 1 | equemene | |
57 | 1 | equemene | Call PrintGeomVasp(Title,geomTmpC,Latr,FrozAtoms,IoTmp) |
58 | 1 | equemene | |
59 | 1 | equemene | CLOSE(IOTMP) |
60 | 1 | equemene | END DO |
61 | 1 | equemene | |
62 | 1 | equemene | if (Vmd) THEN |
63 | 1 | equemene | WRITE(IOOUT,*) "## Insert the following list into the Test_NEB_example.vmd file for an easy VMD use" |
64 | 1 | equemene | |
65 | 1 | equemene | Line2="00" |
66 | 1 | equemene | WRITE(IOOUT,'(A)') TRIM(FirstWord) // " new " // TRIM(POSCAR) // "_00" // TRIM(LastWords) |
67 | 1 | equemene | DO IGeom=2,NGeomF |
68 | 1 | equemene | WRITE(Line,'(I5)') IGeom-1 |
69 | 1 | equemene | Idx=2-Len_TRIM(ADJUSTL(Line)) |
70 | 1 | equemene | WRITE(IOOUT,'(A)') TRIM(FirstWord) // " addfile " // TRIM(POSCAR) // & |
71 | 1 | equemene | "_" // Line2(1:Idx) // TRIM(ADJUSTL(Line)) // TRIM(LastWords) |
72 | 1 | equemene | END DO |
73 | 1 | equemene | WRITE(IOOUT,*) "## End of List" |
74 | 1 | equemene | END IF |
75 | 1 | equemene | |
76 | 1 | equemene | if (debug) WRITE(*,*) '================ Write_VASP OVER ====================' |
77 | 1 | equemene | DeALLOCATE(GeomTmpC, GeomTmp) |
78 | 1 | equemene | |
79 | 1 | equemene | END SUBROUTINE Write_vasp |