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