X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Fwham%2Fsrc-NEWSC%2Fslices.F;fp=source%2Fwham%2Fsrc-NEWSC%2Fslices.F;h=b22ea13cab5b7646402412f5819f3ce63814273a;hb=d101c97dea752458d76055fdbae49c26fff03c1f;hp=0000000000000000000000000000000000000000;hpb=325eda160c9ad2982501e091ca40606a29043712;p=unres.git diff --git a/source/wham/src-NEWSC/slices.F b/source/wham/src-NEWSC/slices.F new file mode 100755 index 0000000..b22ea13 --- /dev/null +++ b/source/wham/src-NEWSC/slices.F @@ -0,0 +1,80 @@ + subroutine set_slices(is,ie,ts,te,iR,ib,iparm) + implicit none + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'DIMENSIONS.FREE' + include 'COMMON.IOUNITS' + include 'COMMON.PROTFILES' + include 'COMMON.OBCINKA' + include 'COMMON.PROT' + integer islice,iR,ib,iparm + integer is(MaxSlice),ie(MaxSlice),nrec_slice + double precision ts(MaxSlice),te(MaxSlice),time_slice + + do islice=1,nslice + if (time_end_collect(iR,ib,iparm).ge.1.0d10) then + ts(islice)=time_start_collect(iR,ib,iparm) + te(islice)=time_end_collect(iR,ib,iparm) + nrec_slice=(rec_end(iR,ib,iparm)- + & rec_start(iR,ib,iparm)+1)/nslice + is(islice)=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice + ie(islice)=rec_start(iR,ib,iparm)+islice*nrec_slice-1 + else + time_slice=(time_end_collect(iR,ib,iparm) + & -time_start_collect(iR,ib,iparm))/nslice + ts(islice)=time_start_collect(iR,ib,iparm)+(islice-1)* + & time_slice + te(islice)=time_start_collect(iR,ib,iparm)+islice*time_slice + is(islice)=rec_start(iR,ib,iparm) + ie(islice)=rec_end(iR,ib,iparm) + endif + enddo + + write (iout,*) "nrec_slice",nrec_slice," time_slice",time_slice + write (iout,*) "is",(is(islice),islice=1,nslice) + write (iout,*) "ie",(ie(islice),islice=1,nslice) + write (iout,*) "rec_start", + & rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm) + write (iout,*) "ts",(ts(islice),islice=1,nslice) + write (iout,*) "te",(te(islice),islice=1,nslice) + write (iout,*) "time_start", + & time_start_collect(iR,ib,iparm)," time_end", + & time_end_collect(iR,ib,iparm) + call flush(iout) + + return + end +c----------------------------------------------------------------------------- + integer function slice(irecord,time,is,ie,ts,te) + implicit none + include 'DIMENSIONS' + include 'DIMENSIONS.ZSCOPT' + include 'DIMENSIONS.FREE' + include 'COMMON.IOUNITS' + include 'COMMON.PROTFILES' + include 'COMMON.OBCINKA' + include 'COMMON.PROT' + integer is(MaxSlice),ie(MaxSlice),nrec_slice + double precision ts(MaxSlice),te(MaxSlice),time_slice + integer i,ii,irecord + double precision time + +c write (iout,*) "within slice nslice",nslice +c call flush(iout) + if (irecord.lt.is(1) .or. time.lt.ts(1)) then + ii=0 + else + ii=1 + do while (ii.le.nslice .and. + & (irecord.lt.is(ii) .or. irecord.gt.ie(ii) .or. + & time.lt.ts(ii) .or. time.gt.te(ii)) ) +c write (iout,*) "ii",ii,time,ts(ii) +c call flush(iout) + ii=ii+1 + enddo + endif +c write (iout,*) "end: ii",ii +c call flush(iout) + slice=ii + return + end