2 c Optimize the UNRES energy function by minimization of a quartic target
3 c function or by the VMC method.
9 cMS$ATTRIBUTES C :: proc_proc
11 include "DIMENSIONS.ZSCOPT"
14 integer IERROR,ERRCODE,kolor,key
17 include "COMMON.IOUNITS"
18 include "COMMON.OPTIM"
20 double precision rr,x(max_paropt)
23 c print *,"Starting..."
25 c print *,"Initializing MPI..."
26 call MPI_Init( IERROR )
27 call MPI_Comm_rank( MPI_COMM_WORLD, me, IERROR )
28 call MPI_Comm_size( MPI_COMM_WORLD, nprocs, IERROR )
29 c print *,"Finished initializing MPI..."
32 c print *,"Me",me," Master",master," Ierror",ierror
34 write(iout,*) "SEVERE ERROR - Can't initialize MPI."
35 call mpi_finalize(ierror)
50 c print *,"calling openunits"
52 c print *,"openunits called"
53 call read_general_data(*10)
54 write (iout,'(80(1h-)/10x,
55 & "Maximum likelihood optimization of UNRES energy function",
56 & " v. 05/10/16"/80(1h-))')
60 write (iout,*) "Finished READ_GENERAL_DATA"
63 call parmread(iparm,*10)
65 call read_pmf_data(*10)
66 write (iout,*) "Finished parmread"
68 call read_optim_parm(*10)
69 call print_general_data(*10)
70 call read_protein_data(*10)
71 write (iout,*) "Finished READ_PROTEIN_DATA"
73 call read_database(*10)
74 write (iout,*) "Finished READ_DATABASE"
77 c write (iout,*) Me,' calling PROC_GROUPS'
79 c write (iout,*) Me,' calling WORK_PARTITION_MAP'
80 c call work_partition_map(nvarr)
85 call proc_data(nvarr,x,*10)
88 if (me.eq.Master) then
90 call maxlikopt(nvarr,x)
97 call MPI_Finalize( IERROR )
102 10 write (iout,*) "Error termination of the program"
103 call MPI_Finalize( IERROR )
106 c------------------------------------------------------------------------------
110 parameter (ntasks=11)
111 include "DIMENSIONS.ZSCOPT"
116 double precision ttask_all(ntasks)
117 integer nctask_all(ntasks)
119 include "COMMON.IOUNITS"
121 double precision ttask
123 common /timing/ ttask(ntasks),nctask(ntasks)
124 character*16 tname(ntasks) /"function","gradient",9*''/
127 write (iout,'(80(1h-))')
129 write (iout,*) "Routine call info from the processor ",me," ..."
131 write (iout,*) "Routine call info ..."
134 write (iout,'(65(1h-))')
135 write (iout,100) "task"," # calls"," total time",
137 write (iout,'(65(1h-))')
139 write (iout,200) tname(i),nctask(i),ttask(i),
140 & ttask(i)/(nctask(i)+1.0d-10)
144 call MPI_Reduce(ttask(1),ttask_all(1),ntasks,
145 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, WHAM_COMM,IERROR)
146 call MPI_Reduce(nctask(1),nctask_all(1),ntasks,
147 & MPI_INTEGER, MPI_SUM, Master, WHAM_COMM,IERROR)
148 if (Me.eq.Master) then
149 write (iout,'(80(1h-))')
150 write (iout,*) "Routine call info from all processors ..."
152 write (iout,'(65(1h-))')
153 write (iout,100) "task"," # calls"," total time",
155 write (iout,'(65(1h-))')
157 write (iout,200) tname(i),nctask_all(i),ttask_all(i),
158 & ttask_all(i)/(nctask_all(i)+1.0d-10)
164 100 format(a,t21,a,t31,a,t46,a)
165 200 format(a,t21,i10,f15.2,f15.8)
167 c------------------------------------------------------------------------------
169 subroutine proc_groups
170 C Split the processors into the Master and Workers group, if needed.
173 include "DIMENSIONS.ZSCOPT"
175 include "COMMON.IOUNITS"
177 include "COMMON.VMCPAR"
178 integer n,chunk,iprot,i,j,ii,remainder
179 integer kolor,key,ierror,errcode
182 C No secondary structure constraints.
188 c-------------------------------------------------------------------------------
189 subroutine work_partition(lprint)
190 c Split the conformations between processors
193 include "DIMENSIONS.ZSCOPT"
195 include "COMMON.CLASSES"
196 include "COMMON.IOUNITS"
198 include "COMMON.VMCPAR"
199 integer n,chunk,iprot,i,j,ii,remainder
200 integer kolor,key,ierror,errcode
203 C Divide conformations between processors; for each proteins the first and
204 C the last conformation to handle by ith processor is stored in
205 C indstart(i,iprot) and indend(i,iprot), respectively.
207 C First try to assign equal number of conformations to each processor.
211 write (iout,*) "Protein",iprot," n=",n
214 scount(0,iprot) = chunk
215 c print *,"i",0," indstart",indstart(0,iprot)," scount",
218 indstart(i,iprot)=chunk+indstart(i-1,iprot)
219 scount(i,iprot)=scount(i-1,iprot)
220 c print *,"i",i," indstart",indstart(i,iprot)," scount",
224 C Determine how many conformations remained yet unassigned.
226 remainder=N-(indstart(nprocs1-1,iprot)
227 & +scount(nprocs1-1,iprot)-1)
228 c print *,"remainder",remainder
230 C Assign the remainder conformations to consecutive processors, starting
231 C from the lowest rank; this continues until the list is exhausted.
233 if (remainder .gt. 0) then
235 scount(i-1,iprot) = scount(i-1,iprot) + 1
236 indstart(i,iprot) = indstart(i,iprot) + i
238 do i=remainder+1,nprocs1-1
239 indstart(i,iprot) = indstart(i,iprot) + remainder
243 indstart(nprocs1,iprot)=N+1
244 scount(nprocs1,iprot)=0
247 indend(i,iprot)=indstart(i,iprot)+scount(i,iprot)-1
248 idispl(i,iprot)=indstart(i,iprot)-1
253 N=N+indend(i,iprot)-indstart(i,iprot)+1
256 c print *,"N",n," NTOT",ntot_work(iprot)
257 if (N.ne.ntot_work(iprot)) then
258 write (iout,*) "!!! Checksum error on processor",me
260 call MPI_Abort( WHAM_COMM, Ierror, Errcode )
264 do i=1,ntot_work(iprot)
265 if (i.ge.indstart(me1,iprot) .and. i.le.indend(me1,iprot))
272 c write (iout,*) "i",i," iprot",iprot," i2ii",i2ii(i,iprot)
277 write (iout,*) "Partition of work between processors"
279 write (iout,*) "Protein",iprot
281 write (iout,*) "The i2ii array"
282 do j=1,ntot_work(iprot)
283 write (iout,*) j,i2ii(j,iprot)
287 write (iout,'(a,i5,a,i7,a,i7,a,i7)')
288 & "Processor",i," indstart",indstart(i,iprot),
289 & " indend",indend(i,iprot)," count",scount(i,iprot)
295 c------------------------------------------------------------------------------
296 subroutine jebadelko(nvarr)
299 include "DIMENSIONS.ZSCOPT"
301 include "COMMON.IOUNITS"
303 include "COMMON.VMCPAR"
304 include "COMMON.CLASSES"
305 include "COMMON.OPTIM"
306 include "COMMON.WEIGHTS"
307 include "COMMON.WEIGHTDER"
308 include "COMMON.ENERGIES"
309 include "COMMON.TIME1"
310 include "COMMON.PROTNAME"
311 include "COMMON.PROTFILES"
312 include "COMMON.TORSION"
313 include "COMMON.COMPAR"
314 integer What, TAG, IERROR, status(MPI_STATUS_SIZE), istop, iprot,
315 & nvarr, nf, errcode, ider
317 double precision x(max_paropt), g(max_paropt), viol
321 double precision rdum,rdif
322 double precision tcpu,t1,t1w,t1_ini,t1w_ini
326 write(iout,*) "Processor",me,me1," called JEBADELKO"
328 if (me.eq.Master) then
330 call func1(nvarr,istop,x)
333 write (iout,*) "ELOWEST at slave starting JEBADELKO"
335 do ibatch=1,natlike(iprot)+2
336 do ib=1,nbeta(ibatch,iprot)
337 write (iout,*) "iprot",iprot," ibatch",ibatch," ib",ib,
338 & " elowest",elowest(ib,ibatch,iprot)
344 t1w_ini = MPI_WTIME()
346 do while (istop.ne.0)
348 write (iout,*) "ELOWEST at slave calling FUNC1 from JBADELKO"
350 do ibatch=1,natlike(iprot)+2
351 do ib=1,nbeta(ibatch,iprot)
352 write (iout,*) "iprot",iprot," ibatch",ibatch," ib",ib,
353 & " elowest",elowest(ib,ibatch,iprot)
358 call func1(nvarr,istop,x)
359 c write (iout,*) "slave: after func1"
362 if (istop.eq.1 .and. mod_fourier(nloctyp).gt.0) then
363 rdum = rdif(nvarr,x,g,ider)
364 c write (iout,*) "slave: after rdif"
369 t1w = mpi_wtime() - t1w_ini
372 write (iout,*) "CPU time",t1," wall clock time",t1w
377 write (iout,*) "Energies of processor",me
380 write (iout,*) "Protein ",protname(iprot)
382 if (i.ge.indstart(me1,j).and.i.le.indend(me1,j)) then
383 write(iout,*)i,e_total(i,j),rmstb(i,j),iscore(i,0,j)
389 write (iout,*) "Deleting scratchfile",bprotfiles(iprot)
390 inquire (file=bprotfiles(iprot),number=iun,opened=op)
391 write (iout,*) "unit",iun," icbase",icbase
393 open (icbase,file=bprotfiles(iprot),status="old",
394 & form="unformatted",access="direct",recl=lenrec(iprot))
395 close(icbase,status="delete")
397 close(iun,status="delete")
400 if (.not.mod_other_params) then
401 write (iout,*) "Deleting scratchfile",benefiles(iprot)
402 inquire (file=benefiles(iprot),number=iun,opened=op)
403 write (iout,*) "unit",iun," ientout",icbase
405 open (ientout,file=benefiles(iprot),status="old",
406 & form="unformatted",access="direct",recl=lenrec_ene(iprot))
407 close(ientout,status="delete")
409 close (iun,status="delete")
414 write (iout,*) "Processor",me,"leaves JEBADELKO"