1 c------------------------------------------------------------------------------
6 include "DIMENSIONS.ZSCOPT"
11 double precision ttask_all(ntasks)
12 integer nctask_all(ntasks)
14 include "COMMON.IOUNITS"
16 double precision ttask
18 common /timing/ ttask(ntasks),nctask(ntasks)
19 character*16 tname(ntasks) /"function","gradient",9*''/
21 if (me.eq.Master) then
23 write (iout,'(80(1h-))')
25 write (iout,*) "Routine call info from the processor ",me," ..."
27 write (iout,*) "Routine call info ..."
30 write (iout,'(65(1h-))')
31 write (iout,100) "task"," # calls"," total time",
33 write (iout,'(65(1h-))')
35 write (iout,200) tname(i),nctask(i),ttask(i),
36 & ttask(i)/(nctask(i)+1.0d-10)
41 call MPI_Reduce(ttask(1),ttask_all(1),ntasks,
42 & MPI_DOUBLE_PRECISION, MPI_SUM, Master, WHAM_COMM,IERROR)
43 call MPI_Reduce(nctask(1),nctask_all(1),ntasks,
44 & MPI_INTEGER, MPI_SUM, Master, WHAM_COMM,IERROR)
45 if (Me.eq.Master) then
46 write (iout,'(80(1h-))')
47 write (iout,*) "Routine call info from all processors ..."
49 write (iout,'(65(1h-))')
50 write (iout,100) "task"," # calls"," total time",
52 write (iout,'(65(1h-))')
54 write (iout,200) tname(i),nctask_all(i),ttask_all(i),
55 & ttask_all(i)/(nctask_all(i)+1.0d-10)
61 100 format(a,t21,a,t31,a,t46,a)
62 200 format(a,t21,i10,f15.2,f15.8)
64 c------------------------------------------------------------------------------
66 subroutine proc_groups
67 C Split the processors into the Master and Workers group, if needed.
70 include "DIMENSIONS.ZSCOPT"
72 include "COMMON.IOUNITS"
74 include "COMMON.VMCPAR"
75 integer n,chunk,iprot,i,j,ii,remainder
76 integer kolor,key,ierror,errcode
79 C No secondary structure constraints.
85 c-------------------------------------------------------------------------------
86 subroutine work_partition(lprint)
87 c Split the conformations between processors
90 include "DIMENSIONS.ZSCOPT"
92 include "COMMON.CLASSES"
93 include "COMMON.IOUNITS"
95 include "COMMON.VMCPAR"
96 integer n,chunk,iprot,i,j,ii,remainder
97 integer kolor,key,ierror,errcode
100 C Divide conformations between processors; for each proteins the first and
101 C the last conformation to handle by ith processor is stored in
102 C indstart(i,iprot) and indend(i,iprot), respectively.
104 C First try to assign equal number of conformations to each processor.
108 if (me.eq.Master) write (iout,*) "Protein",iprot," n=",n
111 scount(0,iprot) = chunk
112 c print *,"i",0," indstart",indstart(0,iprot)," scount",
115 indstart(i,iprot)=chunk+indstart(i-1,iprot)
116 scount(i,iprot)=scount(i-1,iprot)
117 c print *,"i",i," indstart",indstart(i,iprot)," scount",
121 C Determine how many conformations remained yet unassigned.
123 remainder=N-(indstart(nprocs1-1,iprot)
124 & +scount(nprocs1-1,iprot)-1)
125 c print *,"remainder",remainder
127 C Assign the remainder conformations to consecutive processors, starting
128 C from the lowest rank; this continues until the list is exhausted.
130 if (remainder .gt. 0) then
132 scount(i-1,iprot) = scount(i-1,iprot) + 1
133 indstart(i,iprot) = indstart(i,iprot) + i
135 do i=remainder+1,nprocs1-1
136 indstart(i,iprot) = indstart(i,iprot) + remainder
140 indstart(nprocs1,iprot)=N+1
141 scount(nprocs1,iprot)=0
144 indend(i,iprot)=indstart(i,iprot)+scount(i,iprot)-1
145 idispl(i,iprot)=indstart(i,iprot)-1
150 N=N+indend(i,iprot)-indstart(i,iprot)+1
153 c print *,"N",n," NTOT",ntot_work(iprot)
154 if (N.ne.ntot_work(iprot)) then
155 write (*,*) "!!! Checksum error on processor",me
157 call MPI_Abort( WHAM_COMM, Ierror, Errcode )
161 do i=1,ntot_work(iprot)
162 if (i.ge.indstart(me1,iprot) .and. i.le.indend(me1,iprot))
169 c write (iout,*) "i",i," iprot",iprot," i2ii",i2ii(i,iprot)
174 write (iout,*) "Partition of work between processors"
176 write (iout,*) "Protein",iprot
178 write (iout,*) "The i2ii array"
179 do j=1,ntot_work(iprot)
180 write (iout,*) j,i2ii(j,iprot)
184 write (iout,'(a,i5,a,i7,a,i7,a,i7)')
185 & "Processor",i," indstart",indstart(i,iprot),
186 & " indend",indend(i,iprot)," count",scount(i,iprot)
192 c------------------------------------------------------------------------------
193 subroutine jebadelko(nvarr)
196 include "DIMENSIONS.ZSCOPT"
198 include "COMMON.IOUNITS"
200 include "COMMON.VMCPAR"
201 include "COMMON.CLASSES"
202 include "COMMON.OPTIM"
203 include "COMMON.WEIGHTS"
204 include "COMMON.WEIGHTDER"
205 include "COMMON.ENERGIES"
206 include "COMMON.TIME1"
207 include "COMMON.PROTNAME"
208 include "COMMON.PROTFILES"
209 include "COMMON.COMPAR"
210 integer What, TAG, IERROR, status(MPI_STATUS_SIZE), istop, iprot,
213 double precision x(max_paropt), g(max_paropt), viol
217 double precision rdum
218 double precision tcpu,t1,t1w,t1_ini,t1w_ini
222 if (me.eq.Master) then
223 write(iout,*) "Processor",me,me1," called JEBADELKO"
226 if (me.eq.Master) then
228 call func1(nvarr,istop,x)
231 write (iout,*) "ELOWEST at slave starting JEBADELKO"
233 do ibatch=1,natlike(iprot)+2
234 do ib=1,nbeta(ibatch,iprot)
235 write (iout,*) "iprot",iprot," ibatch",ibatch," ib",ib,
236 & " elowest",elowest(ib,ibatch,iprot)
242 t1w_ini = MPI_WTIME()
244 do while (istop.ne.0)
246 write (iout,*) "ELOWEST at slave calling FUNC1 from JBADELKO"
248 do ibatch=1,natlike(iprot)+2
249 do ib=1,nbeta(ibatch,iprot)
250 write (iout,*) "iprot",iprot," ibatch",ibatch," ib",ib,
251 & " elowest",elowest(ib,ibatch,iprot)
256 call func1(nvarr,istop,x)
258 t1w = mpi_wtime() - t1w_ini
262 write (iout,*) "CPU time",t1," wall clock time",t1w
268 write (iout,*) "Energies of processor",me
271 write (iout,*) "Protein ",protname(iprot)
273 if (i.ge.indstart(me1,j).and.i.le.indend(me1,j)) then
274 write(iout,*)i,e_total(i,j),rmstb(i,j),iscore(i,0,j)
281 c write (iout,*) "Deleting scratchfile",bprotfiles(iprot)
282 c inquire (file=bprotfiles(iprot),number=iun,opened=op)
283 c write (iout,*) "unit",iun," icbase",icbase
284 cc if (.not. op) then
285 c open (icbase,file=bprotfiles(iprot),status="old",
286 c & form="unformatted",access="direct",recl=lenrec(iprot))
287 c close(icbase,status="delete")
289 c close(iun,status="delete")
292 c write (iout,*) "Deleting scratchfile",benefiles(iprot)
293 c inquire (file=benefiles(iprot),number=iun,opened=op)
294 c write (iout,*) "unit",iun," ientout",icbase
296 c open (ientout,file=benefiles(iprot),status="old",
297 c & form="unformatted",access="direct",recl=lenrec_ene(iprot))
298 c close(ientout,status="delete")
300 c close (iun,status="delete")
306 write (iout,*) "Processor",me,"leaves JEBADELKO"