Statistiques
| Révision :

root / src / ReadInput_mopac.f90 @ 12

Historique | Voir | Annoter | Télécharger (6,1 ko)

1 5 pfleura2
 SUBROUTINE ReadInput_Mopac
2 5 pfleura2
3 5 pfleura2
! This routine reads an input template for MOPAC
4 5 pfleura2
5 12 pfleura2
!----------------------------------------------------------------------
6 12 pfleura2
!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon,
7 12 pfleura2
!  Centre National de la Recherche Scientifique,
8 12 pfleura2
!  Université Claude Bernard Lyon 1. All rights reserved.
9 12 pfleura2
!
10 12 pfleura2
!  This work is registered with the Agency for the Protection of Programs
11 12 pfleura2
!  as IDDN.FR.001.100009.000.S.P.2014.000.30625
12 12 pfleura2
!
13 12 pfleura2
!  Authors: P. Fleurat-Lessard, P. Dayal
14 12 pfleura2
!  Contact: optnpath@gmail.com
15 12 pfleura2
!
16 12 pfleura2
! This file is part of "Opt'n Path".
17 12 pfleura2
!
18 12 pfleura2
!  "Opt'n Path" is free software: you can redistribute it and/or modify
19 12 pfleura2
!  it under the terms of the GNU Affero General Public License as
20 12 pfleura2
!  published by the Free Software Foundation, either version 3 of the License,
21 12 pfleura2
!  or (at your option) any later version.
22 12 pfleura2
!
23 12 pfleura2
!  "Opt'n Path" is distributed in the hope that it will be useful,
24 12 pfleura2
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
25 12 pfleura2
!
26 12 pfleura2
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
27 12 pfleura2
!  GNU Affero General Public License for more details.
28 12 pfleura2
!
29 12 pfleura2
!  You should have received a copy of the GNU Affero General Public License
30 12 pfleura2
!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.
31 12 pfleura2
!
32 12 pfleura2
! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,
33 12 pfleura2
! for commercial licensing opportunities.
34 12 pfleura2
!----------------------------------------------------------------------
35 12 pfleura2
36 5 pfleura2
  use VarTypes
37 5 pfleura2
  use Path_module
38 5 pfleura2
  use Io_module
39 5 pfleura2
40 5 pfleura2
  IMPLICIT NONE
41 5 pfleura2
42 5 pfleura2
  INTERFACE
43 5 pfleura2
     function valid(string) result (isValid)
44 5 pfleura2
       CHARACTER(*), intent(in) :: string
45 5 pfleura2
       logical                  :: isValid
46 5 pfleura2
     END function VALID
47 10 pfleura2
48 10 pfleura2
    SUBROUTINE die(routine, msg, file, line, unit)
49 10 pfleura2
50 10 pfleura2
      Use VarTypes
51 10 pfleura2
      Use io_module
52 10 pfleura2
53 10 pfleura2
      implicit none
54 10 pfleura2
      character(len=*), intent(in)           :: routine, msg
55 10 pfleura2
      character(len=*), intent(in), optional :: file
56 10 pfleura2
      integer(KINT), intent(in), optional      :: line, unit
57 10 pfleura2
58 10 pfleura2
    END SUBROUTINE die
59 10 pfleura2
60 10 pfleura2
61 5 pfleura2
  END INTERFACE
62 5 pfleura2
63 5 pfleura2
64 10 pfleura2
  CHARACTER(LCHARS) ::  Line,LineUp
65 5 pfleura2
  INTEGER(KINT) :: LineL, Idx, NTmp
66 10 pfleura2
  INTEGER(KINT) :: NatMopac
67 10 pfleura2
  REAL(KREAL) :: Lat(3,3)
68 5 pfleura2
69 5 pfleura2
  LOGICAL :: Debug
70 5 pfleura2
71 5 pfleura2
72 5 pfleura2
  Debug=Valid("readinput").OR.Valid("readinput_mopac")
73 5 pfleura2
74 5 pfleura2
  if (debug) Call Header("Entering ReadInput_mopac")
75 5 pfleura2
76 5 pfleura2
! The structure is:
77 5 pfleura2
! A MOPAC data set normally consists of one line of keywords, two lines of user-defined text, then the coordinates
78 5 pfleura2
! Then  a blank line or a line of 0.
79 5 pfleura2
! then the symmetry description.
80 5 pfleura2
! comment lines start with * and can be anywhere !!!
81 5 pfleura2
82 5 pfleura2
  ! First, the root
