source/wham/src-NEWSC-NEWCORR/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       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       energy_dec=index(controlcard,"ENERGY_DEC").gt.0
  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 readi(controlcard,"NGRIDT",NGridT,400)
  75       call reada(controlcard,"STARTGRIDT",StartGridT,200.0d0)
  76       call reada(controlcard,"DELTA_T",Delta_T,1.0d0)
  77       call reada(controlcard,"DELTRGY",deltrgy,5.0d-2)
  78       call readi(controlcard,"RESCALE",rescale_mode,1)
  79       check_conf=index(controlcard,"NO_CHECK_CONF").eq.0
  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       call readi(controlcard,'CONSTR_DIST',constr_dist,0)
  94       write (iout,*) "with_dihed_constr ",with_dihed_constr,
  95      & " CONSTR_DIST",constr_dist
  96       refstr = index(controlcard,'REFSTR').gt.0
  97       pdbref = index(controlcard,'PDBREF').gt.0
  98       call flush(iout)
  99       return
 100       end
 101 c------------------------------------------------------------------------------
 102       subroutine read_efree(*)
 103 C
 104 C Read molecular data
 105 C
 106       implicit none
 107       include 'DIMENSIONS'
 108       include 'DIMENSIONS.ZSCOPT'
 109       include 'DIMENSIONS.COMPAR'
 110       include 'DIMENSIONS.FREE'
 111       include 'COMMON.IOUNITS'
 112       include 'COMMON.TIME1'
 113       include 'COMMON.SBRIDGE'
 114       include 'COMMON.CONTROL'
 115       include 'COMMON.CHAIN'
 116       include 'COMMON.HEADER'
 117       include 'COMMON.GEO'
 118       include 'COMMON.FREE'
 119       character*320 controlcard,ucase
 120       integer iparm,ib,i,j,npars
 121       integer ilen
 122       external ilen
 123
 124       if (hamil_rep) then
 125         npars=1
 126       else
 127         npars=nParmSet
 128       endif
 129
 130       do iparm=1,npars
 131
 132       call card_concat(controlcard,.true.)
 133       call readi(controlcard,'NT',nT_h(iparm),1)
 134       write (iout,*) "iparm",iparm," nt",nT_h(iparm)
 135       call flush(iout)
 136       if (nT_h(iparm).gt.MaxT_h) then
 137         write (iout,*)  "Error: parameter out of range: NT",nT_h(iparm),
 138      &    MaxT_h
 139         return1
 140       endif
 141       replica(iparm)=index(controlcard,"REPLICA").gt.0
 142       umbrella(iparm)=index(controlcard,"UMBRELLA").gt.0
 143       read_iset(iparm)=index(controlcard,"READ_ISET").gt.0
 144       write (iout,*) "nQ",nQ," nT",nT_h(iparm)," replica ",
 145      &  replica(iparm)," umbrella ",umbrella(iparm),
 146      &  " read_iset",read_iset(iparm)
 147       call flush(iout)
 148       do ib=1,nT_h(iparm)
 149         call card_concat(controlcard,.true.)
 150         call readi(controlcard,'NR',nR(ib,iparm),1)
 151         if (umbrella(iparm)) then
 152           nRR(ib,iparm)=1
 153         else
 154           nRR(ib,iparm)=nR(ib,iparm)
 155         endif
 156         if (nR(ib,iparm).gt.MaxR) then
 157           write (iout,*)  "Error: parameter out of range: NR",
 158      &      nR(ib,iparm),MaxR
 159         return1
 160         endif
 161         call reada(controlcard,'TEMP',beta_h(ib,iparm),298.0d0)
 162         beta_h(ib,iparm)=1.0d0/(beta_h(ib,iparm)*1.987D-3)
 163         call multreada(controlcard,'FI',f(1,ib,iparm),nR(ib,iparm),
 164      &    0.0d0)
 165         do i=1,nR(ib,iparm)
 166           call card_concat(controlcard,.true.)
 167           call multreada(controlcard,'KH',KH(1,i,ib,iparm),nQ,
 168      &      100.0d0)
 169           call multreada(controlcard,'Q0',Q0(1,i,ib,iparm),nQ,
 170      &      0.0d0)
 171         enddo
 172       enddo
 173       do ib=1,nT_h(iparm)
 174         write (iout,*) "ib",ib," beta_h",
 175      &    1.0d0/(0.001987*beta_h(ib,iparm))
 176         write (iout,*) "nR",nR(ib,iparm)
 177         write (iout,*) "fi",(f(i,ib,iparm),i=1,nR(ib,iparm))
 178         do i=1,nR(ib,iparm)
 179           write (iout,*) "i",i," Kh",(Kh(j,i,ib,iparm),j=1,nQ),
 180      &      "q0",(q0(j,i,ib,iparm),j=1,nQ)
 181         enddo
 182         call flush(iout)
 183       enddo
 184
 185       enddo
 186
 187       if (hamil_rep) then
 188
 189        do iparm=2,nParmSet
 190           nT_h(iparm)=nT_h(1)
 191          do ib=1,nT_h(iparm)
 192            nR(ib,iparm)=nR(ib,1)
 193            if (umbrella(iparm)) then
 194              nRR(ib,iparm)=1
 195            else
 196              nRR(ib,iparm)=nR(ib,1)
 197            endif
 198            beta_h(ib,iparm)=beta_h(ib,1)
 199            do i=1,nR(ib,iparm)
 200              f(i,ib,iparm)=f(i,ib,1)
 201              do j=1,nQ
 202                KH(j,i,ib,iparm)=KH(j,i,ib,1)
 203                Q0(j,i,ib,iparm)=Q0(j,i,ib,1)
 204              enddo
 205            enddo
 206            replica(iparm)=replica(1)
 207            umbrella(iparm)=umbrella(1)
 208            read_iset(iparm)=read_iset(1)
 209          enddo
 210        enddo
 211
 212       endif
 213
 214       return
 215       end
 216 c-----------------------------------------------------------------------------
 217       subroutine read_protein_data(*)
 218       implicit none
 219       include "DIMENSIONS"
 220       include "DIMENSIONS.ZSCOPT"
 221       include "DIMENSIONS.FREE"
 222 #ifdef MPI
 223       include "mpif.h"
 224       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
 225       include "COMMON.MPI"
 226 #endif
 227       include "COMMON.CHAIN"
 228       include "COMMON.IOUNITS"
 229       include "COMMON.PROT"
 230       include "COMMON.PROTFILES"
 231       include "COMMON.NAMES"
 232       include "COMMON.FREE"
 233       include "COMMON.OBCINKA"
 234       character*64 nazwa
 235       character*16000 controlcard
 236       integer i,ii,ib,iR,iparm,ilen,iroof,nthr,npars
 237       external ilen,iroof
 238       if (hamil_rep) then
 239         npars=1
 240       else
 241         npars=nparmset
 242       endif
 243
 244       do iparm=1,npars
 245
 246 C Read names of files with conformation data.
 247       if (replica(iparm)) then
 248         nthr = 1
 249       else
 250         nthr = nT_h(iparm)
 251       endif
 252       do ib=1,nthr
 253       do ii=1,nRR(ib,iparm)
 254       write (iout,*) "Parameter set",iparm," temperature",ib,
 255      & " window",ii
 256       call flush(iout)
 257       call card_concat(controlcard,.true.)
 258       write (iout,*) controlcard(:ilen(controlcard))
 259       call readi(controlcard,"NFILE_BIN",nfile_bin(ii,ib,iparm),0)
 260       call readi(controlcard,"NFILE_ASC",nfile_asc(ii,ib,iparm),0)
 261       call readi(controlcard,"NFILE_CX",nfile_cx(ii,ib,iparm),0)
 262       call readi(controlcard,"REC_START",rec_start(ii,ib,iparm),1)
 263       call readi(controlcard,"REC_END",rec_end(ii,ib,iparm),
 264      & maxstr*isampl(iparm)+rec_start(ii,ib,iparm)-1)
 265       call reada(controlcard,"TIME_START",
 266      &  time_start_collect(ii,ib,iparm),0.0d0)
 267       call reada(controlcard,"TIME_END",time_end_collect(ii,ib,iparm),
 268      &  1.0d10)
 269       write (iout,*) "rec_start",rec_start(ii,ib,iparm),
 270      & " rec_end",rec_end(ii,ib,iparm)
 271       write (iout,*) "time_start",time_start_collect(ii,ib,iparm),
 272      & " time_end",time_end_collect(ii,ib,iparm)
 273       call flush(iout)
 274       if (replica(iparm)) then
 275         call readi(controlcard,"TOTRAJ",totraj(ii,iparm),1)
 276         write (iout,*) "Number of trajectories",totraj(ii,iparm)
 277         call flush(iout)
 278       endif
 279       if (nfile_bin(ii,ib,iparm).lt.2
 280      &    .and. nfile_asc(ii,ib,iparm).eq.0
 281      &    .and. nfile_cx(ii,ib,iparm).eq.0) then
 282         write (iout,*) "Error - no action specified!"
 283         return1
 284       endif
 285       if (nfile_bin(ii,ib,iparm).gt.0) then
 286         call card_concat(controlcard,.false.)
 287         call split_string(controlcard,protfiles(1,1,ii,ib,iparm),
 288      &   maxfile_prot,nfile_bin(ii,ib,iparm))
 289 #ifdef DEBUG
 290         write(iout,*)"nfile_bin",nfile_bin(ii,ib,iparm)
 291         write(iout,*) (protfiles(i,1,ii,ib,iparm),
 292      &    i=1,nfile_bin(ii,ib,iparm))
 293 #endif
 294       endif
 295       if (nfile_asc(ii,ib,iparm).gt.0) then
 296         call card_concat(controlcard,.false.)
 297         call split_string(controlcard,protfiles(1,2,ii,ib,iparm),
 298      &   maxfile_prot,nfile_asc(ii,ib,iparm))
 299 #ifdef DEBUG
 300         write(iout,*) "nfile_asc(ii,ib,iparm)",nfile_asc(ii,ib,iparm)
 301         write(iout,*) (protfiles(i,2,ii,ib,iparm),
 302      &    i=1,nfile_asc(ii,ib,iparm))
 303 #endif
 304       else if (nfile_cx(ii,ib,iparm).gt.0) then
 305         call card_concat(controlcard,.false.)
 306         call split_string(controlcard,protfiles(1,2,ii,ib,iparm),
 307      &   maxfile_prot,nfile_cx(ii,ib,iparm))
 308 #ifdef DEBUG
 309         write(iout,*) "nfile_cx(ii,ib,iparm)",nfile_cx(ii,ib,iparm)
 310         write(iout,*) (protfiles(i,2,ii,ib,iparm),
 311      &    i=1,nfile_cx(ii,ib,iparm))
 312 #endif
 313       endif
 314       call flush(iout)
 315       enddo
 316       enddo
 317
 318       enddo
 319
 320       return
 321       end
 322 c-------------------------------------------------------------------------------
 323       subroutine opentmp(islice,iunit,bprotfile_temp)
 324       implicit none
 325       include "DIMENSIONS"
 326       include "DIMENSIONS.ZSCOPT"
 327       include "DIMENSIONS.FREE"
 328 #ifdef MPI
 329       include "mpif.h"
 330       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
 331       include "COMMON.MPI"
 332 #endif
 333       include "COMMON.IOUNITS"
 334       include "COMMON.PROTFILES"
 335       include "COMMON.PROT"
 336       include "COMMON.FREE"
 337       character*64 bprotfile_temp
 338       character*3 liczba,liczba2
 339       character*2 liczba1
 340       integer iunit,islice
 341       integer ilen,iroof
 342       external ilen,iroof
 343       logical lerr
 344
 345       write (liczba1,'(bz,i2.2)') islice
 346       write (liczba,'(bz,i3.3)') me
 347 #ifdef MPI
 348 c      write (iout,*) "separate_parset ",separate_parset,
 349 c     &  " myparm",myparm
 350       if (separate_parset) then
 351       write (liczba2,'(bz,i3.3)') myparm
 352       bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
 353      &  prefix(:ilen(prefix))//liczba//"_"//liczba2//".xbin.tmp"//liczba1
 354       open (iunit,file=bprotfile_temp,status="unknown",
 355      &    form="unformatted",access="direct",recl=lenrec)
 356       else
 357       bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"//
 358      &  prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1
 359       open (iunit,file=bprotfile_temp,status="unknown",
 360      &    form="unformatted",access="direct",recl=lenrec)
 361       endif
 362 #else
 363       bprotfile_temp = scratchdir(:ilen(scratchdir))//
 364      &  "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1
 365       open (iunit,file=bprotfile_temp,status="unknown",
 366      &    form="unformatted",access="direct",recl=lenrec)
 367 #endif
 368 c      write (iout,*) "OpenTmp iunit",iunit," bprotfile_temp",
 369 c     &  bprotfile_temp
 370 c      call flush(iout)
 371       return
 372       end
 373 c-------------------------------------------------------------------------------
 374       subroutine read_database(*)
 375       implicit none
 376       include "DIMENSIONS"
 377       include "DIMENSIONS.ZSCOPT"
 378       include "DIMENSIONS.FREE"
 379 #ifdef MPI
 380       include "mpif.h"
 381       integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE)
 382       include "COMMON.MPI"
 383 #endif
 384       include "COMMON.CHAIN"
 385       include "COMMON.IOUNITS"
 386       include "COMMON.PROTFILES"
 387       include "COMMON.NAMES"
 388       include "COMMON.VAR"
 389       include "COMMON.GEO"
 390       include "COMMON.ENEPS"
 391       include "COMMON.PROT"
 392       include "COMMON.INTERACT"
 393       include "COMMON.FREE"
 394       include "COMMON.SBRIDGE"
 395       include "COMMON.OBCINKA"
 396       real*4 csingle(3,maxres2)
 397       character*64 nazwa,bprotfile_temp
 398       character*3 liczba
 399       character*2 liczba1
 400       integer i,j,ii,jj(maxslice),k,kk(maxslice),l,
 401      &  ll(maxslice),mm(maxslice),if
 402       integer nrec,nlines,iscor,iunit,islice
 403       double precision energ
 404       integer ilen,iroof
 405       external ilen,iroof
 406       double precision rmsdev,energia(0:max_ene),efree,eini,temp
 407       double precision prop(maxQ)
 408       integer ntot_all(maxslice,0:maxprocs-1)
 409       integer iparm,ib,iib,ir,nprop,nthr,npars
 410       double precision etot,time
 411       integer ixdrf,iret
 412       logical lerr,linit
 413
 414       lenrec1=12*(nres+nct-nnt+1)+4*(2*nss+2)+24
 415       lenrec2=12*(nres+nct-nnt+1)+4*(2*nss+2)+24+8*nQ
 416       lenrec=lenrec2+8
 417       write (iout,*) "lenrec",lenrec," lenrec1",lenrec1,
 418      &  " lenrec2",lenrec2
 419
 420       do i=1,nQ
 421         prop(i)=0.0d0
 422       enddo
 423       do islice=1,nslice
 424         ll(islice)=0
 425         mm(islice)=0
 426       enddo
 427       write (iout,*) "nparmset",nparmset
 428       if (hamil_rep) then
 429         npars=1
 430       else
 431         npars=nparmset
 432       endif
 433       do iparm=1,npars
 434
 435       if (replica(iparm)) then
 436         nthr = 1
 437       else
 438         nthr = nT_h(iparm)
 439       endif
 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