Revision 10 src/ReadInput_gaussian.f90

ReadInput_gaussian.f90 (revision 10)
13 13
       CHARACTER(*), intent(in) :: string
14 14
       logical                  :: isValid
15 15
     END function VALID
16

  
17

  
18
    SUBROUTINE die(routine, msg, file, line, unit)
19

  
20
      Use VarTypes
21
      Use io_module
22

  
23
      implicit none
24
      character(len=*), intent(in)           :: routine, msg
25
      character(len=*), intent(in), optional :: file
26
      integer(KINT), intent(in), optional      :: line, unit
27

  
28
    END SUBROUTINE die
29

  
30

  
16 31
  END INTERFACE
17 32

  
18 33

  
19
  CHARACTER(132) ::  Line
34
  CHARACTER(132) ::  Line,LineUp
20 35
  INTEGER(KINT) :: LineL, Idx, Iat
21
  INTEGER(KINT) :: I
36
  INTEGER(KINT) :: I,NTmp
37
  REAL(KREAL) :: Lat(3,3)
22 38
  
23 39
  LOGICAL :: Debug
24 40

  
......
86 102
     ALLOCATE(Gauss_Paste(NAt))
87 103
     LineL=1
88 104
     Iat=0
105
     IPer=0
106
     FPBC=.FALSE.
89 107
     Gauss_paste=" "
90 108
     DO While (LineL.GT.0)
91 109
        READ(IOIN,'(A)') Line
92 110
        Line=AdjustL(Line)
93 111
        LineL=Len_TRIM(Line)
94
        IF (LineL.GT.0) Iat=Iat+1
95
        Idx=Index(Line,'.',BACK=.TRUE.)
96
        Line=ADJUSTL(Line(Idx+1:))
97

  
98
        IF (LEN_TRIM(Line).GT.0) THEN 
99
           Gauss_paste(Iat)=ADJUSTL(TRIM(Line))
112
        IF (LineL.GT.0) THEN
113
           LineUp=Line
114
           Call UpCase(LineUp)
115
           if (LineUp(1:2)=="TV") THEN
116
              FPBC=.TRUE.
117
              IPer=IPer+1
118
              If (Iper>3) THEN
119
                 Call Die("ReadInput Gaussian","Iper>3",Unit=IOOUT)
120
              END IF
121
              NTmp=Index(LineUp," ")
122
              LineUp=LineUp(NTmp:)
123
              Read(LineUp,*) Lat(IPer,1:3)
124
           ELSE
125
              Iat=Iat+1
126
! we search for additional information at the end of the line
127
! for example ONIOM layers
128
! TO detect the end of the line, we use the fact that all reals
129
! should contain a '.', and that we have 3 reals/line.
130
              Idx=Index(Line,'.')
131
              Line=ADJUSTL(Line(Idx+1:))
132
              Idx=Index(Line,'.')
133
              Line=ADJUSTL(Line(Idx+1:))
134
              Idx=Index(Line,'.')
135
              Line=ADJUSTL(Line(Idx+1:))
136
              Idx=Index(Line,' ')
137
              If (Idx>0) THEN
138
                 Line=ADJUSTL(Line(Idx:))
139
                 IF (LEN_TRIM(Line).GT.0) THEN 
140
                    Gauss_paste(Iat)=ADJUSTL(TRIM(Line))
141
                 END IF
142
              ELSE
143
                 Gauss_paste(Iat)=""
144
              END IF
145
           END IF
100 146
        END IF
147
           
101 148
     END DO
102 149

  
150

  
103 151
     IF (Iat.NE.Nat) THEN
104
        WRITE(*,*) "I found ", Iat," lines for the geometry instead of ",Nat
105
        WRITE(*,*) "ERROR. STOP"
106
        WRITE(IOOUT,*) "I found ", Iat," lines for the geometry instead of ",Nat
107
        WRITE(IOOUT,*) "ERROR. STOP"
108
        STOP
152
        WRITE(Line,*) "I found ", Iat," lines for the geometry instead of ",Nat
153
        Call Die("ReadInput Gaussian","Line",UNIT=IOOUT)
109 154
     END IF
155

  
156
  IF (FPBC) THEN
157
     Lat_a(1:3)=Lat(1,1:3)
158
     Lat_b(1:3)=Lat(2,1:3)
159
     Lat_c(1:3)=Lat(3,1:3)
160
     If (IPer>=1) THEN
161
        kaBeg=-1
162
        kaEnd=1
163
     END IF
164
     If (IPer>=2) THEN
165
        kbBeg=-1
166
        kbEnd=1
167
     END IF
168
     If (IPer==3) THEN
169
        kcBeg=-1
170
        kcEnd=1
171
     END IF
172
     If (IPer>3) THEN
173
        Call Die("Readinput_gaussian","Found too many Tv lines !",Unit=IOOUT)
174
     END IF
175
  END IF
176

  
177

  
110 178
     ! We now read the last part
111 179
     IF (DEBUG) WRITE(*,*) "Reading Gauss End"
112 180
     !     READ(IOIN,'(A)') Line
......
134 202
        END DO
135 203
        
136 204
        WRITE(*,*) 
137
        WRITE(*,*) 'Comment original'
205
!        WRITE(*,*) '//INFO// Comment original:'
138 206
        
139 207
        Current => Gauss_comment
140 208
        DO WHILE (ASSOCIATED(Current%next))
......
146 214
        WRITE(*,*) Trim(Gauss_charge)
147 215
        
148 216
        DO I=1,Nat
149
           WRITE(*,'(1X,A10,3(1X,F15.8),A)') Trim(AtName(I)),XyzGeomI(1,1:3,I), TRIM(Gauss_Paste(I))
217
           WRITE(*,'(1X,A10,3(1X,F15.8),1X,A)') Trim(AtName(I)),XyzGeomI(1,1:3,I), TRIM(Gauss_Paste(I))
150 218
        END DO
151 219
        
152 220
        WRITE(*,*) 

Also available in: Unified diff