83 5 pfleura2
  IF (DEBUG) WRITE(*,*) "Reading Mopac input"
84 5 pfleura2
  ALLOCATE(Mopac_Root)
85 5 pfleura2
  NULLIFY(Mopac_Root%next)
86 5 pfleura2
  ALLOCATE(Mopac_Comment)
87 5 pfleura2
  NULLIFY(Mopac_Comment%next)
88 5 pfleura2
  ALLOCATE(Mopac_End)
89 5 pfleura2
  NuLLIFY(Mopac_End%Next)
90 5 pfleura2
  Current => Mopac_root
91 5 pfleura2
  CurCom => Mopac_Comment
92 5 pfleura2
  LineL=1
93 5 pfleura2
  NTmp=0
94 5 pfleura2
  DO WHILE (NTmp.LT.3)
95 5 pfleura2
     READ(IOIN,'(A)') Line
96 5 pfleura2
     Line=AdjustL(Line)
97 5 pfleura2
     LineL=len(Trim(Line))
98 5 pfleura2
     IF (Line(1:1)/="*") THEN
99 5 pfleura2
        IF (NTmp==0) THEN
100 10 pfleura2
           LineUp=Line
101 10 pfleura2
           Call UpCase(LineUp)
102 10 pfleura2
           Idx=Index(LineUp,'GRADIENTS')
103 5 pfleura2
           If (Idx==0) Line=TRIM(Line) // " GRADIENTS"
104 10 pfleura2
           Idx=Index(LineUp,'1SCF')
105 5 pfleura2
           If (Idx==0) Line=TRIM(Line) // " 1SCF"
106 5 pfleura2
        END IF
107 5 pfleura2
        current%Line=TRIM(Line)
108 5 pfleura2
        ALLOCATE(current%next)
109 5 pfleura2
        Current => Current%next
110 5 pfleura2
        Nullify(Current%next)
111 5 pfleura2
        NTmp=NTmp+1
112 5 pfleura2
     ELSE
113 5 pfleura2
        CurCom%Line=TRIM(LINE)
114 5 pfleura2
        ALLOCATE(CurCom%Next)
115 5 pfleura2
        CurCom => CurCom%Next
116 5 pfleura2
        NULLIFY(CurCom%Next)
117 5 pfleura2
     END IF
118 5 pfleura2
  END DO
119 5 pfleura2
120 5 pfleura2
!     Current => Mopac_root
121 5 pfleura2
!     DO WHILE (ASSOCIATED(Current%next))
122 5 pfleura2
!        WRITE(*,'(1X,A)') Trim(current%line)
123 5 pfleura2
!        Current => current%next
124 5 pfleura2
!     END DO
125 5 pfleura2
126 5 pfleura2
! Now the geometry... that we just skip :)
127 10 pfleura2
! PFL 2013 Apr
128 10 pfleura2
! We take care that there is no Translation vectors...
129 10 pfleura2
! We also check that the number of atoms is ok
130 5 pfleura2
  IF (DEBUG) WRITE(*,*) "Reading Mopac Geometry"
131 5 pfleura2
  Mopac_EndGeom=""
132 5 pfleura2
  LineL=1
133 10 pfleura2
  NatMopac=0
134 10 pfleura2
  Lat=0.d0
135 10 pfleura2
  IPer=0
136 10 pfleura2
  FPBC=.FALSE.
137 5 pfleura2
  DO WHILE (LineL.NE.0)
138 5 pfleura2
     READ(IOIN,'(A)',END=989) Line
139 5 pfleura2
     Line=AdjustL(Line)
140 5 pfleura2
     LineL=len(Trim(Line))
141 5 pfleura2
     ! The last line might be either blank or filled with 0
142 10 pfleura2
     If (LineL>0) THEN
143 10 pfleura2
        SELECT CASE (Line(1:1))
144 10 pfleura2
          CASE ("0")
145 10 pfleura2
             LineL=0
146 10 pfleura2
             Mopac_EndGeom=Trim(Line)
147 10 pfleura2
          CASE("*")
148 10 pfleura2
             CurCom%Line=TRIM(LINE)
149 10 pfleura2
             ALLOCATE(CurCom%Next)
