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