1      logical function argos_prepare_wrtrst(lfnout,lfnrst,filrst,title,
2     + npbtyp,nbxtyp,box,
3     + iwmr,xw,vw,mwm,mwa,nwm,nwa,iwmrc,xwc,vwc,mwmc,nwmc,
4     + isar,isgm,xs,vs,msa,nsa,msm,nsm,irrep,nxrep,nyrep,nzrep,
5     + mseq,nseq,lseq,ips,istat,lfnmod,filmod,itopol)
6c
7c $Id$
8c
9      implicit none
10c
11#include "util.fh"
12c
13      logical argos_prepare_ssize,argos_prepare_rstmod
14      external argos_prepare_ssize,argos_prepare_rstmod
15c
16      integer lfnout,lfnrst
17      integer mwm,mwa,nwm,nwa,msa,nsa,msm,nsm,mwmc,nwmc,mseq,nseq
18      integer npbtyp,nbxtyp,irrep,nxrep,nyrep,nzrep
19      character*255 filrst,filmod
20      character*80 title(2,3)
21      real*8 xw(3,mwa,mwm),xs(3,msa),vw(3,mwa,mwm),vs(3,msa),box(3)
22      real*8 xwc(3,mwa,mwmc),vwc(3,mwa,mwmc)
23      integer iwmrc(mwmc),iwmr(mwm),isar(msa),isgm(msa),lseq(mseq)
24      integer ips(msa),istat(msa),lfnmod,itopol
25c
26      integer i,j,k,length,ixrep,iyrep,izrep,nrep,idhop
27      real*8 orep(3),rsgm
28      character*10 rstdat,rsttim
29c
30c     process modifications
31c
32      if(.not.argos_prepare_rstmod(lseq,mseq,nseq,lfnmod,filmod,lfnout))
33     + call md_abort('argos_prepare_rstmod failed',9999)
34c
35      if(itopol.eq.3) then
36      do 111 i=1,nsa
37      idhop=2**(lseq(isgm(i))-1)
38      if(iand(istat(i),idhop).eq.0) ips(i)=-ips(i)
39c      write(*,'(a,5i5)') 'wrtrst ',i,isgm(i),lseq(isgm(i)),istat(i),
40c     + ips(i)
41  111 continue
42      else
43      do 112 i=1,nsa
44      ips(i)=0
45  112 continue
46      endif
47c
48      if(.not.argos_prepare_ssize(isgm,xs,msa,nsa,rsgm))
49     + call md_abort('argos_prepare_ssize failed',9999)
50c
51c     open the restart file
52c     ---------------------
53c
54      length=index(filrst,' ')-1
55      open(unit=lfnrst,file=filrst(1:length),form='formatted',
56     + status='unknown',err=9999)
57c
58      call swatch(rstdat,rsttim)
59c
60      if(npbtyp.eq.0) then
61      if(box(1).lt.1.0e-6) box(1)=max(box(1),box(2),box(3))
62      if(box(2).lt.1.0e-6) box(2)=max(box(1),box(2),box(3))
63      if(box(3).lt.1.0e-6) box(3)=max(box(1),box(2),box(3))
64      endif
65c
66      if(irrep.eq.0) then
67      orep(1)=0.0d0
68      orep(2)=0.0d0
69      orep(3)=0.0d0
70      nxrep=1
71      nyrep=1
72      nzrep=1
73      nrep=1
74      else
75      nrep=nxrep*nyrep*nzrep
76      endif
77c
78      write(lfnrst,1001) (title(2,i),i=1,3),4.6,rstdat,rsttim,0,.false.
79 1001 format(a,/,a,/,a,/,f12.6,2a10,i5,4x,l1)
80      write(lfnrst,1002) npbtyp,nbxtyp,rsgm,
81     + dble(nxrep)*box(1),0.0d0,0.0d0,
82     + 0.0d0,dble(nyrep)*box(2),0.0d0,
83     + 0.0d0,0.0d0,dble(nzrep)*box(3)
84 1002 format(2i5,f12.6,/,(3f12.6))
85      write(lfnrst,1003) 0.0d0
86 1003 format(e12.5)
87      write(lfnrst,1004) 0.0d0,0.0d0,0.0d0
88 1004 format(3f12.6)
89c
90c     dimensions on the restart file
91c
92c     1 i10 nwm   number of solvent molecules
93c     2 i10 nwa   number of atoms per solvent molecule
94c     3 i10 nsm   number of solute molecules
95c     4 i10 nsa   number of solute atoms
96c     5 i10 nwmc  number of crystal solvent molecules
97c     6 i10 nsf   number of solute fractions
98c     7 i10 nss   number of solute segments
99c     8 i5  nprev number of processors used in previous job
100c     9 i5  noe   number of noe constraints
101c
102c
103      write(lfnrst,1005) nrep*(nwmc+nwm),nwa,
104     + nrep*nsm,nrep*nsa,nrep*nwmc,0,nrep*nseq,0,0
105 1005 format(7i10,2i5)
106c
107c     check wich version
108c
109      if(nwm+nwmc.gt.0) then
110      if(nwmc.gt.0) then
111      do 101 izrep=1,nzrep
112      do 102 iyrep=1,nyrep
113      do 103 ixrep=1,nxrep
114      if(irrep.gt.0) then
115      orep(1)=0.5d0*dble(2*ixrep-nxrep-1)*box(1)
116      orep(2)=0.5d0*dble(2*iyrep-nyrep-1)*box(2)
117      orep(3)=0.5d0*dble(2*izrep-nzrep-1)*box(3)
118      endif
119      do 1 i=1,nwmc
120      write(lfnrst,1006) ((xwc(k,j,i)+orep(k),k=1,3),
121     + (vwc(k,j,i),k=1,3),j=1,nwa)
122 1006 format(2x,6f13.8)
123      write(lfnrst,1007) iwmrc(i),(0.0d0,k=1,3)
124 1007 format(i1,1x,3f13.8)
125    1 continue
126  103 continue
127  102 continue
128  101 continue
129      endif
130      do 201 izrep=1,nzrep
131      do 202 iyrep=1,nyrep
132      do 203 ixrep=1,nxrep
133      if(irrep.gt.0) then
134      orep(1)=0.5d0*dble(2*ixrep-nxrep-1)*box(1)
135      orep(2)=0.5d0*dble(2*iyrep-nyrep-1)*box(2)
136      orep(3)=0.5d0*dble(2*izrep-nzrep-1)*box(3)
137      endif
138      do 2 i=1,nwm
139      write(lfnrst,1006) ((xw(k,j,i)+orep(k),k=1,3),
140     + (vw(k,j,i),k=1,3),j=1,nwa)
141      write(lfnrst,1007) iwmr(i),(0.0d0,k=1,3)
142    2 continue
143  203 continue
144  202 continue
145  201 continue
146      endif
147      if(nsa.gt.0) then
148      do 301 izrep=1,nzrep
149      do 302 iyrep=1,nyrep
150      do 303 ixrep=1,nxrep
151      if(irrep.gt.0) then
152      orep(1)=0.5d0*dble(2*ixrep-nxrep-1)*box(1)
153      orep(2)=0.5d0*dble(2*iyrep-nyrep-1)*box(2)
154      orep(3)=0.5d0*dble(2*izrep-nzrep-1)*box(3)
155      endif
156      write(lfnrst,1008)
157     + (isar(i),(xs(k,i)+orep(k),k=1,3),(vs(k,i),k=1,3),ips(i),i=1,nsa)
158 1008 format(i1,1x,6f13.8,i5)
159  303 continue
160  302 continue
161  301 continue
162      endif
163c
164      if(nsm.gt.0) then
165      write(lfnrst,1011) ((0.0d0,k=1,3),i=1,nrep*nsm)
166 1011 format(2x,3f13.8)
167      endif
168c
169      if(nseq.gt.0) then
170      write(lfnrst,1012) ((lseq(i),i=1,nseq),j=1,nrep)
171 1012 format(20i3)
172      endif
173c
174      close(unit=lfnrst)
175c
176      if(util_print('files',print_default)) then
177      write(lfnout,2000) filrst(1:length)
178 2000 format(/,' Created restart',t40,a,/)
179      endif
180c
181      argos_prepare_wrtrst=.true.
182      return
183c
184 9999 continue
185      argos_prepare_wrtrst=.false.
186      return
187      end
188