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