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