1 subroutine set_slices(is,ie,ts,te,iR,ib,iparm)
4 include 'DIMENSIONS.ZSCOPT'
5 include 'DIMENSIONS.FREE'
6 include 'COMMON.IOUNITS'
7 include 'COMMON.PROTFILES'
8 include 'COMMON.OBCINKA'
10 integer islice,iR,ib,iparm
11 integer is(MaxSlice),ie(MaxSlice),nrec_slice
12 double precision ts(MaxSlice),te(MaxSlice),time_slice
15 if (time_end_collect(iR,ib,iparm).ge.1.0d10) then
16 ts(islice)=time_start_collect(iR,ib,iparm)
17 te(islice)=time_end_collect(iR,ib,iparm)
18 nrec_slice=(rec_end(iR,ib,iparm)-
19 & rec_start(iR,ib,iparm)+1)/nslice
20 is(islice)=rec_start(iR,ib,iparm)+(islice-1)*nrec_slice
21 ie(islice)=rec_start(iR,ib,iparm)+islice*nrec_slice-1
23 time_slice=(time_end_collect(iR,ib,iparm)
24 & -time_start_collect(iR,ib,iparm))/nslice
25 ts(islice)=time_start_collect(iR,ib,iparm)+(islice-1)*
27 te(islice)=time_start_collect(iR,ib,iparm)+islice*time_slice
28 is(islice)=rec_start(iR,ib,iparm)
29 ie(islice)=rec_end(iR,ib,iparm)
33 write (iout,*) "nrec_slice",nrec_slice," time_slice",time_slice
34 write (iout,*) "is",(is(islice),islice=1,nslice)
35 write (iout,*) "ie",(ie(islice),islice=1,nslice)
36 write (iout,*) "rec_start",
37 & rec_start(iR,ib,iparm)," rec_end",rec_end(iR,ib,iparm)
38 write (iout,*) "ts",(ts(islice),islice=1,nslice)
39 write (iout,*) "te",(te(islice),islice=1,nslice)
40 write (iout,*) "time_start",
41 & time_start_collect(iR,ib,iparm)," time_end",
42 & time_end_collect(iR,ib,iparm)
47 c-----------------------------------------------------------------------------
48 integer function slice(irecord,time,is,ie,ts,te)
51 include 'DIMENSIONS.ZSCOPT'
52 include 'DIMENSIONS.FREE'
53 include 'COMMON.IOUNITS'
54 include 'COMMON.PROTFILES'
55 include 'COMMON.OBCINKA'
57 integer is(MaxSlice),ie(MaxSlice),nrec_slice
58 double precision ts(MaxSlice),te(MaxSlice),time_slice
62 c write (iout,*) "within slice nslice",nslice
64 if (irecord.lt.is(1) .or. time.lt.ts(1)) then
68 do while (ii.le.nslice .and.
69 & (irecord.lt.is(ii) .or. irecord.gt.ie(ii) .or.
70 & time.lt.ts(ii) .or. time.gt.te(ii)) )
71 c write (iout,*) "ii",ii,time,ts(ii)
76 c write (iout,*) "end: ii",ii