ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/group/trunk/nano_mpi/src/init_system.F90
Revision: 5
Committed: Mon Jun 10 19:31:27 2002 UTC (22 years ago) by pconfort
File size: 24885 byte(s)
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 chuckv 4 !--------------------------------------------------------------------
2     ! Module INIT_SYSTEM
3     ! Initializes and builds system if necessary
4     ! Author: Charles F. Vardeman II and J. Daniel Gezelter
5     !--------------------------------------------------------------------
6    
7    
8     module init_simulation
9     use definitions, ONLY : DP, machdep_lnblnk
10     use parameter
11     use simulation
12     use sprng_mod, ONLY : get_random_sprng
13     use model_module
14     use status, ONLY: error,info, warning
15     #ifdef MPI
16     use mpi_module
17     #endif
18     implicit none
19     PRIVATE
20    
21     public :: nano_build_system
22    
23     integer :: nsolute
24     integer :: nsolvent
25     integer :: ncore
26     integer :: nshell
27     integer :: n_vacancy
28     real( kind = DP ) :: solvent_x
29     real( kind = DP ), parameter :: rhoconv = 1.661E0_DP
30    
31     type :: unit_cell
32     private
33     real( kind = DP ), dimension(4) :: sx,sy,sz
34     real( kind = DP ), dimension(4) :: s_ex,s_ey,s_ez
35     integer :: number_of_cells
36     real( kind = DP ) :: cell_length
37     end type unit_cell
38    
39    
40    
41    
42     contains
43    
44     ! inteface to module, builds the right system
45     subroutine nano_build_system(assign_positions)
46     type (unit_cell) :: system_cell
47     logical, intent(in) :: assign_positions
48     integer :: n_interface
49     ! integer :: n_vacancy
50     logical :: found
51     logical :: random_cluster
52     logical, allocatable, dimension(:) :: vacancy
53     real( kind = DP ),parameter :: small_number = 1.0d-6
54     real( kind = DP ) :: dbl_n_interface
55     real( kind = DP ) :: junk
56     real( kind = DP ) :: scale
57     character(len=80) :: msg
58     integer :: i
59     integer :: tester
60     integer :: orig_nmol
61     #ifndef MPI
62     integer, parameter :: node = 0
63     #endif
64    
65     random_cluster = .false.
66    
67    
68    
69    
70     call build_fcc_unit_cell(system_cell)
71    
72     call get_nmol(system_cell,nmol,n_interface)
73    
74    
75     !! generate vacancy if necessary
76     dbl_n_interface = real(n_interface,KIND(DP))
77     if (sim_type == 'liquid') then
78     n_vacancy = 0
79     else
80     n_vacancy = idint(dbl_n_interface * vacancy_fraction)
81     endif
82    
83     if (n_vacancy /= 0) then
84     allocate(vacancy(n_interface))
85     do i = 1, n_interface
86     vacancy(i) = .false.
87     enddo
88    
89     do i = 1, n_vacancy
90     found = .false.
91     gen_vacancy: do
92     if (found) exit gen_vacancy
93    
94     tester = 1 + idint(dbl_n_interface*get_random_sprng())
95    
96     if (.not.vacancy(tester)) then
97     vacancy(tester) = .true.
98     found = .true.
99     end if
100     end do gen_vacancy
101     end do
102     orig_nmol = nmol
103     nmol = nmol - n_vacancy
104     end if
105    
106    
107     #ifdef MPI
108     call setup_parallel_mol(nmol)
109     call allocate_nmol_arrays(maxmol_local)
110     #else
111     call allocate_nmol_arrays(nmol)
112     nmol_local = nmol
113     #endif
114    
115    
116     if (sim_type == 'liquid' .OR. &
117     dabs(r_shell-r_core).lt.small_number) then
118     call generate_model()
119     random_cluster = .true.
120     elseif (n_vacancy /= 0) then
121     call generate_model(this_cell=system_cell,vacancy = vacancy)
122     else
123     call generate_model(this_cell=system_cell)
124     endif
125    
126     !! set box length
127     if (sim_type == "liquid") then
128     scale = (total_mass*rhoconv/density)**(1.0E0_DP/3.0E0_DP)
129     box(1) = scale
130     box(2) = scale
131     box(3) = scale
132     else !! For cluster box length is set to 1, wrap handles
133     !! selecting the right pbc.
134     box(1) = 1
135     box(2) = 1
136     box(3) = 1
137     endif
138    
139     if (assign_positions) then
140     if (n_vacancy /= 0) then
141     call build_positions(system_cell,vacancy=vacancy)
142     else
143     call build_positions(system_cell)
144     end if
145     endif
146    
147     !! write out what we just did....
148     if (assign_positions) then
149     call info("BUILD_SYSTEM", &
150     "Built new system with the following...")
151     else
152     call info("BUILD_SYSTEM", &
153     "Initialized system with the following...")
154     endif
155     #ifdef MPI
156     call info("BUILD_SYSTEM", &
157     "MPI parallel calculations")
158     #endif
159     write(msg,'(a18,i11)') '# nmol = ', nmol
160     call info("BUILD_SYSTEM",trim(msg))
161     write(msg,'(a18,i11)') '# natoms = ', natoms
162     call info("BUILD_SYSTEM",trim(msg))
163     write(msg,'(a18,es12.3,a10)') 'lattice spacing = ', system_cell%cell_length, &
164     " angstroms"
165     call info("BUILD_SYSTEM",trim(msg))
166    
167     select case (sim_type)
168     case ("cluster")
169     call info("BUILD_SYSTEM","Built cluster with the following")
170     write(msg,'(a8,i11,a24)') '# using ', 2*system_cell%number_of_cells + 1, &
171     ' cells in each direction'
172     call info('BUILD_SYSTEM',trim(msg))
173     write(msg,'(a18,f6.2,a12)') "Particle radius: ", r_shell, " Angstroms."
174     call info('BUILD_SYSTEM',trim(msg))
175     if(random_cluster) then
176     call info("BUILD_SYSTEM","Generated random cluster with: ")
177     write(msg,'(a13,i11)') '# nsolute = ', nsolute
178     call info("BUILD_SYSTEM",trim(msg))
179     write(msg,'(a13,i11)') '# nsolvent = ', nsolvent
180     call info("BUILD_SYSTEM",trim(msg))
181     else
182     call info("BUILD_SYSTEM","Generated core-shell particle with: ")
183     write(msg,'(a13,f6.2,a12)') "Core radius: ", r_core, " Angstroms"
184     call info('BUILD_SYSTEM',trim(msg))
185     write(msg,'(a11,i11)') '# ncore = ', ncore
186     call info('BUILD_SYSTEM',trim(msg))
187     write(msg,'(a11,i11)') '# nshell = ', nshell
188     call info('BUILD_SYSTEM',trim(msg))
189     endif
190     if (n_vacancy /= 0) then
191     call info("BUILD_SYSTEM","Generated Vacancies with: ")
192     write(msg,*) "# mol origonal = ", orig_nmol
193     call info("BUILD_SYSTEM",trim(msg))
194     write(msg,'(a21,f6.2,a1)') "A vacancy percent of: ", vacancy_fraction*100,"%"
195     call info("BUILD_SYSTEM",trim(msg))
196     write(msg,'(a21,f6.2,a31)') "A vacancy radius of: ", vacancy_radius, &
197     " angstroms from the interface."
198     call info("BUILD_SYSTEM",trim(msg))
199     write(msg,*) "Total # of atoms at interface: ", n_interface
200     call info("BUILD_SYSTEM",trim(msg))
201     write(msg,'(a14,i5,a25)') "Resulting in: ", n_vacancy, &
202     " particles being removed."
203     call info("BUILD_SYSTEM",trim(msg))
204    
205     end if
206     case("liquid")
207     call info("BUILD_SYSTEM","Generated liquid with the following: ")
208     write(msg,'(a13,i11)') '# nsolute = ', nsolute
209     call info("BUILD_SYSTEM",trim(msg))
210     write(msg,'(a13,i11)') '# nsolvent = ', nsolvent
211     call info("BUILD_SYSTEM",trim(msg))
212     call info("BUILD_SYSTEM","Periodic Boundary Conditions")
213     write(msg,'(a11,es30.16)') 'boxX = ', box(1)
214     call info("BUILD_SYSTEM",trim(msg))
215     write(msg,'(a11,es30.16)') 'boxY = ', box(2)
216     call info("BUILD_SYSTEM",trim(msg))
217     write(msg,'(a11,es30.16)') 'boxZ = ', box(3)
218     call info("BUILD_SYSTEM",trim(msg))
219     write(msg,'(a12,es30.16)') 'total_mass = ', total_mass
220     call info("BUILD_SYSTEM",trim(msg))
221     write(msg,'(a12,es30.16)') 'rhoconv = ', rhoconv
222     call info("BUILD_SYSTEM",trim(msg))
223    
224     junk = total_mass*rhoconv/(box(1)*box(2)*box(3))
225     write(msg,'(a11,es12.3)') 'density = ', junk
226     call info('BUILD_SYSTEM',trim(msg))
227     junk = dble(nmol)/(box(1)*box(2)*box(3))
228     write(msg,'(a11,es12.3)') 'ndensity = ', junk
229     call info('BUILD_SYSTEM',trim(msg))
230     end select
231    
232     if (allocated(vacancy)) &
233     deallocate(vacancy)
234     #ifdef MPI
235     call allocate_mpi_arrays(max_local)
236     #endif
237     end subroutine nano_build_system
238    
239    
240    
241    
242    
243     !-----------------Utility subroutines----------------------
244    
245     !builds FCC unit cell
246     subroutine build_fcc_unit_cell(this_cell)
247     type (unit_cell), intent(out) :: this_cell
248    
249     real( kind = DP ) :: cell2, rroot3
250    
251    
252     call info("INIT_SYSTEM", "Creating unit cell ...")
253     select case(sim_type)
254     case ("cluster")
255     this_cell%cell_length = cell
256     this_cell%number_of_cells = &
257     2.0E0_DP*r_shell/this_cell%cell_length
258     case ("liquid")
259     this_cell%number_of_cells = ncells
260     this_cell%cell_length = &
261     1.0E0_DP / real(this_cell%number_of_cells,KIND(DP))
262     end select
263    
264     cell2 = 0.5E0_DP * this_cell%cell_length
265     rroot3 = 1.0E0_DP/ dsqrt(3.0E0_DP)
266    
267    
268     ! molecule 1
269    
270     this_cell%sx(1) = 0.0E0_DP
271     this_cell%sy(1) = 0.0E0_DP
272     this_cell%sz(1) = 0.0E0_DP
273     this_cell%s_ex(1) = RROOT3
274     this_cell%s_ey(1) = RROOT3
275     this_cell%s_ez(1) = RROOT3
276    
277     ! molecule 3
278    
279     this_cell%sx(3) = cell2
280     this_cell%sy(3) = cell2
281     this_cell%sz(3) = 0.0E0_DP
282     this_cell%s_ex(3) = RROOT3
283     this_cell%s_ey(3) = -RROOT3
284     this_cell%s_ez(3) = -RROOT3
285    
286     ! molecule 2
287    
288     this_cell%sx(2) = 0.0E0_DP
289     this_cell%sy(2) = cell2
290     this_cell%sz(2) = cell2
291     this_cell%s_ex(2) = -RROOT3
292     this_cell%s_ey(2) = RROOT3
293     this_cell%s_ez(2) = -RROOT3
294    
295     ! molecule 4
296    
297     this_cell%sx(4) = cell2
298     this_cell%sy(4) = 0.0E0_DP
299     this_cell%sz(4) = cell2
300     this_cell%s_ex(4) = -RROOT3
301     this_cell%s_ey(4) = -RROOT3
302     this_cell%s_ez(4) = RROOT3
303    
304    
305    
306    
307    
308     end subroutine build_fcc_unit_cell
309    
310     !! Subroutine counts or calculates the number of molecules in
311     !! this simulation.
312     subroutine get_nmol(this_cell,number_of_molecules, number_at_interface)
313     ! argument declarations
314     type (unit_cell), intent(in) :: this_cell
315     integer, intent(out) :: number_of_molecules
316     integer, intent(out) :: number_at_interface
317    
318     ! integers
319     integer :: ix, iy, iz !cell indexes
320     integer :: iref
321     integer :: number_in_lattice
322     ! reals
323     integer :: nc
324     real( kind = DP ) :: rx,ry,rz
325     real( kind = DP ) :: dist
326    
327     !! r_core = core radius in declared in parameter_mod
328     !! r_shell = shell radius in declared in parameter_mod
329     !! vacancy_radius = radius arround interface to create vacancies
330    
331     number_of_molecules = 0
332     number_at_interface = 0
333     number_in_lattice = 0
334    
335     select case (sim_type)
336     case ('liquid')
337     number_of_molecules = 4 * &
338     this_cell%number_of_cells* &
339     this_cell%number_of_cells* &
340     this_cell%number_of_cells
341     case ('cluster')
342     nc = this_cell%number_of_cells
343     do iz = -nc, nc, 1
344     do iy = -nc, nc, 1
345     do ix = -nc, nc, 1
346     do iref = 1, 4
347     number_in_lattice = &
348     number_in_lattice + 1
349     rx = this_cell%sx(iref) + this_cell%cell_length &
350     * (dble( ix ) - 0.5E0_DP)
351     ry = this_cell%sy(iref) + this_cell%cell_length &
352     * (dble( iy ) - 0.5E0_DP)
353     rz = this_cell%sz(iref) + this_cell%cell_length &
354     * (dble( iz ) - 0.5E0_DP)
355     dist = dsqrt(rx*rx + ry*ry + rz*rz)
356     if (dist.le.r_shell) then
357     number_of_molecules = &
358     number_of_molecules + 1
359     endif
360     if ((dist.ge.r_core-vacancy_radius/2.0E0_DP).and. &
361     (dist.le.r_core+vacancy_radius/2.0E0_DP)) then
362     number_at_interface = &
363     number_at_interface + 1
364     endif
365     end do
366     end do
367     end do
368     end do
369     end select
370     end subroutine get_nmol
371    
372    
373     subroutine generate_model(this_cell,vacancy)
374    
375     ! Arguments!
376     !! optional -- only if generating cluster
377     type (unit_cell), intent(in), optional :: this_cell
378     logical,intent(in), dimension(:), optional :: vacancy
379     !arrays
380     character(len=10), allocatable, dimension(:) :: model_tmp
381     ! real variables
382     real( kind = DP ) :: dist
383     real( kind = DP ) :: rx,ry,rz
384     real( kind = DP ) :: mtot_local
385     ! integers counters
386     integer :: i, ntmp,j
387     integer :: tester
388     integer :: atom_count
389     integer :: ncount
390     logical :: record_start
391     integer :: ix,iy,iz
392     integer :: iref
393     integer :: nc
394     integer :: iinterface
395     integer :: atom
396     character(len=10) :: this_model
397     integer :: this_atype
398     logical :: found
399    
400    
401     #ifndef MPI
402     integer :: nmol_local
403     #endif
404     record_start = .true.
405     allocate (model_tmp(nmol))
406    
407    
408     !! this_cell is the unit cell which we only need to
409     !! build the model for the core-shell cluster
410     !! else we build a random model....
411     if (.not. present(this_cell)) then
412     call info('GENERATE_RANDOM_MODEL', &
413     'Generating random configuration....')
414     !! check for problems with cluster model
415    
416     if (sim_type == 'cluster') then
417     if (core_model /= solute_model .AND. &
418     shell_model /= solvent_model) then
419     call error('GENERATE_RANDOM_MODEL', &
420     'Cluster models and Solvent Models are different')
421     end if
422     end if
423    
424     nsolute = idint(solute_x*dble(nmol))
425     nsolvent = nmol - nsolute
426     solute_x = dble(nsolute)/dble(nmol)
427     solvent_x = 1.0E0_DP - solute_x
428    
429    
430    
431    
432     do i = 1, nmol
433     model_tmp(i) = solvent_model
434     enddo
435    
436    
437     if (solvent_model /= solute_model) then
438     do i = 1, nsolute
439     found = .false.
440     do
441     if (found) exit
442     tester = 1+idint(dble(nmol)*get_random_sprng())
443    
444     if (model_tmp(tester).ne.solute_model) then
445     model_tmp(tester) = solute_model
446     found = .true.
447     endif
448     end do
449     enddo
450     endif
451    
452    
453     ntmp = 0
454     nlocal = 0
455     atom_count = 0
456    
457     do i = 1, nmol
458     atom_count = atom_count + &
459     model_na(model_tmp(i))
460     #ifdef MPI
461     if (i.ge.nmol_start.and. &
462     i.le.nmol_end) then
463     ntmp = i - nmol_start + 1
464     #else
465     ntmp = i
466     #endif
467     model(ntmp) = model_tmp(i)
468     na(ntmp) = model_na(model(ntmp))
469     #ifdef MPI
470     if (record_start) then
471     nstart = atom_count - na(ntmp) + 1
472     record_start = .false.
473     end if
474     #endif
475    
476     do j = 1,na(ntmp)
477     nlocal = nlocal + 1
478     atom_index(ntmp,j) = nlocal
479     end do
480     #ifdef MPI
481     endif
482     #endif
483     end do
484    
485     else ! generate core-shell cluster
486     call info("GENERATE_MODEL","Generating Cluster Model ...")
487     ncount = 0
488     ntmp = 0
489     atom_count = 0
490     ncore = 0
491     nshell = 0
492     iinterface = 0
493     nlocal = 0
494     nc = this_cell%number_of_cells
495     do iz = -nc, nc, 1
496     do iy = -nc, nc, 1
497     do ix = -nc, nc, 1
498     do iref = 1, 4
499    
500     rx = this_cell%sx(iref) + &
501     this_cell%cell_length * (dble( ix ) - 0.5E0_DP)
502     ry = this_cell%sy(iref) + &
503     this_cell%cell_length * (dble( iy ) - 0.5E0_DP)
504     rz = this_cell%sz(iref) + &
505     this_cell%cell_length * (dble( iz ) - 0.5E0_DP)
506    
507     dist = dsqrt(rx*rx + ry*ry + rz*rz)
508    
509    
510     if ((present(vacancy)).and. &
511     (dist.ge.r_core-vacancy_radius/2.0E0_DP).and. &
512     (dist.le.r_core+vacancy_radius/2.0E0_DP)) then
513    
514     iinterface = iinterface + 1
515     if (.not.vacancy(iinterface)) then
516    
517    
518     if (dist.le.r_shell) then
519     ncount = ncount + 1
520     if (dist.le.r_core) then
521     model_tmp(ncount) = core_model
522     ncore = ncore + 1
523     else
524     model_tmp(ncount) = shell_model
525     nshell = nshell + 1
526     endif
527     atom_count = atom_count + &
528     model_na(model_tmp(ncount))
529     #ifdef MPI
530     if (ncount.ge.nmol_start.and. &
531     ncount.le.nmol_end) then
532     ntmp = ncount - nmol_start + 1
533     #else
534     ntmp = ncount
535     #endif
536    
537     model(ntmp) = model_tmp(ncount)
538     na(ntmp) = model_na(model(ntmp))
539     #ifdef MPI
540     if (record_start) then
541     nstart = atom_count - na(ntmp) + 1
542     record_start = .false.
543     end if
544     #endif
545    
546     do j = 1, na(ntmp)
547     nlocal = nlocal + 1
548     atom_index(ntmp,j) = nlocal
549     enddo
550     #ifdef MPI
551     endif
552     #endif
553     endif
554    
555     endif ! end vacancy(iinterface)
556     else ! build core-shell with all particles
557     if (dist.le.r_shell) then
558     ncount = ncount + 1
559    
560    
561     if (dist.le.r_core) then
562     model_tmp(ncount) = core_model
563     ncore = ncore + 1
564     else
565     model_tmp(ncount) = shell_model
566     nshell = nshell + 1
567     endif
568    
569     atom_count = atom_count + &
570     model_na(model_tmp(ncount))
571     #ifdef MPI
572     if (ncount.ge.nmol_start.and. &
573     ncount.le.nmol_end) then
574     ntmp = ncount - nmol_start + 1
575     #else
576     ntmp = ncount
577     #endif
578     model(ntmp) = model_tmp(ncount)
579     na(ntmp) = model_na(model(ntmp))
580    
581     #ifdef MPI
582     if (record_start) then
583     nstart = atom_count - na(ntmp) + 1
584     record_start = .false.
585     end if
586     #endif
587     do j = 1, na(ntmp)
588     nlocal = nlocal + 1
589     atom_index(ntmp,j) = nlocal
590     enddo
591     #ifdef MPI
592     endif
593     #endif
594     endif
595     endif !! end present(vacancy)
596     end do
597     end do
598     end do
599     end do
600     endif
601    
602    
603    
604     natoms = atom_count
605    
606     mtot_local = 0.0E0_DP
607     total_mass = 0.0E0_DP
608    
609     do i = 1, nmol
610     this_model = model_tmp(i)
611     do j = 1,model_na(this_model)
612     this_atype = model_atype(this_model,j)
613     total_mass = total_mass + atype_mass(this_atype)
614     end do
615     end do
616    
617     deallocate(model_tmp)
618    
619    
620     #ifndef MPI
621     nmol_local = nmol
622     #endif
623    
624     #ifdef MPI
625     call setup_parallel_mpi()
626     call allocate_simulation(max_local,ncol)
627     #else
628     nlocal = natoms
629     call allocate_simulation(natoms)
630    
631     #endif
632    
633     !! build ident and mass arrays
634     do i = 1,nmol_local
635     do j = 1, na(i)
636     atom = atom_index(i,j)
637     ident(atom) = model_atype(model(i), j)
638     mass(atom) = atype_mass(ident(atom))
639     mass_local = mass_local + mass(atom)
640    
641     end do
642     end do
643    
644     ! 2-6-2002 Total mass is now calculated on each node to reduce
645     ! summation error
646     !#ifdef MPI
647     ! call mpi_allreduce(mtot_local,total_mass,1,mpi_double_precision, &
648     ! mpi_sum,mpi_comm_world,mpi_err)
649     !#else
650     ! total_mass = mtot_local
651     !#endif
652    
653    
654    
655     end subroutine generate_model
656     subroutine build_positions(this_cell,vacancy)
657     use file_units, ONLY : next_unit
658     logical, intent(in),dimension(:), optional :: vacancy
659     type (unit_cell), intent(in) :: this_cell
660     integer :: ntemp,ncount,nc
661     integer :: ix,iy,iz
662     integer :: start_index
663     integer :: ntmp
664     integer :: iinterface
665     integer :: iref
666     integer :: vac_unit
667     integer :: unit
668     character(len=*), parameter :: xyz_coord = "(a3,3es12.4)"
669     character(len = 80) :: file
670     character(len = 80) :: vac_file
671     real( kind = DP ) :: scale
672     real( kind = DP ) :: rx,ry,rz
673     real( kind = DP ) :: ex,ey,ez
674     real( kind = DP ) :: reference
675     real( kind = DP ) :: dist
676     real( kind = DP ) :: theta
677     real( kind = DP ) :: phi
678     real( kind = DP ) :: psi
679     real( kind = DP ), dimension(3) :: xcom
680    
681     call info("BUILD_POSITIONS","Building positions of model...")
682    
683    
684     if (sim_type == "liquid") then
685     start_index = 1
686     reference = 0.5
687     else
688     start_index = - this_cell%number_of_cells
689     reference = 0
690     endif
691    
692     nc = this_cell%number_of_cells
693     ncount = 0
694     ntmp = 0
695     iinterface = 0
696    
697     !new stuff here
698 pconfort 5 #ifdef MPI
699     end if
700     #else
701     if (print_vac) then
702     vac_unit = next_unit()
703     vac_file = file_prefix(1:machdep_lnblnk(file_prefix))//".vac"
704     open (unit = vac_unit, status = 'replace', file = vac_file)
705 chuckv 4
706 pconfort 5 write(vac_unit,*) n_vacancy
707     write(vac_unit,*)
708 chuckv 4
709 pconfort 5 endif
710     #endif
711 chuckv 4
712     do iz = start_index, nc, 1
713     do iy = start_index, nc, 1
714     do ix = start_index, nc, 1
715     do iref = 1, 4
716    
717     rx = this_cell%sx(iref) + &
718     this_cell%cell_length * (dble( ix ) - 0.5E0_DP)
719     ry = this_cell%sy(iref) + &
720     this_cell%cell_length * (dble( iy ) - 0.5E0_DP)
721     rz = this_cell%sz(iref) + &
722     this_cell%cell_length * (dble( iz ) - 0.5E0_DP)
723    
724     ex = this_cell%s_ex(iref)
725     ey = this_cell%s_ey(iref)
726     ez = this_cell%s_ez(iref)
727    
728     dist = dsqrt(rx*rx + ry*ry + rz*rz)
729     if ((present(vacancy)).and. &
730     (dist.ge.r_core-vacancy_radius/2.0E0_DP).and. &
731     (dist.le.r_core+vacancy_radius/2.0E0_DP)) then
732    
733     iinterface = iinterface + 1
734    
735     if (.not.vacancy(iinterface)) then
736    
737     ncount = ncount + 1
738     #ifdef MPI
739     if(ncount.ge.nmol_start.and. &
740     ncount.le.nmol_end) then
741     ntmp = ncount - nmol_start + 1
742     #else
743     ntmp = ncount
744     #endif
745     rx = box(1)*(rx - reference)
746     ry = box(2)*(ry - reference)
747     rz = box(3)*(rz - reference)
748    
749    
750     xcom(1) = rx
751     xcom(2) = ry
752     xcom(3) = rz
753    
754     theta = cos(ez)
755     phi = 0.0E0_DP
756     psi = dtan(ex/ey)
757     call set_pos(ntmp, xcom, theta, phi, psi)
758     #ifdef MPI
759     end if
760     #endif
761    
762     !new stuff here
763 pconfort 5 #ifdef MPI
764     endif
765    
766     #else
767 chuckv 4 elseif (print_vac) then
768     rx = box(1)*(rx - reference)
769     ry = box(2)*(ry - reference)
770     rz = box(3)*(rz - reference)
771     write(unit = vac_unit,fmt = xyz_coord) "Ar", rx, ry, rz
772    
773     endif
774    
775 pconfort 5
776 chuckv 4 else
777     !! this will build either a liquid or a cluster
778     !! without any vacancies
779     if (is_shell(dist)) then
780     ncount = ncount + 1
781     #ifdef MPI
782     if(ncount.ge.nmol_start.and. &
783     ncount.le.nmol_end) then
784     ntmp = ncount - nmol_start +1
785     #else
786     ntmp = ncount
787     #endif
788     rx = box(1)*(rx - reference)
789     ry = box(2)*(ry - reference)
790     rz = box(3)*(rz - reference)
791    
792     xcom(1) = rx
793     xcom(2) = ry
794     xcom(3) = rz
795    
796     theta = dacos(ez)
797     phi = 0.0E0_DP
798     psi = tan(ex/ey)
799    
800     call set_pos(ntmp, xcom, theta, phi, psi)
801     #ifdef MPI
802     endif
803     #endif
804     endif
805    
806    
807     endif
808     end do
809     end do
810     end do
811     end do
812     close(vac_unit)
813    
814     end subroutine build_positions
815    
816    
817     function is_shell(dist) result(make_shell)
818     real( kind = DP ), intent(in) :: dist
819     logical :: make_shell
820    
821     if (sim_type == "liquid") then
822     make_shell = .true.
823     return
824     elseif (dist <= r_shell) then
825     make_shell = .true.
826     return
827     else
828     make_shell = .false.
829     endif
830    
831     return
832     end function is_shell
833    
834    
835     end module init_simulation