684f09005ae0f06712ede9cfeb501ea962d78778
[unres.git] / readrtns.F
1       subroutine read_general_data(*)
2       implicit none
3       include "DIMENSIONS"
4       include "DIMENSIONS.ZSCOPT"
5       include "DIMENSIONS.FREE"
6       include "COMMON.TORSION"
7       include "COMMON.INTERACT"
8       include "COMMON.IOUNITS"
9       include "COMMON.TIME1"
10       include "COMMON.PROT"
11       include "COMMON.PROTFILES"
12       include "COMMON.CHAIN"
13       include "COMMON.NAMES"
14       include "COMMON.FFIELD"
15       include "COMMON.ENEPS"
16       include "COMMON.WEIGHTS"
17       include "COMMON.FREE"
18       include "COMMON.CONTROL"
19       include "COMMON.ENERGIES"
20       include "COMMON.SPLITELE"
21       include "COMMON.SBRIDGE"
22       character*800 controlcard
23       integer i,j,k,ii,n_ene_found
24       integer ind,itype1,itype2,itypf,itypsc,itypp
25       integer ilen
26       external ilen
27       character*16 ucase
28       character*16 key
29       external ucase
30
31       call card_concat(controlcard,.true.)
32       call readi(controlcard,"N_ENE",n_ene,max_ene)
33       if (n_ene.gt.max_ene) then
34         write (iout,*) "Error: parameter out of range: N_ENE",n_ene,
35      &    max_ene
36         return1
37       endif
38       call readi(controlcard,"NPARMSET",nparmset,1)
39       separate_parset = index(controlcard,"SEPARATE_PARSET").gt.0
40       call readi(controlcard,"IPARMPRINT",iparmprint,1)
41       write (iout,*) "PARMPRINT",iparmprint
42       if (nparmset.gt.max_parm) then
43         write (iout,*) "Error: parameter out of range: NPARMSET",
44      &    nparmset, Max_Parm
45         return1
46       endif
47       call readi(controlcard,"MAXIT",maxit,5000)
48       call reada(controlcard,"FIMIN",fimin,1.0d-3)
49       call readi(controlcard,"ENSEMBLES",ensembles,0)
50       hamil_rep=index(controlcard,"HAMIL_REP").gt.0
51       write (iout,*) "Number of energy parameter sets",nparmset
52       call multreadi(controlcard,"ISAMPL",isampl,nparmset,1)
53       write (iout,*) "MaxSlice",MaxSlice
54       call readi(controlcard,"NSLICE",nslice,1)
55       call flush(iout)
56       if (nslice.gt.MaxSlice) then
57         write (iout,*) "Error: parameter out of range: NSLICE",nslice,
58      &    MaxSlice
59         return1
60       endif
61       write (iout,*) "Frequency of storing conformations",
62      & (isampl(i),i=1,nparmset)
63       write (iout,*) "Maxit",maxit," Fimin",fimin
64       call readi(controlcard,"NQ",nQ,1)
65       if (nQ.gt.MaxQ) then
66         write (iout,*) "Error: parameter out of range: NQ",nq,
67      &    maxq
68         return1
69       endif
70       indpdb=0
71       if (index(controlcard,"CLASSIFY").gt.0) indpdb=1
72       call reada(controlcard,"DELTA",delta,1.0d-2)
73       call readi(controlcard,"EINICHECK",einicheck,2)
74       call reada(controlcard,"DELTRMS",deltrms,5.0d-2)
75       call reada(controlcard,"DELTRGY",deltrgy,5.0d-2)
76       call readi(controlcard,"RESCALE",rescale_mode,1)
77       check_conf=index(controlcard,"NO_CHECK_CONF").eq.0
78       call reada(controlcard,'DISTCHAINMAX',distchainmax,50.0d0)
79        call reada(controlcard,'BOXX',boxxsize,100.0d0)
80        call reada(controlcard,'BOXY',boxysize,100.0d0)
81        call reada(controlcard,'BOXZ',boxzsize,100.0d0)
82 c Cutoff range for interactions
83       call reada(controlcard,"R_CUT",r_cut,15.0d0)
84       call reada(controlcard,"LAMBDA",rlamb,0.3d0)
85       call reada(controlcard,"LIPTHICK",lipthick,0.0d0)
86       call reada(controlcard,"LIPAQBUF",lipbufthick,0.0d0)
87       if (lipthick.gt.0.0d0) then
88        bordliptop=(boxzsize+lipthick)/2.0
89        bordlipbot=bordliptop-lipthick
90 C      endif
91       if ((bordliptop.gt.boxzsize).or.(bordlipbot.lt.0.0))
92      & write(iout,*) "WARNING WRONG SIZE OF LIPIDIC PHASE"
93       buflipbot=bordlipbot+lipbufthick
94       bufliptop=bordliptop-lipbufthick
95       if ((lipbufthick*2.0d0).gt.lipthick)
96      &write(iout,*) "WARNING WRONG SIZE OF LIP AQ BUF"
97       endif
98       write(iout,*) "bordliptop=",bordliptop
99       write(iout,*) "bordlipbot=",bordlipbot
100       write(iout,*) "bufliptop=",bufliptop
101       write(iout,*) "buflipbot=",buflipbot
102       call readi(controlcard,'SYM',symetr,1)
103       write (iout,*) "DISTCHAINMAX",distchainmax
104       write (iout,*) "delta",delta
105       write (iout,*) "einicheck",einicheck
106       write (iout,*) "rescale_mode",rescale_mode
107       call flush(iout)
108       bxfile=index(controlcard,"BXFILE").gt.0
109       cxfile=index(controlcard,"CXFILE").gt.0
110       if (nslice .eq. 1 .and. .not.bxfile .and. .not.cxfile)
111      & bxfile=.true.
112       histfile=index(controlcard,"HISTFILE").gt.0
113       histout=index(controlcard,"HISTOUT").gt.0
114       entfile=index(controlcard,"ENTFILE").gt.0
115       zscfile=index(controlcard,"ZSCFILE").gt.0
116       with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0
117       write (iout,*) "with_dihed_constr ",with_dihed_constr
118       with_theta_constr = index(controlcard,"WITH_THETA_CONSTR").gt.0
119       write (iout,*) "with_theta_constr ",with_theta_constr
120       call readi(controlcard,'CONSTR_DIST',constr_dist,0)
121       dyn_ss=index(controlcard,"DYN_SS").gt.0
122       return
123       end
124 c------------------------------------------------------------------------------
125       subroutine read_efree(*)
126 C
127 C Read molecular data
128 C
129       implicit none
130       include 'DIMENSIONS'
131       include 'DIMENSIONS.ZSCOPT'
132       include 'DIMENSIONS.COMPAR'
133       include 'DIMENSIONS.FREE'
134       include 'COMMON.IOUNITS'
135       include 'COMMON.TIME1'
136       include 'COMMON.SBRIDGE'
137       include 'COMMON.CONTROL'
138       include 'COMMON.CHAIN'
139       include 'COMMON.HEADER'
140       include 'COMMON.GEO'
141       include 'COMMON.FREE'
142       character*320 controlcard,ucase
143       integer iparm,ib,i,j,npars
144       integer ilen
145       external ilen
146      
147       if (hamil_rep) then
148         npars=1
149       else
150         npars=nParmSet
151       endif
152
153       do iparm=1,npars
154
155       call card_concat(controlcard,.true.)
156       call readi(controlcard,'NT',nT_h(iparm),1)
157       write (iout,*) "iparm",iparm," nt",nT_h(iparm)
158       call flush(iout)
159       if (nT_h(iparm).gt.MaxT_h) then
160         write (iout,*)  "Error: parameter out of range: NT",nT_h(iparm),
161      &    MaxT_h
162         return1
163       endif
164       replica(iparm)=index(controlcard,"REPLICA").gt.0
165       umbrella(iparm)=index(controlcard,"UMBRELLA").gt.0
166       read_iset(iparm)=index(controlcard,"READ_ISET").gt.0
167       write (iout,*) "nQ",nQ," nT",nT_h(iparm)," replica ",
168      &  replica(iparm)," umbrella ",umbrella(iparm),
169      &  " read_iset",read_iset(iparm)
170       call flush(iout)
171       do ib=1,nT_h(iparm)
172         call card_concat(controlcard,.true.)
173         call readi(controlcard,'NR',nR(ib,iparm),1)
174         if (umbrella(iparm)) then
175           nRR(ib,iparm)=1
176         else
177           nRR(ib,iparm)=nR(ib,iparm)
178         endif
179         if (nR(ib,iparm).gt.MaxR) then
180           write (iout,*)  "Error: parameter out of range: NR",
181      &      nR(ib,iparm),MaxR
182         return1
183         endif
184         call reada(controlcard,'TEMP',beta_h(ib,iparm),298.0d0)
185         beta_h(ib,iparm)=1.0d0/(beta_h(ib,iparm)*1.987D-3)
186         call multreada(controlcard,'FI',f(1,ib,iparm),nR(ib,iparm),
187      &    0.0d0)
188         do i=1,nR(ib,iparm)
189           call card_concat(controlcard,.true.)
190           call multreada(controlcard,'KH',KH(1,i,ib,iparm),nQ,
191      &      100.0d0)
192           call multreada(controlcard,'Q0',Q0(1,i,ib,iparm),nQ,
193      &      0.0d0)
194         enddo
195       enddo
196       do ib=1,nT_h(iparm)
197         write (iout,*) "ib",ib," beta_h",
198      &    1.0d0/(0.001987*beta_h(ib,iparm))
199         write (iout,*) "nR",nR(ib,iparm)
200         write (iout,*) "fi",(f(i,ib,iparm),i=1,nR(ib,iparm))
201         do i=1,nR(ib,iparm)
202           write (iout,*) "i",i," Kh",(Kh(j,i,ib,iparm),j=1,nQ),
203      &      "q0",(q0(j,i,ib,iparm),j=1,nQ)
204         enddo
205         call flush(iout)
206       enddo
207
208       enddo
209
210       if (hamil_rep) then
211
212        do iparm=2,nParmSet
213           nT_h(iparm)=nT_h(1)
214          do ib=1,nT_h(iparm)
215            nR(ib,iparm)=nR(ib,1)
216            if (umbrella(iparm)) then
217              nRR(ib,iparm)=1
218            else
219              nRR(ib,iparm)=nR(ib,1)
220            endif
221            beta_h(ib,iparm)=beta_h(ib,1)
222            do i=1,nR(ib,iparm)
223              f(i,ib,iparm)=f(i,ib,1)
224              do j=1,nQ
225                KH(j,i,ib,iparm)=KH(j,i,ib,1) 
226                Q0(j,i,ib,iparm)=Q0(j,i,ib,1) 
227              enddo
228            enddo
229            replica(iparm)=replica(1)
230            umbrella(iparm)=umbrella(1)
231            read_iset(iparm)=read_iset(1)
232          enddo
233        enddo
234         
235       endif
236
237       return
238       end
239 c-----------------------------------------------------------------------------
240       subroutine read_protein_data(*)
241       implicit none
242       include "DIMENSIONS"
243       include "DIMENSIONS.ZSCOPT"
244       include "DIMENSIONS.FREE"
245 #ifdef MPI
246       include "mpif.h"
247       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
248       include "COMMON.MPI"
249 #endif
250       include "COMMON.CHAIN"
251       include "COMMON.IOUNITS"
252       include "COMMON.PROT"
253       include "COMMON.PROTFILES"
254       include "COMMON.NAMES"
255       include "COMMON.FREE"
256       include "COMMON.OBCINKA"
257       character*64 nazwa
258       character*16000 controlcard
259       integer i,ii,ib,iR,iparm,ilen,iroof,nthr,npars
260       external ilen,iroof
261       if (hamil_rep) then
262         npars=1
263       else
264         npars=nparmset
265       endif
266
267       do iparm=1,npars
268
269 C Read names of files with conformation data.
270       if (replica(iparm)) then
271         nthr = 1
272       else
273         nthr = nT_h(iparm)
274       endif
275       do ib=1,nthr
276       do ii=1,nRR(ib,iparm)
277       write (iout,*) "Parameter set",iparm," temperature",ib,
278      & " window",ii
279       call flush(iout)
280       call card_concat(controlcard,.true.) 
281       write (iout,*) controlcard(:ilen(controlcard))
282       call readi(controlcard,"NFILE_BIN",nfile_bin(ii,ib,iparm),0)
283       call readi(controlcard,"NFILE_ASC",nfile_asc(ii,ib,iparm),0)
284       call readi(controlcard,"NFILE_CX",nfile_cx(ii,ib,iparm),0)
285       call readi(controlcard,"REC_START",rec_start(ii,ib,iparm),1)
286       call readi(controlcard,"REC_END",rec_end(ii,ib,iparm),
287      & maxstr*isampl(iparm)+rec_start(ii,ib,iparm)-1)
288       call reada(controlcard,"TIME_START",
289      &  time_start_collect(ii,ib,iparm),0.0d0)
290       call reada(controlcard,"TIME_END",time_end_collect(ii,ib,iparm),
291      &  1.0d10)
292       write (iout,*) "rec_start",rec_start(ii,ib,iparm),
293      & " rec_end",rec_end(ii,ib,iparm)
294       write (iout,*) "time_start",time_start_collect(ii,ib,iparm),
295      & " time_end",time_end_collect(ii,ib,iparm)
296       call flush(iout)
297       if (replica(iparm)) then
298         call readi(controlcard,"TOTRAJ",totraj(ii,iparm),1)
299         write (iout,*) "Number of trajectories",totraj(ii,iparm)
300         call flush(iout)
301       endif
302       if (nfile_bin(ii,ib,iparm).lt.2 
303      &    .and. nfile_asc(ii,ib,iparm).eq.0
304      &    .and. nfile_cx(ii,ib,iparm).eq.0) then
305         write (iout,*) "Error - no action specified!"
306         return1
307       endif
308       if (nfile_bin(ii,ib,iparm).gt.0) then
309         call card_concat(controlcard,.false.)
310         call split_string(controlcard,protfiles(1,1,ii,ib,iparm),
311      &   maxfile_prot,nfile_bin(ii,ib,iparm))
312 #ifdef DEBUG
313         write(iout,*)"nfile_bin",nfile_bin(ii,ib,iparm)
314         write(iout,*) (protfiles(i,1,ii,ib,iparm),
315      &    i=1,nfile_bin(ii,ib,iparm))
316 #endif
317       endif
318       if (nfile_asc(ii,ib,iparm).gt.0) then
319         call card_concat(controlcard,.false.)
320         call split_string(controlcard,protfiles(1,2,ii,ib,iparm),
321      &   maxfile_prot,nfile_asc(ii,ib,iparm))
322 #ifdef DEBUG
323         write(iout,*) "nfile_asc(ii,ib,iparm)",nfile_asc(ii,ib,iparm)
324         write(iout,*) (protfiles(i,2,ii,ib,iparm),
325      &    i=1,nfile_asc(ii,ib,iparm))
326 #endif
327       else if (nfile_cx(ii,ib,iparm).gt.0) then
328         call card_concat(controlcard,.false.)
329         call split_string(controlcard,protfiles(1,2,ii,ib,iparm),
330      &   maxfile_prot,nfile_cx(ii,ib,iparm))
331 #ifdef DEBUG
332         write(iout,*) "nfile_cx(ii,ib,iparm)",nfile_cx(ii,ib,iparm)
333         write(iout,*) (protfiles(i,2,ii,ib,iparm),
334      &    i=1,nfile_cx(ii,ib,iparm))
335 #endif
336       endif
337       call flush(iout)
338       enddo
339       enddo
340
341       enddo
342
343       return
344       end
345 c-------------------------------------------------------------------------------
346       subroutine opentmp(islice,iunit,bprotfile_temp)
347       implicit none
348       include "DIMENSIONS"
349       include "DIMENSIONS.ZSCOPT"
350       include "DIMENSIONS.FREE"
351 #ifdef MPI
352       include "mpif.h"
353       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
354       include "COMMON.MPI"
355 #endif
356       include "COMMON.IOUNITS"
357       include "COMMON.PROTFILES"
358       include "COMMON.PROT"
359       include "COMMON.FREE"
360       character*64 bprotfile_temp
361       character*3 liczba,liczba2
362       character*2 liczba1
363       integer iunit,islice
364       integer ilen,iroof
365       external ilen,iroof
366       logical lerr
367
368       write (liczba1,'(bz,i2.2)') islice
369       write (liczba,'(bz,i3.3)') me
370 #ifdef MPI
371 c      write (iout,*) "separate_parset ",separate_parset,
372 c     &  " myparm",myparm
373       if (separate_parset) then
374       write (liczba2,'(bz,i3.3)') myparm
375       bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
376      &  prefix(:ilen(prefix))//liczba//"_"//liczba2//".xbin.tmp"//liczba1
377       open (iunit,file=bprotfile_temp,status="unknown",
378      &    form="unformatted",access="direct",recl=lenrec)
379       else
380       bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
381      &  prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1
382       open (iunit,file=bprotfile_temp,status="unknown",
383      &    form="unformatted",access="direct",recl=lenrec)
384       endif
385 #else
386       bprotfile_temp = scratchdir(:ilen(scratchdir))//
387      &  "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1
388       open (iunit,file=bprotfile_temp,status="unknown",
389      &    form="unformatted",access="direct",recl=lenrec)
390 #endif      
391 c      write (iout,*) "OpenTmp iunit",iunit," bprotfile_temp",
392 c     &  bprotfile_temp
393 c      call flush(iout)
394       return
395       end
396 c-------------------------------------------------------------------------------
397       subroutine read_database(*)
398       implicit none
399       include "DIMENSIONS"
400       include "DIMENSIONS.ZSCOPT"
401       include "DIMENSIONS.FREE"
402 #ifdef MPI
403       include "mpif.h"
404       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
405       include "COMMON.MPI"
406 #endif
407       include "COMMON.CHAIN"
408       include "COMMON.IOUNITS"
409       include "COMMON.PROTFILES"
410       include "COMMON.NAMES"
411       include "COMMON.VAR"
412       include "COMMON.GEO"
413       include "COMMON.ENEPS"
414       include "COMMON.PROT"
415       include "COMMON.INTERACT"
416       include "COMMON.FREE"
417       include "COMMON.SBRIDGE"
418       include "COMMON.OBCINKA"
419       real*4 csingle(3,maxres2)
420       character*64 nazwa,bprotfile_temp
421       character*3 liczba
422       character*2 liczba1
423       integer i,j,ii,jj(maxslice),k,kk(maxslice),l,
424      &  ll(maxslice),mm(maxslice),if
425       integer nrec,nlines,iscor,iunit,islice
426       double precision energ
427       integer ilen,iroof
428       external ilen,iroof
429       double precision rmsdev,energia(0:max_ene),efree,eini,temp
430       double precision prop(maxQ)
431       integer ntot_all(maxslice,0:maxprocs-1), maxslice_buff
432       integer iparm,ib,iib,ir,nprop,nthr,npars
433       double precision etot,time
434       integer ixdrf,iret 
435       logical lerr,linit
436
437       lenrec1=12*(nres+nct-nnt+1)+4*(2*nss+2)+24
438       lenrec2=12*(nres+nct-nnt+1)+4*(2*nss+2)+24+8*nQ
439       lenrec=lenrec2+8
440       write (iout,*) "lenrec",lenrec," lenrec1",lenrec1,
441      &  " lenrec2",lenrec2
442
443       do i=1,nQ
444         prop(i)=0.0d0
445       enddo
446       do islice=1,nslice
447         ll(islice)=0
448         mm(islice)=0
449       enddo
450       write (iout,*) "nparmset",nparmset
451       if (hamil_rep) then
452         npars=1
453       else
454         npars=nparmset
455       endif
456       do iparm=1,npars
457
458       if (replica(iparm)) then
459         nthr = 1
460       else
461         nthr = nT_h(iparm)
462       endif
463
464       do ib=1,nthr
465       do iR=1,nRR(ib,iparm)
466
467       write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ
468       do islice=1,nslice
469         jj(islice)=0
470         kk(islice)=0
471       enddo
472
473       IF (NFILE_BIN(iR,ib,iparm).GT.0) THEN
474 c Read conformations from binary DA files (one per batch) and write them to 
475 c a binary DA scratchfile.
476         write (liczba,'(bz,i3.3)') me
477         do if=1,nfile_bin(iR,ib,iparm)
478           nazwa=protfiles(if,1,iR,ib,iparm)
479      &     (:ilen(protfiles(if,1,iR,ib,iparm)))//".bx"
480           open (ientin,file=nazwa,status="old",form="unformatted",
481      &     access="direct",recl=lenrec2,err=1111)
482           ii=0
483           do islice=1,nslice
484             call opentmp(islice,ientout,bprotfile_temp)
485             call bxread(nazwa,ii,jj(islice),kk(islice),ll(islice),
486      &        mm(islice),iR,ib,iparm)
487             close(ientout)
488           enddo
489           close(ientin)
490         enddo
491       ENDIF ! NFILE_BIN>0
492 c
493       IF (NFILE_ASC(iR,ib,iparm).GT.0) THEN
494 c Read conformations from multiple ASCII int files and write them to a binary
495 c DA scratchfile.
496         do if=1,nfile_asc(iR,ib,iparm)
497           nazwa=protfiles(if,2,iR,ib,iparm)
498      &     (:ilen(protfiles(if,2,iR,ib,iparm)))//".x"
499           open(unit=ientin,file=nazwa,status='old',err=1111)
500           write(iout,*) "reading ",nazwa(:ilen(nazwa))
501           ii=0
502           call xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm)
503         enddo ! if
504       ENDIF
505       IF (NFILE_CX(iR,ib,iparm).gt.0) THEN
506 c Read conformations from cx files and write them to a binary
507 c DA scratchfile.
508         do if=1,nfile_cx(iR,ib,iparm)
509           nazwa=protfiles(if,2,iR,ib,iparm)
510      &     (:ilen(protfiles(if,2,iR,ib,iparm)))//".cx"
511           write(iout,*) "reading ",nazwa(:ilen(nazwa))
512           ii=0
513           print *,"Calling cxread"
514           call cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm,
515      &       *1111)
516           close(ientout)
517           write (iout,*) "exit cxread"
518           call flush(iout)
519         enddo
520       ENDIF
521
522       do islice=1,nslice
523         stot(islice)=stot(islice)+jj(islice)
524       enddo
525
526       enddo
527       enddo
528       write (iout,*) "IPARM",iparm
529       enddo
530
531       if (nslice.eq.1) then
532 #ifdef MPI
533         write (liczba,'(bz,i3.3)') me
534         bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
535      &    prefix(:ilen(prefix))//liczba//".xbin.tmp"
536 #else
537         bprotfile_temp = scratchdir(:ilen(scratchdir))//
538      &     "/"//prefix(:ilen(prefix))//".xbin.tmp"
539 #endif
540         write(iout,*) mm(1)," conformations read",ll(1),
541      &    " conformations written to ", 
542      &    bprotfile_temp(:ilen(bprotfile_temp))
543       else
544         do islice=1,nslice
545           write (liczba1,'(bz,i2.2)') islice
546 #ifdef MPI
547           write (liczba,'(bz,i3.3)') me
548           bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
549      &      prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1
550 #else
551           bprotfile_temp = scratchdir(:ilen(scratchdir))//
552      &       "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1
553 #endif
554           write(iout,*) mm(islice)," conformations read",ll(islice),
555      &    " conformations written to ", 
556      &    bprotfile_temp(:ilen(bprotfile_temp))
557         enddo
558       endif
559
560 #ifdef MPI
561 c Check if everyone has the same number of conformations
562
563 c      call MPI_ALLgather(MPI_IN_PLACE,stot(1),MPI_DATATYPE_NULL,
564 c     &  ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR)
565
566       maxslice_buff=maxslice
567
568       call MPI_Allgather(stot(1),maxslice_buff,MPI_INTEGER,
569      &  ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR)
570       lerr=.false.
571       do i=0,nprocs-1
572         if (i.ne.me) then
573           do islice=1,nslice
574           if (stot(islice).ne.ntot_all(islice,i)) then
575             write (iout,*) "Number of conformations at processor",i,
576      &       " differs from that at processor",me,
577      &       stot(islice),ntot_all(islice,i)," slice",islice
578             lerr = .true.
579           endif
580           enddo
581         endif
582       enddo 
583       if (lerr) then
584         write (iout,*)
585         write (iout,*) "Numbers of conformations read by processors"
586         write (iout,*)
587         do i=0,nprocs-1
588           write (iout,'(8i10)') i,(ntot_all(islice,i),islice=1,nslice)
589         enddo
590         write (iout,*) "Calculation terminated."
591         call flush(iout)
592         return1
593       endif
594       do islice=1,nslice
595         ntot(islice)=stot(islice)
596       enddo
597       return
598 #endif
599  1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa))
600       call flush(iout)
601       return1
602       end
603 c------------------------------------------------------------------------------
604       subroutine card_concat(card,to_upper)
605       implicit none
606       include 'DIMENSIONS.ZSCOPT'
607       include "COMMON.IOUNITS"
608       character*(*) card
609       character*80 karta,ucase
610       logical to_upper
611       integer ilen
612       external ilen
613       read (inp,'(a)') karta
614       if (to_upper) karta=ucase(karta)
615       card=' '
616       do while (karta(80:80).eq.'&')
617         card=card(:ilen(card)+1)//karta(:79)
618         read (inp,'(a)') karta
619         if (to_upper) karta=ucase(karta)
620       enddo
621       card=card(:ilen(card)+1)//karta
622       return
623       end
624 c------------------------------------------------------------------------------
625       subroutine readi(rekord,lancuch,wartosc,default)
626       implicit none
627       character*(*) rekord,lancuch
628       integer wartosc,default
629       integer ilen,iread
630       external ilen
631       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
632       if (iread.eq.0) then
633         wartosc=default
634         return
635       endif
636       iread=iread+ilen(lancuch)+1
637       read (rekord(iread:),*) wartosc
638       return
639       end
640 c----------------------------------------------------------------------------
641       subroutine reada(rekord,lancuch,wartosc,default)
642       implicit none
643       character*(*) rekord,lancuch
644       character*80 aux
645       double precision wartosc,default
646       integer ilen,iread
647       external ilen
648       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
649       if (iread.eq.0) then
650         wartosc=default
651         return
652       endif
653       iread=iread+ilen(lancuch)+1
654       read (rekord(iread:),*) wartosc
655       return
656       end
657 c----------------------------------------------------------------------------
658       subroutine multreadi(rekord,lancuch,tablica,dim,default)
659       implicit none
660       integer dim,i
661       integer tablica(dim),default
662       character*(*) rekord,lancuch
663       character*80 aux
664       integer ilen,iread
665       external ilen
666       do i=1,dim
667         tablica(i)=default
668       enddo
669       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
670       if (iread.eq.0) return
671       iread=iread+ilen(lancuch)+1
672       read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
673    10 return
674       end
675 c----------------------------------------------------------------------------
676       subroutine multreada(rekord,lancuch,tablica,dim,default)
677       implicit none
678       integer dim,i
679       double precision tablica(dim),default
680       character*(*) rekord,lancuch
681       character*80 aux
682       integer ilen,iread
683       external ilen
684       do i=1,dim
685         tablica(i)=default
686       enddo
687       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
688       if (iread.eq.0) return
689       iread=iread+ilen(lancuch)+1
690       read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
691    10 return
692       end
693 c----------------------------------------------------------------------------
694       subroutine reads(rekord,lancuch,wartosc,default)
695       implicit none
696       character*(*) rekord,lancuch,wartosc,default
697       character*80 aux
698       integer ilen,lenlan,lenrec,iread,ireade
699       external ilen
700       logical iblnk
701       external iblnk
702       lenlan=ilen(lancuch)
703       lenrec=ilen(rekord)
704       iread=index(rekord,lancuch(:lenlan)//"=")
705 c      print *,"rekord",rekord," lancuch",lancuch
706 c      print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
707       if (iread.eq.0) then
708         wartosc=default
709         return
710       endif
711       iread=iread+lenlan+1
712 c      print *,"iread",iread
713 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
714       do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
715         iread=iread+1
716 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
717       enddo
718 c      print *,"iread",iread
719       if (iread.gt.lenrec) then
720          wartosc=default
721         return
722       endif
723       ireade=iread+1
724 c      print *,"ireade",ireade
725       do while (ireade.lt.lenrec .and.
726      &   .not.iblnk(rekord(ireade:ireade)))
727         ireade=ireade+1
728       enddo
729       wartosc=rekord(iread:ireade)
730       return
731       end
732 c----------------------------------------------------------------------------
733       subroutine multreads(rekord,lancuch,tablica,dim,default)
734       implicit none
735       integer dim,i
736       character*(*) rekord,lancuch,tablica(dim),default
737       character*80 aux
738       integer ilen,lenlan,lenrec,iread,ireade
739       external ilen
740       logical iblnk
741       external iblnk
742       do i=1,dim
743         tablica(i)=default
744       enddo
745       lenlan=ilen(lancuch)
746       lenrec=ilen(rekord)
747       iread=index(rekord,lancuch(:lenlan)//"=")
748 c      print *,"rekord",rekord," lancuch",lancuch
749 c      print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
750       if (iread.eq.0) return
751       iread=iread+lenlan+1
752       do i=1,dim
753 c      print *,"iread",iread
754 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
755       do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
756         iread=iread+1
757 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
758       enddo
759 c      print *,"iread",iread
760       if (iread.gt.lenrec) return
761       ireade=iread+1
762 c      print *,"ireade",ireade
763       do while (ireade.lt.lenrec .and.
764      &   .not.iblnk(rekord(ireade:ireade)))
765         ireade=ireade+1
766       enddo
767       tablica(i)=rekord(iread:ireade)
768       iread=ireade+1
769       enddo
770       end
771 c----------------------------------------------------------------------------
772       subroutine split_string(rekord,tablica,dim,nsub)
773       implicit none
774       integer dim,nsub,i,ii,ll,kk
775       character*(*) tablica(dim)
776       character*(*) rekord
777       integer ilen
778       external ilen
779       do i=1,dim
780         tablica(i)=" "
781       enddo
782       ii=1
783       ll = ilen(rekord)
784       nsub=0
785       do i=1,dim
786 C Find the start of term name
787         kk = 0
788         do while (ii.le.ll .and. rekord(ii:ii).eq." ") 
789           ii = ii+1
790         enddo
791 C Parse the name into TABLICA(i) until blank found
792         do while (ii.le.ll .and. rekord(ii:ii).ne." ") 
793           kk = kk+1
794           tablica(i)(kk:kk)=rekord(ii:ii)
795           ii = ii+1
796         enddo
797         if (kk.gt.0) nsub=nsub+1
798         if (ii.gt.ll) return
799       enddo
800       return
801       end
802 c--------------------------------------------------------------------------------
803       integer function iroof(n,m)
804       ii = n/m
805       if (ii*m .lt. n) ii=ii+1
806       iroof = ii
807       return
808       end