150 10 pfleura2
             CurCom => CurCom%Next
151 10 pfleura2
             NULLIFY(CurCom%Next)
152 10 pfleura2
          CASE DEFAULT
153 10 pfleura2
             LineUp=Line
154 10 pfleura2
             Call UpCase(LineUp)
155 10 pfleura2
             If (LineUp(1:2)=="TV") THEN
156 10 pfleura2
                FPBC=.TRUE.
157 10 pfleura2
                IPer=IPer+1
158 10 pfleura2
                If (Iper>3) THEN
159 10 pfleura2
                   Call Die("ReadInput Mopac","Iper>3",Unit=IOOUT)
160 10 pfleura2
                END IF
161 10 pfleura2
                NTmp=Index(LineUp," ")
162 10 pfleura2
                LineUp=LineUp(NTmp:)
163 10 pfleura2
                Read(LineUp,*) Lat(IPer,1:3)
164 10 pfleura2
             ELSE
165 10 pfleura2
                NatMopac=NatMopac+1
166 10 pfleura2
             END IF
167 10 pfleura2
         END SELECT
168 10 pfleura2
      END IF
169 10 pfleura2
170 10 pfleura2
   END DO
171 10 pfleura2
172 10 pfleura2
!  WRITE(*,*) "NatMopac,Nat:",NAtMopac,Nat
173 10 pfleura2
  IF (NatMopac/=Nat) Call Die("ReadInput_mopac","Nat read does not mat nat",Unit=IOOUT)
174 10 pfleura2
  IF (FPBC) THEN
175 10 pfleura2
     Lat_a(1:3)=Lat(1,1:3)
176 10 pfleura2
     Lat_b(1:3)=Lat(2,1:3)
177 10 pfleura2
     Lat_c(1:3)=Lat(3,1:3)
178 10 pfleura2
     If (IPer>=1) THEN
179 10 pfleura2
        kaBeg=-1
180 10 pfleura2
        kaEnd=1
181 5 pfleura2
     END IF
182 10 pfleura2
     If (IPer>=2) THEN
183 10 pfleura2
        kbBeg=-1
184 10 pfleura2
        kbEnd=1
185 5 pfleura2
     END IF
186 10 pfleura2
     If (IPer==3) THEN
187 10 pfleura2
        kcBeg=-1
188 10 pfleura2
        kcEnd=1
189 10 pfleura2
     END IF
190 10 pfleura2
     If (IPer>3) THEN
191 10 pfleura2
        Call Die("Readinput_mopac","Found too many Tv lines !",Unit=IOOUT)
192 10 pfleura2
     END IF
193 10 pfleura2
  END IF
194 5 pfleura2
195 5 pfleura2
! If we are here, there might be something else to read: Mopac_end
196 5 pfleura2
197 5 pfleura2
  ! We now read the last part
198 5 pfleura2
  IF (DEBUG) WRITE(*,*) "Reading Mopac End"
199 5 pfleura2
  !     READ(IOIN,'(A)') Line
200 5 pfleura2
  Current => Mopac_End
201 5 pfleura2
  LineL=1
202 5 pfleura2
  DO WHILE (1.EQ.1)
203 5 pfleura2
     READ(IOIN,'(A)',END=989) Line
204 5 pfleura2
     Line=AdjustL(Line)
205 5 pfleura2
     LineL=len(Trim(Line))
206 5 pfleura2
     IF (Line(1:1)/="*") THEN
207 5 pfleura2
        current%Line=TRIM(Line)
208 5 pfleura2
        ALLOCATE(current%next)
209 5 pfleura2
        Current => Current%next
210 5 pfleura2
        Nullify(Current%next)
211 5 pfleura2
        NTmp=NTmp+1
212 5 pfleura2
     ELSE
213 5 pfleura2
        CurCom%Line=TRIM(LINE)
214 5 pfleura2
        ALLOCATE(CurCom%Next)
215 5 pfleura2
        CurCom => CurCom%Next
216 5 pfleura2
        NULLIFY(CurCom%Next)
217 5 pfleura2
        END IF
218 5 pfleura2
     END DO
219 5 pfleura2
989  CONTINUE
220 5 pfleura2
221 5 pfleura2
  if (debug) Call Header("Exiting ReadInput_mopac")
222 5 pfleura2
223 5 pfleura2
END SUBROUTINE READINPUT_Mopac