1
2*     *****************************
3*     *                           *
4*     *     pspw_director_init    *
5*     *                           *
6*     *****************************
7      subroutine pspw_director_init(rtdb)
8      implicit none
9      integer rtdb
10
11#include "btdb.fh"
12#include "util.fh"
13#include "stdio.fh"
14
15*     **** local variables ****
16      logical   lprint
17      integer   MASTER,taskid,l
18      parameter (MASTER=0)
19
20      character*255 filename,full_filename
21
22      logical use_director
23      common /pspw_director_common/ use_director
24
25*     **** external functions ****
26      logical  control_use_director,control_print
27      external control_use_director,control_print
28
29
30      use_director = control_use_director()
31
32      if (use_director) then
33         call Parallel_taskid(taskid)
34         if (.not.btdb_cget(rtdb,'nwpw:director_filename',
35     >                      1,filename))
36     >      call util_file_prefix('director',filename)
37            call util_file_name_noprefix(filename,.false.,.false.,
38     >                                   full_filename)
39
40          l = index(full_filename,' ') -1
41          lprint= ((taskid.eq.MASTER).and.control_print(print_medium))
42          if (lprint) write(luout,1210) full_filename(1:l)
43
44      end if
45
46 1210 FORMAT(/' pspw_director filename:',A)
47      return
48      end
49
50*     ***************************
51*     *                         *
52*     *     pspw_director       *
53*     *                         *
54*     ***************************
55*
56*  This routine initializes the director file, which
57* is used to keep track of ion positions and velocities.
58
59      subroutine pspw_director(rtdb)
60      implicit none
61      integer   rtdb
62
63#include "btdb.fh"
64#include "inp.fh"
65#include "stdio.fh"
66
67      integer   MASTER,taskid
68      parameter (MASTER=0)
69
70      logical found
71      character*50 filename
72      character*255 full_filename,line
73
74
75      logical use_director
76      common /pspw_director_common/ use_director
77
78*     **** external functions ***
79      real*8   lattice_omega
80      integer  ion_nion,control_it_out
81      external lattice_omega
82      external ion_nion,control_it_out
83
84      if (use_director) then
85
86         call Parallel_taskid(taskid)
87
88         if (.not.btdb_cget(rtdb,'nwpw:director_filename',1,filename))
89     >       call util_file_prefix('director',filename)
90
91         call util_file_name_noprefix(filename,.false.,.false.,
92     >                                full_filename)
93
94         call pspw_reset_cmd_director()
95
96         if (taskid.eq.MASTER) then
97
98            inquire(file=full_filename,exist=found)
99            if (found) then
100               open(unit=83,file=full_filename,
101     >              form='formatted',status='old')
102               do while (found)
103                  read(83,'(A)',ERR=30,END=30) line
104                  if (inp_strlen(line).gt.9)
105     >               call pspw_add_cmd_director(line)
106               end do
107   30          continue
108               close(83)
109
110               call util_file_unlink(full_filename)
111
112            end if
113         end if
114
115         call pspw_brdcst_cmd_director()
116         call pspw_run_cmd_director()
117
118      end if
119
120      return
121      end
122
123
124*     *************************************
125*     *                                   *
126*     *     pspw_reset_cmd_director       *
127*     *                                   *
128*     *************************************
129      subroutine pspw_reset_cmd_director()
130      implicit none
131
132*     **** pspw_director_lines common block ****
133      character*255 lines(10)
134      integer nlines
135      common /pspw_director_lines/ lines,nlines
136
137      nlines = 0
138      return
139      end
140
141
142*     *************************************
143*     *                                   *
144*     *      pspw_add_cmd_director        *
145*     *                                   *
146*     *************************************
147      subroutine pspw_add_cmd_director(line)
148      implicit none
149      character*(*) line
150
151*     **** pspw_director_lines common block ****
152      character*255 lines(10)
153      integer nlines
154      common /pspw_director_lines/ lines,nlines
155
156      nlines = nlines + 1
157      lines(nlines) = line
158      return
159      end
160
161
162*     *************************************
163*     *                                   *
164*     *      pspw_brdcst_cmd_director     *
165*     *                                   *
166*     *************************************
167      subroutine pspw_brdcst_cmd_director()
168      implicit none
169
170*     **** local variables ****
171      integer   MASTER,taskid
172      parameter (MASTER=0)
173
174      integer i
175
176*     **** pspw_director_lines common block ****
177      character*255 lines(10)
178      integer nlines
179      common /pspw_director_lines/ lines,nlines
180
181      call Parallel_Brdcst_ivalue(MASTER,nlines)
182      do i=1,nlines
183         call pspw_director_brdcst_string(lines(i))
184      end do
185      return
186      end
187
188
189
190
191*     *************************************
192*     *                                   *
193*     *      pspw_run_cmd_director        *
194*     *                                   *
195*     *************************************
196      subroutine pspw_run_cmd_director()
197      implicit none
198
199#include "bafdecls.fh"
200#include "inp.fh"
201
202*     **** local variables ****
203      integer MASTER,taskid
204      parameter (MASTER=0)
205
206      logical found
207      integer indx,indx2,ll1,ll2,i,ind,ii
208      integer r0_ptr,r1_ptr,r2_ptr,v2_ptr,nion
209
210      character*255 filename,cmd
211
212*     **** pspw_director_lines common block ****
213      character*255 lines(10)
214      integer nlines
215      common /pspw_director_lines/ lines,nlines
216
217*     **** external functions ****
218      integer  ion_nion,ion_rion_indx_ptr
219      external ion_nion,ion_rion_indx_ptr
220      real*8   ion_rion2,ion_rion,ion_vion
221      external ion_rion2,ion_rion,ion_vion
222
223      call Parallel_taskid(taskid)
224
225      do i=1,nlines
226         filename = ''
227         cmd = ''
228
229         filename = lines(i)
230         indx     = index(filename," ")
231         filename = filename(indx+1:)
232
233         if (inp_strlen(filename).gt.3) then
234            do while (filename(1:1).eq.' ')
235               filename = filename(2:)
236            end do
237
238            indx2 = index(filename," ")
239            cmd      = filename(indx2+1:)
240            filename = filename(:indx2-1)
241            ll1 = inp_strlen(filename)
242            ll2 = inp_strlen(cmd)
243
244            if (inp_contains(.false.,"writestatus",lines(i),ind)) then
245
246              if (taskid.eq.MASTER) then
247                 write(*,*) "add_cmd_director: writestatus "
248     >                      //filename(1:ll1)
249
250                 open(unit=82,file=filename(1:ll1),
251     >                action='write',position='append')
252                 write(82,'(A)') cmd(1:ll2)
253                 close(82)
254              end if
255
256            else if (inp_contains(.false.,"loadmovecs",
257     >               lines(i),ind)) then
258               if (taskid.eq.MASTER) then
259                  write(*,*) "add_cmd_director: loadmovecs "
260     >                       //filename(1:ll1)
261               end if
262               call psi_tmp_read_full_filename(filename)
263
264            else if (inp_contains(.false.,"savemovecs",
265     >               lines(i),ind)) then
266               if (taskid.eq.MASTER) then
267                  write(*,*) "add_cmd_director: savemovecs "
268     >                       //filename(1:ll1)
269               end if
270               call psi_tmp_write_full_filename(filename)
271
272            else if (inp_contains(.false.,"loadgeometry",
273     >                            lines(i),ind)) then
274               r0_ptr = ion_rion_indx_ptr(0)
275               r1_ptr = ion_rion_indx_ptr(1)
276               r2_ptr = ion_rion_indx_ptr(2)
277               v2_ptr = ion_rion_indx_ptr(3)
278               nion   = ion_nion()
279               if (taskid.eq.MASTER) then
280                  write(*,*) "add_cmd_director: loadgeometry "
281     >                       //filename(1:ll1)
282                  inquire(file=filename(1:ll1),exist=found)
283                  if (found) then
284                     open(unit=83,file=filename(1:ll1),
285     >                    action='read',status='old')
286                     do ii=1,nion
287                        read(83,*) dbl_mb(r2_ptr+3*(ii-1)),
288     >                             dbl_mb(r2_ptr+3*(ii-1)+1),
289     >                             dbl_mb(r2_ptr+3*(ii-1)+2),
290     >                             dbl_mb(r1_ptr+3*(ii-1)),
291     >                             dbl_mb(r1_ptr+3*(ii-1)+1),
292     >                             dbl_mb(r1_ptr+3*(ii-1)+2),
293     >                             dbl_mb(r0_ptr+3*(ii-1)),
294     >                             dbl_mb(r0_ptr+3*(ii-1)+1),
295     >                             dbl_mb(r0_ptr+3*(ii-1)+2),
296     >                             dbl_mb(v2_ptr+3*(ii-1)),
297     >                             dbl_mb(v2_ptr+3*(ii-1)+1),
298     >                             dbl_mb(v2_ptr+3*(ii-1)+2)
299                     end do
300                     close(83)
301                     call util_file_unlink(filename(1:ll1))
302                  end if
303               end if
304               call Parallel_Brdcst_values(MASTER,3*nion,dbl_mb(r2_ptr))
305               call Parallel_Brdcst_values(MASTER,3*nion,dbl_mb(r1_ptr))
306               call Parallel_Brdcst_values(MASTER,3*nion,dbl_mb(r0_ptr))
307               call Parallel_Brdcst_values(MASTER,3*nion,dbl_mb(v2_ptr))
308
309               call Nose_zero_thermostats()
310
311
312            else if (inp_contains(.false.,"savegeometry",
313     >               lines(i),ind)) then
314               r0_ptr = ion_rion_indx_ptr(0)
315               r1_ptr = ion_rion_indx_ptr(1)
316               r2_ptr = ion_rion_indx_ptr(2)
317               v2_ptr = ion_rion_indx_ptr(3)
318               nion   = ion_nion()
319               if (taskid.eq.MASTER) then
320                  write(*,*) "add_cmd_director: savegeometry "
321     >                       //filename(1:ll1)
322                  call util_file_unlink(filename(1:ll1))
323                  open(unit=82,file=filename(1:ll1),
324     >                 action='write',status='new')
325                  do ii=1,nion
326                     write(82,'(12E24.15)') dbl_mb(r2_ptr+3*(ii-1)),
327     >                                     dbl_mb(r2_ptr+3*(ii-1)+1),
328     >                                     dbl_mb(r2_ptr+3*(ii-1)+2),
329     >                                     dbl_mb(r1_ptr+3*(ii-1)),
330     >                                     dbl_mb(r1_ptr+3*(ii-1)+1),
331     >                                     dbl_mb(r1_ptr+3*(ii-1)+2),
332     >                                     dbl_mb(r0_ptr+3*(ii-1)),
333     >                                     dbl_mb(r0_ptr+3*(ii-1)+1),
334     >                                     dbl_mb(r0_ptr+3*(ii-1)+2),
335     >                                     dbl_mb(v2_ptr+3*(ii-1)),
336     >                                     dbl_mb(v2_ptr+3*(ii-1)+1),
337     >                                     dbl_mb(v2_ptr+3*(ii-1)+2)
338                  end do
339                  close(82)
340               end if
341
342            end if
343         end if
344
345      end do
346
347      return
348      end
349
350
351*     *************************************
352*     *                                   *
353*     *    pspw_director_brdcst_string    *
354*     *                                   *
355*     *************************************
356      subroutine pspw_director_brdcst_string(mystring)
357      implicit none
358      character*(*) mystring
359
360#include "inp.fh"
361
362      integer   MASTER,taskid
363      parameter (MASTER=0)
364
365      integer istring(255),ilen,i
366      character*255 tmpstring
367
368      call Parallel_taskid(taskid)
369
370      if (taskid.eq.MASTER) then
371         ilen = inp_strlen(mystring)
372         do i=1,ilen
373            istring(i) = ichar(mystring(i:i))
374         end do
375      end if
376      call Parallel_Brdcst_ivalue(MASTER,ilen)
377      call Parallel_Brdcst_ivalues(MASTER,ilen,istring)
378      tmpstring = ''
379      do i=1,ilen
380         tmpstring(i:i) = char(istring(i))
381      end do
382      mystring = tmpstring
383
384      return
385      end
386
387