3 c ###################################################
4 c ## COPYRIGHT (C) 1990 by Jay William Ponder ##
5 c ## All Rights Reserved ##
6 c ###################################################
8 c ##################################################################
10 c ## subroutine optsave -- save optimization info and results ##
12 c ##################################################################
15 c "optsave" is used by the optimizers to write imtermediate
16 c coordinates and other relevant information; also checks for
17 c user requested termination of an optimization
20 subroutine optsave (ncycle,f,xx)
55 c nothing to do if coordinate type is undefined
57 if (coordtype .eq. 'NONE') return
59 c check scaling factors for optimization parameters
61 if (.not. set_scale) then
63 if (coordtype .eq. 'CARTESIAN') then
64 if (.not. allocated(scale)) allocate (scale(3*n))
68 else if (coordtype .eq. 'INTERNAL') then
69 if (.not. allocated(scale)) allocate (scale(nomega))
76 c convert optimization parameters to atomic coordinates
78 if (coordtype .eq. 'CARTESIAN') then
83 x(i) = xx(nvar) / scale(nvar)
85 y(i) = xx(nvar) / scale(nvar)
87 z(i) = xx(nvar) / scale(nvar)
90 if (use_bounds) call bounds
91 else if (coordtype .eq. 'INTERNAL') then
93 dihed(i) = xx(i) / scale(i)
94 ztors(zline(i)) = dihed(i) * radian
98 c get name of archive or intermediate coordinates file
103 optfile = filename(1:leng)
104 call suffix (optfile,'arc','old')
105 inquire (file=optfile,exist=exist)
107 call openend (iopt,optfile)
109 open (unit=iopt,file=optfile,status='new')
113 call numeral (ncycle,ext,lext)
114 optfile = filename(1:leng)//'.'//ext(1:lext)
115 call version (optfile,'new')
116 open (unit=iopt,file=optfile,status='new')
120 call version (optfile,'old')
121 open (unit=iopt,file=optfile,status='old')
125 c update intermediate file with desired coordinate type
127 if (coordtype .eq. 'CARTESIAN') then
129 else if (coordtype .eq. 'INTERNAL') then
131 else if (coordtype .eq. 'RIGIDBODY') then
136 c save the force vector components for the current step
138 if (frcsave .and. coordtype.eq.'CARTESIAN') then
141 frcfile = filename(1:leng)
142 call suffix (frcfile,'frc','old')
143 inquire (file=frcfile,exist=exist)
145 call openend (ifrc,frcfile)
147 open (unit=ifrc,file=frcfile,status='new')
150 frcfile = filename(1:leng)//'.'//ext(1:lext)//'f'
151 call version (frcfile,'new')
152 open (unit=ifrc,file=frcfile,status='new')
154 write (ifrc,250) n,title(1:ltitle)
157 write (ifrc,260) i,name(i),(-desum(j,i),j=1,3)
158 260 format (i6,2x,a3,3x,d13.6,3x,d13.6,3x,d13.6)
161 write (iout,270) frcfile(1:trimtext(frcfile))
162 270 format (' Force Vector File',11x,a)
165 c save the current induced dipole moment at each site
167 if (uindsave .and. use_polar .and. coordtype.eq.'CARTESIAN') then
170 indfile = filename(1:leng)
171 call suffix (indfile,'uind','old')
172 inquire (file=indfile,exist=exist)
174 call openend (iind,indfile)
176 open (unit=iind,file=indfile,status='new')
179 indfile = filename(1:leng)//'.'//ext(1:lext)//'u'
180 call version (indfile,'new')
181 open (unit=iind,file=indfile,status='new')
183 write (iind,280) n,title(1:ltitle)
186 if (polarity(i) .ne. 0.0d0) then
188 write (iind,290) k,name(k),(debye*uind(j,i),j=1,3)
189 290 format (i6,2x,a3,3f12.6)
193 write (iout,300) indfile(1:trimtext(indfile))
194 300 format (' Induced Dipole File',10x,a)
197 c send data via external socket communication if desired
199 if (.not.sktstart .or. use_socket) then
200 if (coordtype .eq. 'INTERNAL') call makexyz
201 call sktopt (ncycle,f)
204 c test for requested termination of the optimization
206 endfile = 'tinker.end'
207 inquire (file=endfile,exist=exist)
208 if (.not. exist) then
209 endfile = filename(1:leng)//'.end'
210 inquire (file=endfile,exist=exist)
213 open (unit=iend,file=endfile,status='old')
214 close (unit=iend,status='delete')
219 10 format (/,' OPTSAVE -- Optimization Calculation Ending',
220 & ' due to User Request')