2 ! program WHAM_multparm
3 ! Creation/update of the database of conformations
13 use control_data, only:indpdb
18 use control, only:initialize,hpb_partition
19 !el use io_config, only:parmread
24 !MS$ATTRIBUTES C :: proc_proc
29 !el external proc_proc
32 !elcMS$ATTRIBUTES C :: proc_proc
34 ! include "DIMENSIONS"
35 ! include "DIMENSIONS.ZSCOPT"
36 ! include "DIMENSIONS.FREE"
39 ! include "COMMON.MPI"
42 integer :: IERROR,ERRCODE
44 ! include "COMMON.IOUNITS"
45 ! include "COMMON.FREE"
46 ! include "COMMON.CONTROL"
47 ! include "COMMON.ALLPARM"
48 ! include "COMMON.PROT"
49 real(kind=8) :: rr !,x(max_paropt)
51 integer :: i,ipar,islice
55 ! call alloc_wham_arrays
56 !write(iout,*) "after alloc wham"
58 call MPI_Init( IERROR )
59 call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR )
60 call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR )
63 write(iout,*) "SEVERE ERROR - Can't initialize MPI."
64 call mpi_finalize(ierror)
67 !el if (nprocs.gt.MaxProcs+1) then
68 !el write (2,*) "Error - too many processors",&
70 !el write (2,*) "Increase MaxProcs and recompile"
71 !el call MPI_Finalize(IERROR)
85 !write(iout,*) "before init"
87 !write(iout,*)"after init"
89 !write(iout,*)"after open ui"
91 !write(iout,*)"after cinfo"
92 call read_general_data(*10)
93 !write(iout,*)"after read_gen"
96 !write(iout,*)"after molread"
99 write (iout,*) "Calling proc_groups"
101 write (iout,*) "proc_groups exited"
105 call alloc_wham_arrays
108 write (iout,*) "Calling parmread",ipar
109 call parmread(ipar,*10)
110 if (.not.separate_parset) then
111 call store_parm(ipar)
112 write (iout,*) "Finished storing parameters",ipar
113 else if (ipar.eq.myparm) then
115 write (iout,*) "Finished storing parameters",ipar
120 write (iout,*) "Finished READ_EFREE"
122 call read_protein_data(*10)
123 write (iout,*) "Finished READ_PROTEIN_DATA"
125 if (indpdb.gt.0) then
128 call read_ref_structure(*10)
129 !write(iout,*)"before proc_cont, define frag"
133 if (constr_dist.gt.0) then
134 call read_dist_constr
137 write (iout,*) "Begin read_database"
139 call read_database(*10)
140 write (iout,*) "Finished read_database"
142 if (separate_parset) nparmset=1
144 if (ntot(islice).gt.0) then
146 call work_partition(islice,.true.)
147 write (iout,*) "work_partition OK"
150 write (iout,*) "call enecalc",islice,nslice
151 call enecalc(islice,*10)
152 write (iout,*) "enecalc OK"
154 call WHAMCALC(islice,*10)
155 write (iout,*) "wham_calc OK"
157 call write_dbase(islice,*10)
158 write (iout,*) "write_dbase OK"
160 if (ensembles.gt.0) then
161 call make_ensembles(islice,*10)
162 write (iout,*) "make_ensembles OK"
168 call MPI_Finalize( IERROR )
171 10 write (iout,*) "Error termination of the program"
173 call MPI_Finalize( IERROR )
176 end program wham_multparm
177 !------------------------------------------------------------------------------
179 !------------------------------------------------------------------------------
181 subroutine proc_groups
182 ! Split the processors into the Master and Workers group, if needed.
188 ! include "DIMENSIONS"
189 ! include "DIMENSIONS.ZSCOPT"
190 ! include "DIMENSIONS.FREE"
191 ! include "COMMON.IOUNITS"
192 ! include "COMMON.MPI"
193 ! include "COMMON.FREE"
195 integer :: n,chunk,i,j,ii,remainder
196 integer :: kolorW,key,ierror,errcode
200 ! Split the communicator if independent runs for different parameter
201 ! sets will be performed.
203 if (nparmset.eq.1 .or. .not.separate_parset) then
204 WHAM_COMM = MPI_COMM_WORLD
205 else if (separate_parset) then
206 if (nprocs.lt.nparmset) then
208 "*** Cannot split parameter sets for fewer processors than sets",&
210 call MPI_Finalize(ierror)
213 write (iout,*) "nparmset",nparmset
214 nprocs = nprocs/nparmset
217 write (iout,*) "My old rank",me," kolor",kolorW," key",key
218 call MPI_Comm_split(MPI_COMM_WORLD,kolorW,key,WHAM_COMM,ierror)
219 call MPI_Comm_size(WHAM_COMM,nprocs,ierror)
220 call MPI_Comm_rank(WHAM_COMM,me,ierror)
221 write (iout,*) "My new rank",me," comm size",nprocs
222 write (iout,*) "MPI_COMM_WORLD",MPI_COMM_WORLD,&
223 " WHAM_COMM",WHAM_COMM
225 write (iout,*) "My parameter set is",myparm
233 end subroutine proc_groups
235 !------------------------------------------------------------------------------
242 !-----------------------------------------------------------------------------
243 subroutine promienie(*)
247 use io_base, only:ucase
248 use energy_data, only:sigma0,dsc,dsc_inv
252 ! include 'DIMENSIONS'
253 ! include 'COMMON.CONTROL'
254 ! include 'COMMON.INTERACT'
255 ! include 'COMMON.IOUNITS'
256 ! include 'COMMON.CONTPAR'
257 ! include 'COMMON.LOCAL'
259 real(kind=8) :: facont=1.569D0 ! facont = (2/(1-sqrt(1-1/4)))**(1/6)
260 character(len=8) :: contfunc
261 character(len=8) :: contfuncid(5)=reshape((/'GB ',&
262 'DIST ','CEN ','ODC ','SIG '/),shape(contfuncid))
263 !el character(len=8) ucase
264 call getenv("CONTFUNC",contfunc)
265 contfunc=ucase(contfunc)
267 if (contfunc.eq.contfuncid(icomparfunc)) goto 10
270 write (iout,*) "Sidechain contact function is ",contfunc,&
271 "icomparfunc",icomparfunc
274 if (icomparfunc.lt.3) then
275 read(isidep1,*) chi_comp(i,j),chip_comp(i,j),sig_comp(i,j),&
277 else if (icomparfunc.lt.5) then
278 read(isidep1,*) sc_cutoff(i,j)
279 else if (icomparfunc.eq.5) then
280 sc_cutoff(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2)*facont
282 write (iout,*) "Error - Unknown contact function"
289 if (i.eq.10 .or. i.eq.ntyp1) then
292 dsc_inv(i)=1.0d0/dsc(i)
296 end subroutine promienie
297 !-----------------------------------------------------------------------------
298 subroutine alloc_wham_arrays
301 use geometry_data, only:nres
302 use energy_data, only:maxcont
306 !-------------------------
309 allocate(stot(nslice)) !(maxslice)
313 allocate(Kh(nQ,MaxR,MaxT_h,nParmSet),q0(nQ,MaxR,MaxT_h,nParmSet))!(MaxQ,MaxR,MaxT_h,max_parm)
314 allocate(f(maxR,maxT_h,nParmSet)) !(maxR,maxT_h,max_parm)
315 allocate(beta_h(maxT_h,nParmSet)) !(MaxT_h,max_parm)
316 allocate(nR(maxT_h,nParmSet),nRR(maxT_h,nParmSet)) !(maxT_h,max_parm)
317 allocate(snk(MaxR,MaxT_h,nParmSet,nSlice)) !(MaxR,MaxT_h,max_parm,MaxSlice)
328 allocate(totraj(maxR,nParmSet)) !(maxR,max_parm)
330 allocate(nT_h(nParmSet))!(max_parm)
331 allocate(replica(nParmSet))
332 allocate(umbrella(nParmSet))
333 allocate(read_iset(nParmSet))
334 ! allocate(nT_h(nParmSet))
335 !-------------------------
338 allocate(ntot(nslice)) !(maxslice)
339 ! allocatable :: isampl !(max_parm)
340 !-------------------------
343 allocate(protfiles(maxfile_prot,2,MaxR,MaxT_h,nParmSet)) !(maxfile_prot,2,MaxR,MaxT_h,Max_Parm)
344 allocate(nfile_bin(MaxR,MaxT_h,nParmSet))
345 allocate(nfile_asc(MaxR,MaxT_h,nParmSet))
346 allocate(nfile_cx(MaxR,MaxT_h,nParmSet))
347 allocate(rec_start(MaxR,MaxT_h,nParmSet))
348 allocate(rec_end(MaxR,MaxT_h,nParmSet)) !(MaxR,MaxT_h,Max_Parm)
349 !-------------------------
352 allocate(time_start_collect(maxR,MaxT_h,nParmSet))
353 allocate(time_end_collect(maxR,MaxT_h,nParmSet)) !(maxR,MaxT_h,Max_Parm)
354 !-------------------------
357 allocate(sig_comp(ntyp,ntyp),chi_comp(ntyp,ntyp),&
358 chip_comp(ntyp,ntyp),sc_cutoff(ntyp,ntyp)) !(ntyp,ntyp)
359 !-------------------------
362 allocate(icont_pept_ref(2,maxcont)) !(2,maxcont)
363 ! allocate(ncont_frag_ref()) !(mmaxfrag)
364 ! allocate(icont_frag_ref(2,maxcont)) !(2,maxcont,mmaxfrag)
365 allocate(isec_ref(nres)) !(maxres)
366 !-------------------------
368 ! Angles from experimental structure
370 allocate(vbld_ref(nres),theta_ref(nres),&
371 phi_ref(nres),alph_ref(nres),omeg_ref(nres)) !(maxres)
372 !-------------------------
373 end subroutine alloc_wham_arrays
374 !-----------------------------------------------------------------------------
375 !-----------------------------------------------------------------------------