2 ! program WHAM_multparm
3 ! Creation/update of the database of conformations
13 use control_data, only:indpdb
18 use control, only:initialize
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) call read_dist_constr
134 write (iout,*) "Begin read_database"
136 call read_database(*10)
137 write (iout,*) "Finished read_database"
139 if (separate_parset) nparmset=1
141 if (ntot(islice).gt.0) then
143 call work_partition(islice,.true.)
144 write (iout,*) "work_partition OK"
147 write (iout,*) "call enecalc",islice,nslice
148 call enecalc(islice,*10)
149 write (iout,*) "enecalc OK"
151 call WHAMCALC(islice,*10)
152 write (iout,*) "wham_calc OK"
154 call write_dbase(islice,*10)
155 write (iout,*) "write_dbase OK"
157 if (ensembles.gt.0) then
158 call make_ensembles(islice,*10)
159 write (iout,*) "make_ensembles OK"
165 call MPI_Finalize( IERROR )
168 10 write (iout,*) "Error termination of the program"
170 call MPI_Finalize( IERROR )
173 end program wham_multparm
174 !------------------------------------------------------------------------------
176 !------------------------------------------------------------------------------
178 subroutine proc_groups
179 ! Split the processors into the Master and Workers group, if needed.
185 ! include "DIMENSIONS"
186 ! include "DIMENSIONS.ZSCOPT"
187 ! include "DIMENSIONS.FREE"
188 ! include "COMMON.IOUNITS"
189 ! include "COMMON.MPI"
190 ! include "COMMON.FREE"
192 integer :: n,chunk,i,j,ii,remainder
193 integer :: kolorW,key,ierror,errcode
197 ! Split the communicator if independent runs for different parameter
198 ! sets will be performed.
200 if (nparmset.eq.1 .or. .not.separate_parset) then
201 WHAM_COMM = MPI_COMM_WORLD
202 else if (separate_parset) then
203 if (nprocs.lt.nparmset) then
205 "*** Cannot split parameter sets for fewer processors than sets",&
207 call MPI_Finalize(ierror)
210 write (iout,*) "nparmset",nparmset
211 nprocs = nprocs/nparmset
214 write (iout,*) "My old rank",me," kolor",kolorW," key",key
215 call MPI_Comm_split(MPI_COMM_WORLD,kolorW,key,WHAM_COMM,ierror)
216 call MPI_Comm_size(WHAM_COMM,nprocs,ierror)
217 call MPI_Comm_rank(WHAM_COMM,me,ierror)
218 write (iout,*) "My new rank",me," comm size",nprocs
219 write (iout,*) "MPI_COMM_WORLD",MPI_COMM_WORLD,&
220 " WHAM_COMM",WHAM_COMM
222 write (iout,*) "My parameter set is",myparm
230 end subroutine proc_groups
232 !------------------------------------------------------------------------------
239 !-----------------------------------------------------------------------------
240 subroutine promienie(*)
244 use io_base, only:ucase
245 use energy_data, only:sigma0,dsc,dsc_inv
249 ! include 'DIMENSIONS'
250 ! include 'COMMON.CONTROL'
251 ! include 'COMMON.INTERACT'
252 ! include 'COMMON.IOUNITS'
253 ! include 'COMMON.CONTPAR'
254 ! include 'COMMON.LOCAL'
256 real(kind=8) :: facont=1.569D0 ! facont = (2/(1-sqrt(1-1/4)))**(1/6)
257 character(len=8) :: contfunc
258 character(len=8) :: contfuncid(5)=reshape((/'GB ',&
259 'DIST ','CEN ','ODC ','SIG '/),shape(contfuncid))
260 !el character(len=8) ucase
261 call getenv("CONTFUNC",contfunc)
262 contfunc=ucase(contfunc)
264 if (contfunc.eq.contfuncid(icomparfunc)) goto 10
267 write (iout,*) "Sidechain contact function is ",contfunc,&
268 "icomparfunc",icomparfunc
271 if (icomparfunc.lt.3) then
272 read(isidep1,*) chi_comp(i,j),chip_comp(i,j),sig_comp(i,j),&
274 else if (icomparfunc.lt.5) then
275 read(isidep1,*) sc_cutoff(i,j)
276 else if (icomparfunc.eq.5) then
277 sc_cutoff(i,j)=dsqrt(sigma0(i)**2+sigma0(j)**2)*facont
279 write (iout,*) "Error - Unknown contact function"
286 if (i.eq.10 .or. i.eq.ntyp1) then
289 dsc_inv(i)=1.0d0/dsc(i)
293 end subroutine promienie
294 !-----------------------------------------------------------------------------
295 subroutine alloc_wham_arrays
298 use geometry_data, only:nres
299 use energy_data, only:maxcont
303 !-------------------------
306 allocate(stot(nslice)) !(maxslice)
310 allocate(Kh(nQ,MaxR,MaxT_h,nParmSet),q0(nQ,MaxR,MaxT_h,nParmSet))!(MaxQ,MaxR,MaxT_h,max_parm)
311 allocate(f(maxR,maxT_h,nParmSet)) !(maxR,maxT_h,max_parm)
312 allocate(beta_h(maxT_h,nParmSet)) !(MaxT_h,max_parm)
313 allocate(nR(maxT_h,nParmSet),nRR(maxT_h,nParmSet)) !(maxT_h,max_parm)
314 allocate(snk(MaxR,MaxT_h,nParmSet,nSlice)) !(MaxR,MaxT_h,max_parm,MaxSlice)
325 allocate(totraj(maxR,nParmSet)) !(maxR,max_parm)
327 allocate(nT_h(nParmSet))!(max_parm)
328 allocate(replica(nParmSet))
329 allocate(umbrella(nParmSet))
330 allocate(read_iset(nParmSet))
331 ! allocate(nT_h(nParmSet))
332 !-------------------------
335 allocate(ntot(nslice)) !(maxslice)
336 ! allocatable :: isampl !(max_parm)
337 !-------------------------
340 allocate(protfiles(maxfile_prot,2,MaxR,MaxT_h,nParmSet)) !(maxfile_prot,2,MaxR,MaxT_h,Max_Parm)
341 allocate(nfile_bin(MaxR,MaxT_h,nParmSet))
342 allocate(nfile_asc(MaxR,MaxT_h,nParmSet))
343 allocate(nfile_cx(MaxR,MaxT_h,nParmSet))
344 allocate(rec_start(MaxR,MaxT_h,nParmSet))
345 allocate(rec_end(MaxR,MaxT_h,nParmSet)) !(MaxR,MaxT_h,Max_Parm)
346 !-------------------------
349 allocate(time_start_collect(maxR,MaxT_h,nParmSet))
350 allocate(time_end_collect(maxR,MaxT_h,nParmSet)) !(maxR,MaxT_h,Max_Parm)
351 !-------------------------
354 allocate(sig_comp(ntyp,ntyp),chi_comp(ntyp,ntyp),&
355 chip_comp(ntyp,ntyp),sc_cutoff(ntyp,ntyp)) !(ntyp,ntyp)
356 !-------------------------
359 allocate(icont_pept_ref(2,maxcont)) !(2,maxcont)
360 ! allocate(ncont_frag_ref()) !(mmaxfrag)
361 ! allocate(icont_frag_ref(2,maxcont)) !(2,maxcont,mmaxfrag)
362 allocate(isec_ref(nres)) !(maxres)
363 !-------------------------
365 ! Angles from experimental structure
367 allocate(vbld_ref(nres),theta_ref(nres),&
368 phi_ref(nres),alph_ref(nres),omeg_ref(nres)) !(maxres)
369 !-------------------------
370 end subroutine alloc_wham_arrays
371 !-----------------------------------------------------------------------------
372 !-----------------------------------------------------------------------------