subroutine read_general_data(*) implicit none include "DIMENSIONS" include "DIMENSIONS.ZSCOPT" include "DIMENSIONS.FREE" include "COMMON.TORSION" include "COMMON.INTERACT" include "COMMON.IOUNITS" include "COMMON.TIME1" include "COMMON.PROT" include "COMMON.PROTFILES" include "COMMON.CHAIN" include "COMMON.NAMES" include "COMMON.FFIELD" include "COMMON.ENEPS" include "COMMON.WEIGHTS" include "COMMON.FREE" include "COMMON.CONTROL" include "COMMON.ENERGIES" character*800 controlcard integer i,j,k,ii,n_ene_found integer ind,itype1,itype2,itypf,itypsc,itypp integer ilen external ilen character*16 ucase character*16 key external ucase call card_concat(controlcard,.true.) call readi(controlcard,"N_ENE",n_ene,max_ene) if (n_ene.gt.max_ene) then write (iout,*) "Error: parameter out of range: N_ENE",n_ene, & max_ene return1 endif call readi(controlcard,"NPARMSET",nparmset,1) if (nparmset.gt.max_parm) then write (iout,*) "Error: parameter out of range: NPARMSET", & nparmset, Max_Parm return1 endif call readi(controlcard,"MAXIT",maxit,5000) call reada(controlcard,"FIMIN",fimin,1.0d-3) call readi(controlcard,"ENSEMBLES",ensembles,0) write (iout,*) "Number of energy parameter sets",nparmset call multreadi(controlcard,"ISAMPL",isampl,nparmset,1) write (iout,*) "MaxSlice",MaxSlice call readi(controlcard,"NSLICE",nslice,1) call flush(iout) if (nslice.gt.MaxSlice) then write (iout,*) "Error: parameter out of range: NSLICE",nslice, & MaxSlice return1 endif write (iout,*) "Frequency of storing conformations", & (isampl(i),i=1,nparmset) write (iout,*) "Maxit",maxit," Fimin",fimin call readi(controlcard,"NQ",nQ,1) if (nQ.gt.MaxQ) then write (iout,*) "Error: parameter out of range: NQ",nq, & maxq return1 endif indpdb=0 if (index(controlcard,"CLASSIFY").gt.0) indpdb=1 call reada(controlcard,"DELTA",delta,1.0d-2) call readi(controlcard,"EINICHECK",einicheck,2) call reada(controlcard,"DELTRMS",deltrms,5.0d-2) call reada(controlcard,"DELTRGY",deltrgy,5.0d-2) call readi(controlcard,"RESCALE",rescale_mode,1) write (iout,*) "delta",delta write (iout,*) "einicheck",einicheck write (iout,*) "rescale_mode",rescale_mode call flush(iout) bxfile=index(controlcard,"BXFILE").gt.0 cxfile=index(controlcard,"CXFILE").gt.0 if (nslice .eq. 1 .and. .not.bxfile .and. .not.cxfile) & bxfile=.true. histfile=index(controlcard,"HISTFILE").gt.0 entfile=index(controlcard,"ENTFILE").gt.0 zscfile=index(controlcard,"ZSCFILE").gt.0 return end c------------------------------------------------------------------------------ subroutine read_efree(iparm,*) C C Read molecular data C implicit none include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.COMPAR' include 'DIMENSIONS.FREE' include 'COMMON.IOUNITS' include 'COMMON.TIME1' include 'COMMON.SBRIDGE' include 'COMMON.CONTROL' include 'COMMON.CHAIN' include 'COMMON.HEADER' include 'COMMON.GEO' include 'COMMON.FREE' character*320 controlcard,ucase integer iparm,ib,i,j integer ilen external ilen call card_concat(controlcard,.true.) call readi(controlcard,'NT',nT_h(iparm),1) if (nT_h(iparm).gt.MaxT_h) then write (iout,*) "Error: parameter out of range: NT",nT_h(iparm), & MaxT_h return1 endif replica(iparm)=index(controlcard,"REPLICA").gt.0 umbrella(iparm)=index(controlcard,"UMBRELLA").gt.0 read_iset(iparm)=index(controlcard,"READ_ISET").gt.0 write (iout,*) "nQ",nQ," nT",nT_h(iparm)," replica ", & replica(iparm)," umbrella ",umbrella(iparm), & " read_iset",read_iset(iparm) call flush(iout) do ib=1,nT_h(iparm) call card_concat(controlcard,.true.) call readi(controlcard,'NR',nR(ib,iparm),1) if (umbrella(iparm)) then nRR(ib,iparm)=1 else nRR(ib,iparm)=nR(ib,iparm) endif if (nR(ib,iparm).gt.MaxR) then write (iout,*) "Error: parameter out of range: NR", & nR(ib,iparm),MaxR return1 endif call reada(controlcard,'TEMP',beta_h(ib,iparm),298.0d0) beta_h(ib,iparm)=1.0d0/(beta_h(ib,iparm)*1.987D-3) call multreada(controlcard,'FI',f(1,ib,iparm),nR(ib,iparm), & 0.0d0) do i=1,nR(ib,iparm) call card_concat(controlcard,.true.) call multreada(controlcard,'KH',KH(1,i,ib,iparm),nQ, & 100.0d0) call multreada(controlcard,'Q0',Q0(1,i,ib,iparm),nQ, & 0.0d0) enddo enddo do ib=1,nT_h(iparm) write (iout,*) "ib",ib," beta_h", & 1.0d0/(0.001987*beta_h(ib,iparm)) write (iout,*) "nR",nR(ib,iparm) write (iout,*) "fi",(f(i,ib,iparm),i=1,nR(ib,iparm)) do i=1,nR(ib,iparm) write (iout,*) "i",i," Kh",(Kh(j,i,ib,iparm),j=1,nQ), & "q0",(q0(j,i,ib,iparm),j=1,nQ) enddo call flush(iout) enddo return end c----------------------------------------------------------------------------- subroutine read_protein_data(iparm,*) implicit none include "DIMENSIONS" include "DIMENSIONS.ZSCOPT" include "DIMENSIONS.FREE" #ifdef MPI include "mpif.h" integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) include "COMMON.MPI" #endif include "COMMON.CHAIN" include "COMMON.IOUNITS" include "COMMON.PROT" include "COMMON.PROTFILES" include "COMMON.NAMES" include "COMMON.FREE" include "COMMON.OBCINKA" character*64 nazwa character*16000 controlcard integer i,ii,ib,iR,iparm,ilen,iroof,nthr external ilen,iroof call flush(iout) C Read names of files with conformation data. if (replica(iparm)) then nthr = 1 else nthr = nT_h(iparm) endif do ib=1,nthr do ii=1,nRR(ib,iparm) write (iout,*) "Parameter set",iparm," temperature",ib, & " window",ii call card_concat(controlcard,.true.) write (iout,*) controlcard(:ilen(controlcard)) call readi(controlcard,"NFILE_BIN",nfile_bin(ii,ib,iparm),0) call readi(controlcard,"NFILE_ASC",nfile_asc(ii,ib,iparm),0) call readi(controlcard,"NFILE_CX",nfile_cx(ii,ib,iparm),0) call readi(controlcard,"REC_START",rec_start(ii,ib,iparm),1) call readi(controlcard,"REC_END",rec_end(ii,ib,iparm), & maxstr*isampl(iparm)+rec_start(ii,ib,iparm)-1) call reada(controlcard,"TIME_START", & time_start_collect(ii,ib,iparm),0.0d0) call reada(controlcard,"TIME_END",time_end_collect(ii,ib,iparm), & 1.0d10) write (iout,*) "rec_start",rec_start(ii,ib,iparm), & " rec_end",rec_end(ii,ib,iparm) write (iout,*) "time_start",time_start_collect(ii,ib,iparm), & " time_end",time_end_collect(ii,ib,iparm) call flush(iout) if (replica(iparm)) then call readi(controlcard,"TOTRAJ",totraj(ii,iparm),1) write (iout,*) "Number of trajectories",totraj(ii,iparm) call flush(iout) endif if (nfile_bin(ii,ib,iparm).lt.2 & .and. nfile_asc(ii,ib,iparm).eq.0 & .and. nfile_cx(ii,ib,iparm).eq.0) then write (iout,*) "Error - no action specified!" return1 endif if (nfile_bin(ii,ib,iparm).gt.0) then call card_concat(controlcard,.false.) call split_string(controlcard,protfiles(1,1,ii,ib,iparm), & maxfile_prot,nfile_bin(ii,ib,iparm)) #ifdef DEBUG write(iout,*)"nfile_bin",nfile_bin(ii,ib,iparm) write(iout,*) (protfiles(i,1,ii,ib,iparm), & i=1,nfile_bin(ii,ib,iparm)) #endif endif if (nfile_asc(ii,ib,iparm).gt.0) then call card_concat(controlcard,.false.) call split_string(controlcard,protfiles(1,2,ii,ib,iparm), & maxfile_prot,nfile_asc(ii,ib,iparm)) #ifdef DEBUG write(iout,*) "nfile_asc(ii,ib,iparm)",nfile_asc(ii,ib,iparm) write(iout,*) (protfiles(i,2,ii,ib,iparm), & i=1,nfile_asc(ii,ib,iparm)) #endif else if (nfile_cx(ii,ib,iparm).gt.0) then call card_concat(controlcard,.false.) call split_string(controlcard,protfiles(1,2,ii,ib,iparm), & maxfile_prot,nfile_cx(ii,ib,iparm)) #ifdef DEBUG write(iout,*) "nfile_cx(ii,ib,iparm)",nfile_cx(ii,ib,iparm) write(iout,*) (protfiles(i,2,ii,ib,iparm), & i=1,nfile_cx(ii,ib,iparm)) #endif endif call flush(iout) enddo enddo return end c------------------------------------------------------------------------------- subroutine opentmp(islice,iunit,bprotfile_temp) implicit none include "DIMENSIONS" include "DIMENSIONS.ZSCOPT" include "DIMENSIONS.FREE" #ifdef MPI include "mpif.h" integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) include "COMMON.MPI" #endif include "COMMON.IOUNITS" include "COMMON.PROTFILES" include "COMMON.PROT" character*64 bprotfile_temp character*3 liczba character*2 liczba1 integer iunit,islice integer ilen,iroof external ilen,iroof logical lerr write (liczba1,'(bz,i2.2)') islice #ifdef MPI write (liczba,'(bz,i3.3)') me bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// & prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1 open (iunit,file=bprotfile_temp,status="unknown", & form="unformatted",access="direct",recl=lenrec) #else bprotfile_temp = scratchdir(:ilen(scratchdir))// & "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1 open (iunit,file=bprotfile_temp,status="unknown", & form="unformatted",access="direct",recl=lenrec) #endif return end c------------------------------------------------------------------------------- subroutine read_database(*) implicit none include "DIMENSIONS" include "DIMENSIONS.ZSCOPT" include "DIMENSIONS.FREE" #ifdef MPI include "mpif.h" integer IERROR,ERRCODE,STATUS(MPI_STATUS_SIZE) include "COMMON.MPI" #endif include "COMMON.CHAIN" include "COMMON.IOUNITS" include "COMMON.PROTFILES" include "COMMON.NAMES" include "COMMON.VAR" include "COMMON.GEO" include "COMMON.ENEPS" include "COMMON.PROT" include "COMMON.INTERACT" include "COMMON.FREE" include "COMMON.SBRIDGE" include "COMMON.OBCINKA" real*4 csingle(3,maxres2) character*64 nazwa,bprotfile_temp character*3 liczba character*2 liczba1 integer i,j,ii,jj(maxslice),k,kk(maxslice),l, & ll(maxslice),mm(maxslice),if integer nrec,nlines,iscor,iunit,islice double precision energ integer ilen,iroof external ilen,iroof double precision rmsdev,energia(0:max_ene),efree,eini,temp double precision prop(maxQ) integer ntot_all(maxslice,0:maxprocs-1) integer iparm,ib,iib,ir,nprop,nthr double precision etot,time integer ixdrf,iret logical lerr,linit lenrec1=12*(nres+nct-nnt+1)+4*(2*nss+2)+24 lenrec2=12*(nres+nct-nnt+1)+4*(2*nss+2)+24+8*nQ lenrec=lenrec2+8 write (iout,*) "lenrec",lenrec," lenrec1",lenrec1, & " lenrec2",lenrec2 do i=1,nQ prop(i)=0.0d0 enddo do islice=1,nslice ll(islice)=0 mm(islice)=0 enddo write (iout,*) "nparmset",nparmset do iparm=1,nparmset if (replica(iparm)) then nthr = 1 else nthr = nT_h(iparm) endif do ib=1,nthr do iR=1,nRR(ib,iparm) write (iout,*) "iparm",iparm," ib",ib," iR",iR," nQ",nQ do islice=1,nslice jj(islice)=0 kk(islice)=0 enddo IF (NFILE_BIN(iR,ib,iparm).GT.0) THEN c Read conformations from binary DA files (one per batch) and write them to c a binary DA scratchfile. write (liczba,'(bz,i3.3)') me do if=1,nfile_bin(iR,ib,iparm) nazwa=protfiles(if,1,iR,ib,iparm) & (:ilen(protfiles(if,1,iR,ib,iparm)))//".bx" open (ientin,file=nazwa,status="old",form="unformatted", & access="direct",recl=lenrec2,err=1111) ii=0 do islice=1,nslice call opentmp(islice,ientout,bprotfile_temp) call bxread(nazwa,ii,jj(islice),kk(islice),ll(islice), & mm(islice),iR,ib,iparm) close(ientout) enddo close(ientin) enddo ENDIF ! NFILE_BIN>0 c IF (NFILE_ASC(iR,ib,iparm).GT.0) THEN c Read conformations from multiple ASCII int files and write them to a binary c DA scratchfile. do if=1,nfile_asc(iR,ib,iparm) nazwa=protfiles(if,2,iR,ib,iparm) & (:ilen(protfiles(if,2,iR,ib,iparm)))//".x" open(unit=ientin,file=nazwa,status='old',err=1111) write(iout,*) "reading ",nazwa(:ilen(nazwa)) ii=0 call xread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm) enddo ! if ENDIF IF (NFILE_CX(iR,ib,iparm).gt.0) THEN c Read conformations from cx files and write them to a binary c DA scratchfile. do if=1,nfile_cx(iR,ib,iparm) nazwa=protfiles(if,2,iR,ib,iparm) & (:ilen(protfiles(if,2,iR,ib,iparm)))//".cx" write(iout,*) "reading ",nazwa(:ilen(nazwa)) ii=0 print *,"Calling cxread" call cxread(nazwa,ii,jj,kk,ll,mm,iR,ib,iparm, & *1111) close(ientout) write (iout,*) "exit cxread" call flush(iout) enddo ENDIF do islice=1,nslice stot(islice)=stot(islice)+jj(islice) enddo enddo enddo write (iout,*) "IPARM",iparm enddo if (nslice.eq.1) then #ifdef MPI write (liczba,'(bz,i3.3)') me bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// & prefix(:ilen(prefix))//liczba//".xbin.tmp" #else bprotfile_temp = scratchdir(:ilen(scratchdir))// & "/"//prefix(:ilen(prefix))//".xbin.tmp" #endif write(iout,*) mm(1)," conformations read",ll(1), & " conformations written to ", & bprotfile_temp(:ilen(bprotfile_temp)) else do islice=1,nslice write (liczba1,'(bz,i2.2)') islice #ifdef MPI write (liczba,'(bz,i3.3)') me bprotfile_temp = scratchdir(:ilen(scratchdir))//"/"// & prefix(:ilen(prefix))//liczba//".xbin.tmp"//liczba1 #else bprotfile_temp = scratchdir(:ilen(scratchdir))// & "/"//prefix(:ilen(prefix))//".xbin.tmp"//liczba1 #endif write(iout,*) mm(islice)," conformations read",ll(islice), & " conformations written to ", & bprotfile_temp(:ilen(bprotfile_temp)) enddo endif #ifdef MPI c Check if everyone has the same number of conformations call MPI_Allgather(stot(1),maxslice,MPI_INTEGER, & ntot_all(1,0),maxslice,MPI_INTEGER,MPI_Comm_World,IERROR) lerr=.false. do i=0,nprocs-1 if (i.ne.me) then do islice=1,nslice if (stot(islice).ne.ntot_all(islice,i)) then write (iout,*) "Number of conformations at processor",i, & " differs from that at processor",me, & stot(islice),ntot_all(islice,i)," slice",islice lerr = .true. endif enddo endif enddo if (lerr) then write (iout,*) write (iout,*) "Numbers of conformations read by processors" write (iout,*) do i=0,nprocs-1 write (iout,'(8i10)') i,(ntot_all(islice,i),islice=1,nslice) enddo write (iout,*) "Calculation terminated." call flush(iout) return1 endif do islice=1,nslice ntot(islice)=stot(islice) enddo return #endif 1111 write(iout,*) "Error opening coordinate file ",nazwa(:ilen(nazwa)) call flush(iout) return1 end c------------------------------------------------------------------------------ subroutine card_concat(card,to_upper) implicit none include 'DIMENSIONS.ZSCOPT' include "COMMON.IOUNITS" character*(*) card character*80 karta,ucase logical to_upper integer ilen external ilen read (inp,'(a)') karta if (to_upper) karta=ucase(karta) card=' ' do while (karta(80:80).eq.'&') card=card(:ilen(card)+1)//karta(:79) read (inp,'(a)') karta if (to_upper) karta=ucase(karta) enddo card=card(:ilen(card)+1)//karta return end c------------------------------------------------------------------------------ subroutine readi(rekord,lancuch,wartosc,default) implicit none character*(*) rekord,lancuch integer wartosc,default integer ilen,iread external ilen iread=index(rekord,lancuch(:ilen(lancuch))//"=") if (iread.eq.0) then wartosc=default return endif iread=iread+ilen(lancuch)+1 read (rekord(iread:),*) wartosc return end c---------------------------------------------------------------------------- subroutine reada(rekord,lancuch,wartosc,default) implicit none character*(*) rekord,lancuch character*80 aux double precision wartosc,default integer ilen,iread external ilen iread=index(rekord,lancuch(:ilen(lancuch))//"=") if (iread.eq.0) then wartosc=default return endif iread=iread+ilen(lancuch)+1 read (rekord(iread:),*) wartosc return end c---------------------------------------------------------------------------- subroutine multreadi(rekord,lancuch,tablica,dim,default) implicit none integer dim,i integer tablica(dim),default character*(*) rekord,lancuch character*80 aux integer ilen,iread external ilen do i=1,dim tablica(i)=default enddo iread=index(rekord,lancuch(:ilen(lancuch))//"=") if (iread.eq.0) return iread=iread+ilen(lancuch)+1 read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) 10 return end c---------------------------------------------------------------------------- subroutine multreada(rekord,lancuch,tablica,dim,default) implicit none integer dim,i double precision tablica(dim),default character*(*) rekord,lancuch character*80 aux integer ilen,iread external ilen do i=1,dim tablica(i)=default enddo iread=index(rekord,lancuch(:ilen(lancuch))//"=") if (iread.eq.0) return iread=iread+ilen(lancuch)+1 read (rekord(iread:),*,end=10,err=10) (tablica(i),i=1,dim) 10 return end c---------------------------------------------------------------------------- subroutine reads(rekord,lancuch,wartosc,default) implicit none character*(*) rekord,lancuch,wartosc,default character*80 aux integer ilen,lenlan,lenrec,iread,ireade external ilen logical iblnk external iblnk lenlan=ilen(lancuch) lenrec=ilen(rekord) iread=index(rekord,lancuch(:lenlan)//"=") c print *,"rekord",rekord," lancuch",lancuch c print *,"iread",iread," lenlan",lenlan," lenrec",lenrec if (iread.eq.0) then wartosc=default return endif iread=iread+lenlan+1 c print *,"iread",iread c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) do while (iread.le.lenrec .and. iblnk(rekord(iread:iread))) iread=iread+1 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) enddo c print *,"iread",iread if (iread.gt.lenrec) then wartosc=default return endif ireade=iread+1 c print *,"ireade",ireade do while (ireade.lt.lenrec .and. & .not.iblnk(rekord(ireade:ireade))) ireade=ireade+1 enddo wartosc=rekord(iread:ireade) return end c---------------------------------------------------------------------------- subroutine multreads(rekord,lancuch,tablica,dim,default) implicit none integer dim,i character*(*) rekord,lancuch,tablica(dim),default character*80 aux integer ilen,lenlan,lenrec,iread,ireade external ilen logical iblnk external iblnk do i=1,dim tablica(i)=default enddo lenlan=ilen(lancuch) lenrec=ilen(rekord) iread=index(rekord,lancuch(:lenlan)//"=") c print *,"rekord",rekord," lancuch",lancuch c print *,"iread",iread," lenlan",lenlan," lenrec",lenrec if (iread.eq.0) return iread=iread+lenlan+1 do i=1,dim c print *,"iread",iread c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) do while (iread.le.lenrec .and. iblnk(rekord(iread:iread))) iread=iread+1 c print *,"|",rekord(iread:iread),"|",iblnk(rekord(iread:iread)) enddo c print *,"iread",iread if (iread.gt.lenrec) return ireade=iread+1 c print *,"ireade",ireade do while (ireade.lt.lenrec .and. & .not.iblnk(rekord(ireade:ireade))) ireade=ireade+1 enddo tablica(i)=rekord(iread:ireade) iread=ireade+1 enddo end c---------------------------------------------------------------------------- subroutine split_string(rekord,tablica,dim,nsub) implicit none integer dim,nsub,i,ii,ll,kk character*(*) tablica(dim) character*(*) rekord integer ilen external ilen do i=1,dim tablica(i)=" " enddo ii=1 ll = ilen(rekord) nsub=0 do i=1,dim C Find the start of term name kk = 0 do while (ii.le.ll .and. rekord(ii:ii).eq." ") ii = ii+1 enddo C Parse the name into TABLICA(i) until blank found do while (ii.le.ll .and. rekord(ii:ii).ne." ") kk = kk+1 tablica(i)(kk:kk)=rekord(ii:ii) ii = ii+1 enddo if (kk.gt.0) nsub=nsub+1 if (ii.gt.ll) return enddo return end c-------------------------------------------------------------------------------- integer function iroof(n,m) ii = n/m if (ii*m .lt. n) ii=ii+1 iroof = ii return end