source/wham/src/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       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       call flush(iout)
  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)
 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       call MPI_Allgather(stot(1),maxslice,MPI_INTEGER,
 537      &  ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR)
 538       lerr=.false.
 539       do i=0,nprocs-1
 540         if (i.ne.me) then
 541           do islice=1,nslice
 542           if (stot(islice).ne.ntot_all(islice,i)) then
 543             write (iout,*) "Number of conformations at processor",i,
 544      &       " differs from that at processor",me,
 545      &       stot(islice),ntot_all(islice,i)," slice",islice
 546             lerr = .true.
 547           endif
 548           enddo
 549         endif
 550       enddo
 551       if (lerr) then
 552         write (iout,*)
 553         write (iout,*) "Numbers of conformations read by processors"
 554         write (iout,*)
 555         do i=0,nprocs-1
 556           write (iout,'(8i10)') i,(ntot_all(islice,i),islice=1,nslice)
 557         enddo
 558         write (iout,*) "Calculation terminated."
 559         call flush(iout)
 560         return1
 561       endif
 562       do islice=1,nslice
 563         ntot(islice)=stot(islice)
 564       enddo
 565       return
 566 #endif
 567  1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa))
 568       call flush(iout)
 569       return1
 570       end
 571 c------------------------------------------------------------------------------
 572       subroutine card_concat(card,to_upper)
 573       implicit none
 574       include 'DIMENSIONS.ZSCOPT'
 575       include "COMMON.IOUNITS"
 576       character*(*) card
 577       character*80 karta,ucase
 578       logical to_upper
 579       integer ilen
 580       external ilen
 581       read (inp,'(a)') karta
 582       if (to_upper) karta=ucase(karta)
 583       card=' '
 584       do while (karta(80:80).eq.'&')
 585         card=card(:ilen(card)+1)//karta(:79)
 586         read (inp,'(a)') karta
 587         if (to_upper) karta=ucase(karta)
 588       enddo
 589       card=card(:ilen(card)+1)//karta
 590       return
 591       end
 592 c------------------------------------------------------------------------------
 593       subroutine readi(rekord,lancuch,wartosc,default)
 594       implicit none
 595       character*(*) rekord,lancuch
 596       integer wartosc,default
 597       integer ilen,iread
 598       external ilen
 599       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
 600       if (iread.eq.0) then
 601         wartosc=default
 602         return
 603       endif
 604       iread=iread+ilen(lancuch)+1
 605       read (rekord(iread:),*) wartosc
 606       return
 607       end
 608 c----------------------------------------------------------------------------
 609       subroutine reada(rekord,lancuch,wartosc,default)
 610       implicit none
 611       character*(*) rekord,lancuch
 612       character*80 aux
 613       double precision wartosc,default
 614       integer ilen,iread
 615       external ilen
 616       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
 617       if (iread.eq.0) then
 618         wartosc=default
 619         return
 620       endif
 621       iread=iread+ilen(lancuch)+1
 622       read (rekord(iread:),*) wartosc
 623       return
 624       end
 625 c----------------------------------------------------------------------------
 626       subroutine multreadi(rekord,lancuch,tablica,dim,default)
 627       implicit none
 628       integer dim,i
 629       integer tablica(dim),default
 630       character*(*) rekord,lancuch
 631       character*80 aux
 632       integer ilen,iread
 633       external ilen
 634       do i=1,dim
 635         tablica(i)=default
 636       enddo
 637       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
 638       if (iread.eq.0) return
 639       iread=iread+ilen(lancuch)+1
 640       read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
 641    10 return
 642       end
 643 c----------------------------------------------------------------------------
 644       subroutine multreada(rekord,lancuch,tablica,dim,default)
 645       implicit none
 646       integer dim,i
 647       double precision tablica(dim),default
 648       character*(*) rekord,lancuch
 649       character*80 aux
 650       integer ilen,iread
 651       external ilen
 652       do i=1,dim
 653         tablica(i)=default
 654       enddo
 655       iread=index(rekord,lancuch(:ilen(lancuch))//"=")
 656       if (iread.eq.0) return
 657       iread=iread+ilen(lancuch)+1
 658       read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim)
 659    10 return
 660       end
 661 c----------------------------------------------------------------------------
 662       subroutine reads(rekord,lancuch,wartosc,default)
 663       implicit none
 664       character*(*) rekord,lancuch,wartosc,default
 665       character*80 aux
 666       integer ilen,lenlan,lenrec,iread,ireade
 667       external ilen
 668       logical iblnk
 669       external iblnk
 670       lenlan=ilen(lancuch)
 671       lenrec=ilen(rekord)
 672       iread=index(rekord,lancuch(:lenlan)//"=")
 673 c      print *,"rekord",rekord," lancuch",lancuch
 674 c      print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
 675       if (iread.eq.0) then
 676         wartosc=default
 677         return
 678       endif
 679       iread=iread+lenlan+1
 680 c      print *,"iread",iread
 681 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
 682       do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
 683         iread=iread+1
 684 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
 685       enddo
 686 c      print *,"iread",iread
 687       if (iread.gt.lenrec) then
 688          wartosc=default
 689         return
 690       endif
 691       ireade=iread+1
 692 c      print *,"ireade",ireade
 693       do while (ireade.lt.lenrec .and.
 694      &   .not.iblnk(rekord(ireade:ireade)))
 695         ireade=ireade+1
 696       enddo
 697       wartosc=rekord(iread:ireade)
 698       return
 699       end
 700 c----------------------------------------------------------------------------
 701       subroutine multreads(rekord,lancuch,tablica,dim,default)
 702       implicit none
 703       integer dim,i
 704       character*(*) rekord,lancuch,tablica(dim),default
 705       character*80 aux
 706       integer ilen,lenlan,lenrec,iread,ireade
 707       external ilen
 708       logical iblnk
 709       external iblnk
 710       do i=1,dim
 711         tablica(i)=default
 712       enddo
 713       lenlan=ilen(lancuch)
 714       lenrec=ilen(rekord)
 715       iread=index(rekord,lancuch(:lenlan)//"=")
 716 c      print *,"rekord",rekord," lancuch",lancuch
 717 c      print *,"iread",iread," lenlan",lenlan," lenrec",lenrec
 718       if (iread.eq.0) return
 719       iread=iread+lenlan+1
 720       do i=1,dim
 721 c      print *,"iread",iread
 722 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
 723       do while (iread.le.lenrec .and. iblnk(rekord(iread:iread)))
 724         iread=iread+1
 725 c      print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread))
 726       enddo
 727 c      print *,"iread",iread
 728       if (iread.gt.lenrec) return
 729       ireade=iread+1
 730 c      print *,"ireade",ireade
 731       do while (ireade.lt.lenrec .and.
 732      &   .not.iblnk(rekord(ireade:ireade)))
 733         ireade=ireade+1
 734       enddo
 735       tablica(i)=rekord(iread:ireade)
 736       iread=ireade+1
 737       enddo
 738       end
 739 c----------------------------------------------------------------------------
 740       subroutine split_string(rekord,tablica,dim,nsub)
 741       implicit none
 742       integer dim,nsub,i,ii,ll,kk
 743       character*(*) tablica(dim)
 744       character*(*) rekord
 745       integer ilen
 746       external ilen
 747       do i=1,dim
 748         tablica(i)=" "
 749       enddo
 750       ii=1
 751       ll = ilen(rekord)
 752       nsub=0
 753       do i=1,dim
 754 C Find the start of term name
 755         kk = 0
 756         do while (ii.le.ll .and. rekord(ii:ii).eq." ")
 757           ii = ii+1
 758         enddo
 759 C Parse the name into TABLICA(i) until blank found
 760         do while (ii.le.ll .and. rekord(ii:ii).ne." ")
 761           kk = kk+1
 762           tablica(i)(kk:kk)=rekord(ii:ii)
 763           ii = ii+1
 764         enddo
 765         if (kk.gt.0) nsub=nsub+1
 766         if (ii.gt.ll) return
 767       enddo
 768       return
 769       end
 770 c--------------------------------------------------------------------------------
 771       integer function iroof(n,m)
 772       ii = n/m
 773       if (ii*m .lt. n) ii=ii+1
 774       iroof = ii
 775       return
 776       end