source/wham/src-new/readrtns.F.orig

   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       character*800 controlcard
  21       integer i,j,k,ii,n_ene_found
  22       integer ind,itype1,itype2,itypf,itypsc,itypp
  23       integer ilen
  24       external ilen
  25       character*16 ucase
  26       character*16 key
  27       external ucase
  28
  29       call card_concat(controlcard,.true.)
  30       call readi(controlcard,"N_ENE",n_ene,max_ene)
  31       if (n_ene.gt.max_ene) then
  32         write (iout,*) "Error: parameter out of range: N_ENE",n_ene,
  33      &    max_ene
  34         return1
  35       endif
  36       call readi(controlcard,"NPARMSET",nparmset,1)
  37       separate_parset = index(controlcard,"SEPARATE_PARSET").gt.0
  38       call readi(controlcard,"IPARMPRINT",iparmprint,1)
  39       write (iout,*) "PARMPRINT",iparmprint
  40       if (nparmset.gt.max_parm) then
  41         write (iout,*) "Error: parameter out of range: NPARMSET",
  42      &    nparmset, Max_Parm
  43         return1
  44       endif
  45       call readi(controlcard,"MAXIT",maxit,5000)
  46       call reada(controlcard,"FIMIN",fimin,1.0d-3)
  47       call readi(controlcard,"ENSEMBLES",ensembles,0)
  48       hamil_rep=index(controlcard,"HAMIL_REP").gt.0
  49       write (iout,*) "Number of energy parameter sets",nparmset
  50       call multreadi(controlcard,"ISAMPL",isampl,nparmset,1)
  51       write (iout,*) "MaxSlice",MaxSlice
  52       call readi(controlcard,"NSLICE",nslice,1)
  53       call flush(iout)
  54       if (nslice.gt.MaxSlice) then
  55         write (iout,*) "Error: parameter out of range: NSLICE",nslice,
  56      &    MaxSlice
  57         return1
  58       endif
  59       write (iout,*) "Frequency of storing conformations",
  60      & (isampl(i),i=1,nparmset)
  61       write (iout,*) "Maxit",maxit," Fimin",fimin
  62       call readi(controlcard,"NQ",nQ,1)
  63       if (nQ.gt.MaxQ) then
  64         write (iout,*) "Error: parameter out of range: NQ",nq,
  65      &    maxq
  66         return1
  67       endif
  68       indpdb=0
  69       if (index(controlcard,"CLASSIFY").gt.0) indpdb=1
  70       call reada(controlcard,"DELTA",delta,1.0d-2)
  71       call readi(controlcard,"EINICHECK",einicheck,2)
  72       call reada(controlcard,"DELTRMS",deltrms,5.0d-2)
  73       call readi(controlcard,"NGRIDT",NGridT,400)
  74       call reada(controlcard,"STARTGRIDT",StartGridT,200.0d0)
  75       call reada(controlcard,"DELTA_T",Delta_T,1.0d0)
  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       write (iout,*) "delta",delta
  80       write (iout,*) "einicheck",einicheck
  81       write (iout,*) "rescale_mode",rescale_mode
  82       call flush(iout)
  83       bxfile=index(controlcard,"BXFILE").gt.0
  84       cxfile=index(controlcard,"CXFILE").gt.0
  85       if (nslice .eq. 1 .and. .not.bxfile .and. .not.cxfile)
  86      & bxfile=.true.
  87       histfile=index(controlcard,"HISTFILE").gt.0
  88       histout=index(controlcard,"HISTOUT").gt.0
  89       entfile=index(controlcard,"ENTFILE").gt.0
  90       zscfile=index(controlcard,"ZSCFILE").gt.0
  91       with_dihed_constr = index(controlcard,"WITH_DIHED_CONSTR").gt.0
  92       call readi(controlcard,'CONSTR_DIST',constr_dist,0)
  93       write (iout,*) "with_dihed_constr ",with_dihed_constr,
  94      & " CONSTR_DIST",constr_dist
  95       refstr = index(controlcard,'REFSTR').gt.0
  96       pdbref = index(controlcard,'PDBREF').gt.0
  97       call flush(iout)
  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)
 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       write (iout,*) "nparmset",nparmset
 420       if (hamil_rep) then
 421         npars=1
 422       else
 423         npars=nparmset
 424       endif
 425       do iparm=1,npars
 426
 427       if (replica(iparm)) then
 428         nthr = 1
 429       else
 430         nthr = nT_h(iparm)
 431       endif
 432
 433       do i=1,nQ
 434         prop(i)=0.0d0
 435       enddo
 436       do islice=1,nslice
 437         ll(islice)=0
 438         mm(islice)=0
 439       enddo
 440
 441       do ib=1,nthr
 442       do iR=1,nRR(ib,iparm)
 443
 444       write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ
 445       do islice=1,nslice
 446         jj(islice)=0
 447         kk(islice)=0
 448       enddo
 449
 450       IF (NFILE_BIN(iR,ib,iparm).GT.0) THEN
 451 c Read conformations from binary DA files (one per batch) and write them to
 452 c a binary DA scratchfile.
 453         write (liczba,'(bz,i3.3)') me
 454         do if=1,nfile_bin(iR,ib,iparm)
 455           nazwa=protfiles(if,1,iR,ib,iparm)
 456      &     (:ilen(protfiles(if,1,iR,ib,iparm)))//".bx"
 457           open (ientin,file=nazwa,status="old",form="unformatted",
 458      &     access="direct",recl=lenrec2,err=1111)
 459           ii=0
 460           do islice=1,nslice
 461             call opentmp(islice,ientout,bprotfile_temp)
 462             call bxread(nazwa,ii,jj(islice),kk(islice),ll(islice),
 463      &        mm(islice),iR,ib,iparm)
 464             close(ientout)
 465           enddo
 466           close(ientin)
 467         enddo
 468       ENDIF ! NFILE_BIN>0
 469 c
 470       IF (NFILE_ASC(iR,ib,iparm).GT.0) THEN
 471 c Read conformations from multiple ASCII int files and write them to a binary
 472 c DA scratchfile.
 473         do if=1,nfile_asc(iR,ib,iparm)
 474           nazwa=protfiles(if,2,iR,ib,iparm)
 475      &     (:ilen(protfiles(if,2,iR,ib,iparm)))//".x"
 476           open(unit=ientin,file=nazwa,status='old',err=1111)
 477           write(iout,*) "reading ",nazwa(:ilen(nazwa))
 478           ii=0
 479           call xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm)
 480         enddo ! if
 481       ENDIF
 482       IF (NFILE_CX(iR,ib,iparm).gt.0) THEN
 483 c Read conformations from cx files and write them to a binary
 484 c DA scratchfile.
 485         do if=1,nfile_cx(iR,ib,iparm)
 486           nazwa=protfiles(if,2,iR,ib,iparm)
 487      &     (:ilen(protfiles(if,2,iR,ib,iparm)))//".cx"
 488           write(iout,*) "reading ",nazwa(:ilen(nazwa))
 489           ii=0
 490           print *,"Calling cxread"
 491           call cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm,
 492      &       *1111)
 493           close(ientout)
 494           write (iout,*) "exit cxread"
 495           call flush(iout)
 496         enddo
 497       ENDIF
 498
 499       do islice=1,nslice
 500         stot(islice)=stot(islice)+jj(islice)
 501       enddo
 502
 503       enddo
 504       enddo
 505       write (iout,*) "IPARM",iparm
 506       enddo
 507
 508       if (nslice.eq.1) then
 509 #ifdef MPI
 510         write (liczba,'(bz,i3.3)') me
 511         bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
 512      &    prefix(:ilen(prefix))//liczba//".xbin.tmp"
 513 #else
 514         bprotfile_temp = scratchdir(:ilen(scratchdir))//
 515      &     "/"//prefix(:ilen(prefix))//".xbin.tmp"
 516 #endif
 517         write(iout,*) mm(1)," conformations read",ll(1),
 518      &    " conformations written to ",
 519      &    bprotfile_temp(:ilen(bprotfile_temp))
 520       else
 521         do islice=1,nslice
 522           write (liczba1,'(bz,i2.2)') islice
 523 #ifdef MPI
 524           write (liczba,'(bz,i3.3)') me
 525           bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
 526      &      prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1
 527 #else
 528           bprotfile_temp = scratchdir(:ilen(scratchdir))//
 529      &       "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1
 530 #endif
 531           write(iout,*) mm(islice)," conformations read",ll(islice),
 532      &    " conformations written to ",
 533      &    bprotfile_temp(:ilen(bprotfile_temp))
 534         enddo
 535       endif
 536
 537 #ifdef MPI
 538 c Check if everyone has the same number of conformations
 539       call MPI_Allgather(stot(1),maxslice,MPI_INTEGER,
 540      &  ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR)
 541       lerr=.false.
 542       do i=0,nprocs-1
 543         if (i.ne.me) then
 544           do islice=1,nslice
 545           if (stot(islice).ne.ntot_all(islice,i)) then
 546             write (iout,*) "Number of conformations at processor",i,
 547      &       " differs from that at processor",me,
 548      &       stot(islice),ntot_all(islice,i)," slice",islice
 549             lerr = .true.
 550           endif
 551           enddo
 552         endif
 553       enddo
 554       if (lerr) then
 555         write (iout,*)
 556         write (iout,*) "Numbers of conformations read by processors"
 557         write (iout,*)
 558         do i=0,nprocs-1
 559           write (iout,'(8i10)') i,(ntot_all(islice,i),islice=1,nslice)
 560         enddo
 561         write (iout,*) "Calculation terminated."
 562         call flush(iout)
 563         return1
 564       endif
 565       do islice=1,nslice
 566         ntot(islice)=stot(islice)
 567       enddo
 568       return
 569 #endif
 570  1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa))
 571       call flush(iout)
 572       return1
 573       end
 574 c------------------------------------------------------------------------------
 575       subroutine card_concat(card,to_upper)
 576       implicit none
 577       include 'DIMENSIONS.ZSCOPT'
 578       include "COMMON.IOUNITS"
 579       character*(*) card
 580       character*80 karta,ucase
 581       logical to_upper
 582       integer ilen
 583       external ilen
 584       read (inp,'(a)') karta
 585       if (to_upper) karta=ucase(karta)
 586       card=' '
 587       do while (karta(80:80).eq.'&')
 588         card=card(:ilen(card)+1)//karta(:79)
 589         read (inp,'(a)') karta
 590         if (to_upper) karta=ucase(karta)
 591       enddo
 592       card=card(:ilen(card)+1)//karta
 593       return
 594       end
 595 c------------------------------------------------------------------------------
 596       subroutine readi(rekord,lancuch,wartosc,default)
 597       implicit none
 598       character*(*) rekord,lancuch
 599       integer wartosc,default
 600       integer ilen,iread
 601       external ilen
 602       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
 603       if (iread.eq.0) then
 604         wartosc=default
 605         return
 606       endif
 607       iread=iread+ilen(lancuch)+1
 608       read (rekord(iread:),*) wartosc
 609       return
 610       end
 611 c----------------------------------------------------------------------------
 612       subroutine reada(rekord,lancuch,wartosc,default)
 613       implicit none
 614       character*(*) rekord,lancuch
 615       character*80 aux
 616       double precision wartosc,default
 617       integer ilen,iread
 618       external ilen
 619       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
 620       if (iread.eq.0) then
 621         wartosc=default
 622         return
 623       endif
 624       iread=iread+ilen(lancuch)+1
 625       read (rekord(iread:),*) wartosc
 626       return
 627       end
 628 c----------------------------------------------------------------------------
 629       subroutine multreadi(rekord,lancuch,tablica,dim,default)
 630       implicit none
 631       integer dim,i
 632       integer tablica(dim),default
 633       character*(*) rekord,lancuch
 634       character*80 aux
 635       integer ilen,iread
 636       external ilen
 637       do i=1,dim
 638         tablica(i)=default
 639       enddo
 640       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
 641       if (iread.eq.0) return
 642       iread=iread+ilen(lancuch)+1
 643       read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
 644    10 return
 645       end
 646 c----------------------------------------------------------------------------
 647       subroutine multreada(rekord,lancuch,tablica,dim,default)
 648       implicit none
 649       integer dim,i
 650       double precision tablica(dim),default
 651       character*(*) rekord,lancuch
 652       character*80 aux
 653       integer ilen,iread
 654       external ilen
 655       do i=1,dim
 656         tablica(i)=default
 657       enddo
 658       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
 659       if (iread.eq.0) return
 660       iread=iread+ilen(lancuch)+1
 661       read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
 662    10 return
 663       end
 664 c----------------------------------------------------------------------------
 665       subroutine reads(rekord,lancuch,wartosc,default)
 666       implicit none
 667       character*(*) rekord,lancuch,wartosc,default
 668       character*80 aux
 669       integer ilen,lenlan,lenrec,iread,ireade
 670       external ilen
 671       logical iblnk
 672       external iblnk
 673       lenlan=ilen(lancuch)
 674       lenrec=ilen(rekord)
 675       iread=index(rekord,lancuch(:lenlan)//"=")
 676 c      print *,"rekord",rekord," lancuch",lancuch
 677 c      print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
 678       if (iread.eq.0) then
 679         wartosc=default
 680         return
 681       endif
 682       iread=iread+lenlan+1
 683 c      print *,"iread",iread
 684 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
 685       do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
 686         iread=iread+1
 687 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
 688       enddo
 689 c      print *,"iread",iread
 690       if (iread.gt.lenrec) then
 691          wartosc=default
 692         return
 693       endif
 694       ireade=iread+1
 695 c      print *,"ireade",ireade
 696       do while (ireade.lt.lenrec .and.
 697      &   .not.iblnk(rekord(ireade:ireade)))
 698         ireade=ireade+1
 699       enddo
 700       wartosc=rekord(iread:ireade)
 701       return
 702       end
 703 c----------------------------------------------------------------------------
 704       subroutine multreads(rekord,lancuch,tablica,dim,default)
 705       implicit none
 706       integer dim,i
 707       character*(*) rekord,lancuch,tablica(dim),default
 708       character*80 aux
 709       integer ilen,lenlan,lenrec,iread,ireade
 710       external ilen
 711       logical iblnk
 712       external iblnk
 713       do i=1,dim
 714         tablica(i)=default
 715       enddo
 716       lenlan=ilen(lancuch)
 717       lenrec=ilen(rekord)
 718       iread=index(rekord,lancuch(:lenlan)//"=")
 719 c      print *,"rekord",rekord," lancuch",lancuch
 720 c      print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
 721       if (iread.eq.0) return
 722       iread=iread+lenlan+1
 723       do i=1,dim
 724 c      print *,"iread",iread
 725 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
 726       do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
 727         iread=iread+1
 728 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
 729       enddo
 730 c      print *,"iread",iread
 731       if (iread.gt.lenrec) return
 732       ireade=iread+1
 733 c      print *,"ireade",ireade
 734       do while (ireade.lt.lenrec .and.
 735      &   .not.iblnk(rekord(ireade:ireade)))
 736         ireade=ireade+1
 737       enddo
 738       tablica(i)=rekord(iread:ireade)
 739       iread=ireade+1
 740       enddo
 741       end
 742 c----------------------------------------------------------------------------
 743       subroutine split_string(rekord,tablica,dim,nsub)
 744       implicit none
 745       integer dim,nsub,i,ii,ll,kk
 746       character*(*) tablica(dim)
 747       character*(*) rekord
 748       integer ilen
 749       external ilen
 750       do i=1,dim
 751         tablica(i)=" "
 752       enddo
 753       ii=1
 754       ll = ilen(rekord)
 755       nsub=0
 756       do i=1,dim
 757 C Find the start of term name
 758         kk = 0
 759         do while (ii.le.ll .and. rekord(ii:ii).eq." ")
 760           ii = ii+1
 761         enddo
 762 C Parse the name into TABLICA(i) until blank found
 763         do while (ii.le.ll .and. rekord(ii:ii).ne." ")
 764           kk = kk+1
 765           tablica(i)(kk:kk)=rekord(ii:ii)
 766           ii = ii+1
 767         enddo
 768         if (kk.gt.0) nsub=nsub+1
 769         if (ii.gt.ll) return
 770       enddo
 771       return
 772       end
 773 c--------------------------------------------------------------------------------
 774       integer function iroof(n,m)
 775       ii = n/m
 776       if (ii*m .lt. n) ii=ii+1
 777       iroof = ii
 778       return
 779       end