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