      program monitor
*     ------- ------

      include 'Online.cmm'

      character*15 tem
      character*15 forc
      character*12 ras
      character*17 plat
      character*14 daily
      character*160 line 
      integer system
        common/fgerewee/first
        logical first
        data first/.true./



        common /pawc/ hmem(500000)
        call hlimit(500000)

C--
C last sequence reading set if timefirst=24 and timelast=24
C--
	ilastseq=0
        istat=system(' rm glucheck.dat ')

C--
C set calibration mode flag '1' iso '0'
C--
        icalmode=0
	dircalset='bolxx' ! bolxx=via datum else pointer to dir
C--
C set local disc use flag in case of Paling problems to '1' iso '0'
C set KAKAP D disc use flag irasloc=2
C--
	irasloc=2  
	index=0
	open(34,file='steer.txt')
 210    continue
	   read(34,'(a)',ERR=230,END=230)line
	   if (line(1:1).eq.'*') goto 210
	   index=index+1
	   if (index.eq.1) read(line,*,ERR=220,END=220)irasloc
	   if (index.eq.2) then
                if (line(1:5).ne.'bolxx') then
	           read(line,*,ERR=220,END=220)dircalset
		endif
	   endif
	   if (index.eq.3)  then
		read(line,*,ERR=220,END=220)icalmode
	        goto 230
	   endif
        goto 210
 219	goto 230
 220	print *,'!!! WARNING steer.txt=================='
 	print *,'file steer.txt not read properly '
	print *,'END WARNING steer.txt=================='
	stop
 230	continue
        close(34)

	idir=0
	do i=1,40
	  if (dircalset(i:i).eq.'' .and. idir.eq.0) idir=i-1
	  if (dircalset(i:i).eq.' ' .and. idir.eq.0) idir=i-1
	enddo
	print *,'LOCATION RASNIK FILE FLAG ',irasloc
	print *,'USE CALIBRATION SET FLAG ',dircalset
	print *,'RUN CALIBRATION MODE FLAG ',icalmode
C--
C
C--
	itemploc=0 ! obsolete
	iforceloc=0 ! obsolete

C--
C
C--
	do i=1,10
		ierror(i)=0
	enddo
	do i=1,100
	   namech(i)='empty'
	enddo

        do inp=1,4
           y_db(inp)=0
           z_db(inp)=0
           rotz_db(inp)=0
           scale_db(inp)=0
           ey_db(inp)=0
           ez_db(inp)=0
           erotz_db(inp)=0
           escale_db(inp)=0
           counts_db(inp)=0
        enddo


      open(34,file='database_steer.txt')
        read(34,*)database_t1
        read(34,*)database_t2
      close(34)


C--
C-- see what timespan to process
C--
      open(34,file='timespan.txt')
        read(34,*)timemin
        read(34,*)timemax
      close(34)
C      if (timemax.ge.24 .and. timemin.ge.24) then read last sequence,see below
      if (timemax.eq.0 .and. timemin.eq.0) then
         open(34,file='timelast.txt')
           read(34,*)timelast
         close(34)
* get tunix        
         istat=system(' date \'+%H\' > time.txt ')
         istat=system(' date \'+%M\' >> time.txt ')
         open(34,file='time.txt')
         read(34,*)ih
         read(34,*)im
         close(34)
         tunix=float(ih)+float(im)/60.
* end tunix
         timemin=tunix-timelast
         timemax=tunix+timelast
      endif
C-- end timespan
C-- see what to do with datum
      open(34,file='datum.txt')
        read(34,*)idatum
        idatum_org=idatum
      close(34)
      if (idatum.eq.0) then
         istat=system(' date \'+%Y%m%d\' > datum.txt ')
      endif
      open(34,file='datum.txt')
      read(34,*)datum
      close(34)
      write(*,*)datum
C-- read date as integer
      open(34,file='datum.txt')
        read(34,*)idatum
      close(34)
C-- for next go
      open(34,file='datum.txt')
        write(34,*)idatum_org
      close(34)

      dag=datum(5:8)
      if (timemax.ge.24 .and. timemin.ge.24) then 
	  timemin=0.
	  timemax=24.
	  rname='seq.res'
          write(*,*)rname
	  ilastseq=1
      else
	if (idatum.lt.20000101) then
          daily='Daily.'//datum
          rname=daily//'.res'
          write(*,*)rname
        elseif (idatum.gt.20010501 .and. idatum.lt.20010615) then
          plat='platform.'//datum
          rname=plat//'.res'
          write(*,*)rname
        else
          ras='ras.'//datum
          rname=ras//'.res'
          write(*,*)rname
        endif
      endif


      tem='BOLtemp'//datum
      tname=tem//'.txt'
      write(*,*)tname

      forc='SagComp'//datum
      forcename=forc//'.txt'



      if (icalmode.eq.1 .or. icalmode.eq.2) call readseqs
      if (icalmode.eq.2) call initseqs



      ifile=2
      call readtemp(ifile)
      close(2)
      ifile=2
*OLD      call readforce(ifile)
      close(2)
*     ----
      call read
*     ----

      print *
      print *,' # of succesful cycles : ',ncyc
	
c--
c database stuff out
c--
      do i=1,4
         if (counts_db(inp).gt.0) then
            y_db(inp)=y_db(inp)/counts_db(inp)
            z_db(inp)=z_db(inp)/counts_db(inp)
            rotz_db(inp)=rotz_db(inp)/counts_db(inp)
            scale_db(inp)=scale_db(inp)/counts_db(inp)
            ey_db(inp)=ey_db(inp)/counts_db(inp)
            ez_db(inp)=ez_db(inp)/counts_db(inp)
            erotz_db(inp)=erotz_db(inp)/counts_db(inp)
            escale_db(inp)=escale_db(inp)/counts_db(inp)
            ey=sqrt(ey_db(inp)-y_db(inp)*y_db(inp))
            ez=sqrt(ez_db(inp)-z_db(inp)*z_db(inp))
            erotz=sqrt(erotz_db(inp)-rotz_db(inp)*rotz_db(inp))
            escale=sqrt(escale_db(inp)-scale_db(inp)*scale_db(inp))
         endif
      open(34,file='database.txt')
      write(34,2034)inp, z_db(inp),y_db(inp),scale_db(inp),rotz_db(inp)
      write(34,2034)inp, ez, ey , escale, erotz
      enddo
      close(34)
 2034 format(I1,1x,F9.4,1x,F9.4,1x,F9.4,1x,F9.4)
c
c--
c

      end

      subroutine read
*     ---------- ----
  	include 'getcor.cmm' 
  
       common/fgerewee/first
        logical first


	integer system

      include 'Online.cmm'

      character*125 chline
      character*11 kname

      character*59 comm,comm_prev
      character*2  tprob,pprob
      character*3  resu
      character*16 sname
      character*16 gsname(100)
      character*16 csname(100)
      character*16 ssname(100)
      real gxy(100,2)
      real cxy(100,2)
      real sxy(100,2)
      character*11 fntup
      character*27 cpntup


      character*80 aline
      character*1  devch(5)

      dimension value(9)

* ---------

      ipass=0

	fntup='ntuple.'//dag

      print *,'rname = ',rname         
      print *,'Start Time = ',timemin
      ifile=1
      if (irasloc.le.1) then
         call rasfile(ifile,rname)
      elseif(irasloc.eq.2) then
C pladys         call rasfile_smb(ifile,rname)
         call rasfile_h73(ifile,rname)
      else	
	 print *,' IRASLOC UNKNOWN '
	 stop
      endif

      write(*,*)'file opened ',rname
      read(1,'(a)')aline
      print *,'first line=',aline
      rewind 1

      istat=system('rm raw.dat') 
      istat=system('rm correction.dat') 
      istat=system('rm ntuple.ascii') 
      istat=system('rm forces.dat') 
      print *,' old ntuple remove ',istat
      open(33,file='raw.dat')
      open(34,file='correction.dat')
      open(35,file='ntuple.ascii')
      open(36,file='glucheck.dat')
      open(37,file='forces.dat')
	ioldseq=-1

      print *,
     +   'SYSTEM: TIME h:m(.fh)     X:        Y:',
     +   '         SCALE:      ROTZ:  '

      nch=1
      ns=1
      nrasnik=0
      trasnik(1)=-1
      trasnik(2)=-1

      ncyc=1
      time_prev = -1.0
      comm_prev = 'NO COMMENT'
      mcomm     = 1
*
*  Read Loop
*  ---------
       do igroup=1,4
          do ilayer=1,3
                dysum(igroup,ilayer)=0
                dxsum(igroup,ilayer)=0
                drsum(igroup,ilayer)=0
                nsum(igroup,ilayer)=0
           enddo
         enddo

        nwrite=0
	iapfirst=0
	iamfirst=0
	icpfirst=0
	icmfirst=0
        iaplast=0
        iamlast=0
        icplast=0
        icmlast=0

	itempcheck=1
        iglu=1
        icheck=1
	istrip=1
        icount=0
        igfail=0
        icfail=0
        isfail=0
	itape=0



    3  read(1,'(a)',ERR=99,END=99) chline
       
*
* Select and decode  'st' line
*
         if(chline(1:2) .eq. 'st') then

           sname = chline(31:46)
	   if (sname(1:9).eq.'InPlane_0') sname='A+InPl_0'
	   if (sname(1:9).eq.'InPlane_1') sname='A+InPl_1'
	   if (sname(1:9).eq.'InPlane_2') sname='A+InPl_2'
	   if (sname(1:9).eq.'InPlane_3') sname='A+InPl_3'
           comm  = chline(67:125)

           read(chline,1501,ERR=99,END=99)iseq
 1501 format(3x,i6)
           read(chline,1002,ERR=99,END=99)nhour,nminu,nsec
 1002 format(21x,i2.2,1x,i2.2,1x,i2.2)

           time=nhour+float(nminu)/60.+float(nsec)/3600.
           trasnik(2)=time
           if (trasnik(1).lt.0) trasnik(1)=time
           nrasnik=nrasnik+1

*
* Check Time
*
           if (time.ge.timemin .and. time.le.timemax) then

             ipass=1
*
* Read and decode following 'ud' line
*
             read(1,'(a)',ERR=99,END=99) chline
             if( chline(1:2) .eq. 'ud' ) then

               read(chline,1001,ERR=99,END=99)value

 1001 format(9x,3e14.3,2e12.3,2e14.3,2e11.3)

                 call get_offsetsbol1(sname)
c                call get_offsets_bol0(sname)
*              ----

               x=value(1)
               y=value(2)
	       scale=value(3)
	       rotz=1000.*value(6)

*   Check if Comment has changed and add mcomm to  .dat file  

               if (comm .ne. comm_prev ) mcomm = -mcomm

*
*  write 'raw' values to 'ntpl'-file
*
               write(33,*) sname, time, x,y,scale,rotz,mcomm

C--
C database: raw stuff
C--
      if (time.ge.database_t1 .and. time.le.database_t2) then
         inp=0
         if (sname(3:8).eq.'InPl_0') inp=1
         if (sname(3:8).eq.'InPl_1') inp=2
         if (sname(3:8).eq.'InPl_2') inp=3
         if (sname(3:8).eq.'InPl_3') inp=4
         if (inp.gt.0) then
            y_db(inp)=y_db(inp)+y
            z_db(inp)=z_db(inp)+x
            rotz_db(inp)=rotz_db(inp)+rotz
            scale_db(inp)=scale_db(inp)+scale
            ey_db(inp)=ey_db(inp)+y*y
            ez_db(inp)=ez_db(inp)+x*x
            erotz_db(inp)=erotz_db(inp)+rotz*rotz
            escale_db(inp)=escale_db(inp)+scale*scale
            counts_db(inp)=counts_db(inp)+1
         endif
      endif
C--
C
C--



	       
               call get_correction(x,y,scale,rotz)
*               write(33,*)'corrected ', sname, time, x,y,scale,rotz
*              ----
               call get_txplate(time,txplate)
*	       force=0.
*               call get_force(time,force)
*              ----
* get T_Gra
	 do i=1,4
	   tsens(i)=tsens_gra(i)
	 enddo
         call get_txplate(time,tgra)
* get T_Fra
         do i=1,4
           tsens(i)=tsens_fra(i)
         enddo
         call get_txplate(time,tfra)

	 dtgra=tgra-tgracal
	 dtfra=tfra-tfracal
     
	if ((idch.le.12) .or.
     +      (idch.ge.21.and.idch.le.24)) then
 	       x=x-
     +             (19.*lxplate/1000.*
     +             (txplate-txplate_cal(xplate)))/1000.
	endif
*              x=x+(23[um/m] * Length[m] * delta_temp ) [mm]
*
*  write corrected values to 'ntpl'-file
*
               write(34,2002) sname, time,txplate-txplate_cal(xplate),
     +               x,y,scale,rotz
 2002	format(a8,1x,F9.4,1x,F9.4,1x,F9.4,1x,F9.4,1x,F9.4,
     +                 1x,F9.4,1x)

                yp=y
		xp=x
                ilayer=2
              if (idch.le.12 .or. (idhc.ge.21 .and.idch.le.24)) then
                if (x.gt.10.) xp=x-15.017
                if (y.gt.10.) then 
			yp=y-26.011
                        ilayer=3
                endif
                if (y.lt.-10) then
			yp=y+26.011
                        ilayer=1
		endif
               endif
               nwrite=nwrite+1
               write(37,2037)idch,dag,time,itower,force,ilayer
 2037   format(I3,1x,a4,1x,F9.4,1x,I2,1x,F9.4,1x,I2)
       if (abs(rotz).gt.999) rotz=999.
               write(35,2003)idch,dag,time,txplate-txplate_cal(xplate),
     +               dtgra,dtfra,
     +               xp,yp,scale,rotz,igch,
     +               ilayer
 2003   format(I3,1x,a4,1x,F9.4,1x,F9.4,1x,F9.4,1x,F9.4,1x,
     +                 F9.4,1x,F9.4,1x,F9.4,
     +                 1x,F9.4,1x,I2,1x,I2)

C 
*	call check_eps(sname,idch,ilayer,xp,yp,rotz)
*       data iap/ 1,2,3,4/
*       data iam/ 5,6,7,8/
*       data icm/ 9,10,11,12/
*       data icp/ 21,22,23,24/

        if (sname(1:2).eq.'A+') then
		iaplast=nwrite
	endif
        if (sname(1:2).eq.'A-') then
		iamlast=nwrite
	endif
        if (sname(1:2).eq.'C+') then
		icplast=nwrite
	endif
        if (sname(1:2).eq.'C-') then
		icmlast=nwrite
	endif

*       data iap/ 1,2,3,4/
*       data iam/ 5,6,7,8/
*       data icm/ 9,10,11,12/
*       data icp/ 21,22,23,24/
C quick and dirty
        igroup=0
	if (abs(idch-2.5).lt.2.) igroup=1
	if (abs(idch-6.5).lt.2.) igroup=2
	if (abs(idch-10.5).lt.2.) igroup=3
	if (abs(idch-22.5).lt.2.) igroup=4





        iuse=1
        if (yp.gt.0.029) iuse=0
        if (yp.lt.-0.029)iuse=0
        if (xp.gt.0.029)iuse=0
        if (xp.lt.-0.029)iuse=0
        if (igroup.gt.0 .and. iuse.eq.1) then
	 dysum(igroup,ilayer)=dysum(igroup,ilayer)+yp
	 dxsum(igroup,ilayer)=dxsum(igroup,ilayer)+xp
	 drsum(igroup,ilayer)=drsum(igroup,ilayer)+rotz
	 nsum(igroup,ilayer)=nsum(igroup,ilayer)+1
	endif
*     print comment 
*        . it has changed or
*        . more the 5 seconds have passed between measmnts

               if ( time-time_prev .gt. 5./3600.
     +             .or. comm .ne. comm_prev ) then
                  print *
                  print *,comm
               endif
               time_prev = time
               comm_prev = comm

               dx=abs(x)
               dd=abs(abs(x)-15.017)
               if (dd.lt.dx) dx=dd

               dy=abs(y)
               dd=abs(abs(y)-26.011)
               if (dd.lt.dy) dy=dd
               dd=abs(abs(y)-2.*26.011)
               if (dd.lt.dy) dy=dd
                 
               resu='RED'
               tprob='++'
               pprob='++'
               if (dx.le.0.010 .and. dy.le.0.010) resu='BLU'
               if (dx.le.0.006 .and. dy.le.0.006) resu='GRE'
               if (ierror(1).gt.0) tprob=':T'
               if (ierror(2).gt.0) pprob=':P'


* GLU LIMITS.....16/10/2000
C this if statement determines sequence for check
	if (ilastseq.gt.0) then 
	ioldseq=iseq

* RASAS
	xofs(1)=0.
	yofs(1)=-0.015
	xmin(1)=-0.010
	xmax(1)=+0.010
	ymin(1)=-0.010
        ymax(1)=+0.010
* InPl_0 A+ 0layers
        xmin(2)=-0.10
        xmax(2)=+0.10
        ymin(2)=-0.03 
        ymax(2)=-0.030
* InPl_1 A+ 0layers
        xmin(3)=-0.10
        xmax(3)=+0.10
        ymin(3)=-0.01
        ymax(3)=-0.050
* InPl_2 A+ 0layers
        xmin(4)=-0.10
        xmax(4)=+0.10
        ymin(4)=-0.01
        ymax(4)=-0.050
* InPl_2 A+ 0layers
        xmin(4)=-0.10
        xmax(4)=+0.10
        ymin(4)=-0.01
        ymax(4)=-0.050



        if (igroup.ne.0) then ! RASAS
C--
C general warining for strips, tape and temp flags
C--
	  if (ilayer.gt.1) itape=1 ! layer 1,2 
	  if (abs(tfra-txplate).gt.0.5) itempcheck=0
	  if (sname(4:4).eq.'E') then ! east
C-- glu
           if (abs(xp).gt.0.025 .or. yp.lt.0.005 .or. yp.gt.0.025) then
		iglu=0
		igfail=igfail+1
		gsname(igfail)=sname
		gxy(igfail,1)=xp
		gxy(igfail,2)=yp
	   endif
C-- check
           if (abs(xp).gt.0.025 .or. yp.lt.-0.010 .or. yp.gt.0.010) then
		icheck=0
		icfail=icfail+1
		csname(icfail)=sname
                cxy(icfail,1)=xp
                cxy(icfail,2)=yp
	   endif ! east check
C-- strip
           if (abs(xp).gt.0.030 .or. yp.lt.-0.010 .or. yp.gt.0.010) then
                istrip=0
                isfail=isfail+1
                ssname(isfail)=sname
                sxy(isfail,1)=xp
                sxy(isfail,2)=yp
           endif ! east strip
	   icount=icount+1
	  else ! west side 
C glu rasas west
           if (abs(xp).gt.0.010 .or. yp.lt.0.005 .or. yp.gt.0.025) then
		iglu=0
		igfail=igfail+1
		gsname(igfail)=sname
                gxy(igfail,1)=xp
                gxy(igfail,2)=yp
	   endif
C check rasas west
           if (abs(xp).gt.0.010 .or. yp.lt.-0.010 .or. yp.gt.0.010) then
		icheck=0
		icfail=icfail+1
		csname(icfail)=sname
                cxy(icfail,1)=xp
                cxy(icfail,2)=yp
	   endif
C  strip rasas west
           if (abs(xp).gt.0.030 .or. yp.lt.0.500 .or. yp.gt.1.000) then
                istrip=0
                isfail=isfail+1
                ssname(isfail)=sname
                sxy(isfail,1)=xp
                sxy(isfail,2)=yp
           endif
	   icount=icount+1
	  endif ! west side 
        endif ! rasass
C--
C inplane
C--
	if (sname(3:6).eq.'InPl') then
C glu inplane
	   if (abs(abs(yp))-0.060.gt.0.030 .or. abs(xp).gt.0.100) then
		iglu=0
		igfail=igfail+1
		gsname(igfail)=sname
                gxy(igfail,1)=xp
                gxy(igfail,2)=yp
	   endif
C check inplane
	     if (abs(yp).gt.0.4 .or. abs(xp).gt.0.100) then
		icheck=0
		icfail=icfail+1
		csname(icfail)=sname
                cxy(icfail,1)=xp
                cxy(icfail,2)=yp
	     endif
C strip inplNE 
             if (abs(yp).gt.2.0 .or. abs(xp).gt.1.000) then
                istrip=0
                isfail=isfail+1
                ssname(isfail)=sname
                sxy(isfail,1)=xp
                sxy(isfail,2)=yp
             endif
	   icount=icount+1
	endif ! inplane
C--
C xplate rasniks
C--
	if (sname(5:6).eq.'LO') then
C glu xplate
	   if (abs(xp).gt.0.045) then
		iglu=0 ! for BOL1 xp is ysag
		igfail=igfail+1
		gsname(igfail)=sname
                gxy(igfail,1)=xp
                gxy(igfail,2)=xp
	   endif
C check xplate
	   if (abs(xp).gt.0.200) then
		icheck=0 ! for BOL1 xp is ysag
		icfail=icfail+1
		csname(icfail)=sname
                cxy(icfail,1)=xp
                cxy(icfail,2)=xp
	   endif
C strip xplate + sagcomp
           if (abs(xp).gt.0.045) then
                istrip=0 ! for BOL1 xp is ysag
                isfail=isfail+1
                ssname(isfail)=sname
                sxy(isfail,1)=xp
                sxy(isfail,2)=xp
           endif
	   icount=icount+1
	endif ! xplate rasniks

	endif ! ilastseq
	  
*
*
*     Tag deviating values
*
               do i=1,5
                 devch(i) = ' '
               enddo

               if ( dx .gt. 0.006 ) then
                  devch(1) = '*'
               endif
               if ( dy .gt. 0.006 ) then
                  devch(2) = '*'
               endif
*
*     Show corrected results
*
	print *,'idch ',idch
               dectime = float(nminu)/60.+float(nsec)/3600.
		   write(*,*)'==> results for cycle ',ncyc,idch
               write(*,2001) sname, nhour,nminu,dectime,
     +         txplate-txplate_cal(xplate),
     +         x,devch(1),y,devch(2),scale,devch(3),
     +              rotz,devch(4),resu,tprob,pprob

 2001 format(a8,i3,':',i2.2,'(',f3.2,')', ' dT=',F5.2,
     +                       ' x=',F7.3,a,' y=',F7.3,a,
     +                       ' s=',F5.3,a,' Az=',F7.3,a,1x,a,a,a)

	
C--
C make offsets in calibration 2 mode 
C--
	if (icalmode.eq.2) then
	  print *,' this runtype has ',comm(1:2)
	  if (comm(1:2).eq.'1:') then ! calibration candidate
	      n_save=n_save+1
	      if (n_save.gt.3000) then
		print *,'TO MANY CALIBRATION NUMBERS: ',n_save
	        stop
	      endif
		idd=idch
		ill=ilayer
	        icyc_save(n_save)=ncyc
                id_save(n_save)=idd
                il_save(n_save)=ill
                pm_save(n_save)=1
		if (sname(2:2).eq.'-')  pm_save(n_save)=-1
                dy_save(n_save)=yp
                dz_save(n_save)=xp
	  endif
	endif

	     

C
C--
C

C--
C save offsets in calibration mode
C--
	if (icalmode.eq.1) then
	  if (idatum.ne.idatum_use) then
		print *,' IN CALIBRATION MODE: wrong dates ',idatum,idatum_use
		stop
	  endif
	  do ical=1,n_use
	    if (ncyc.eq.icyc_use(ical)) then	
		idd=id_use(ical)
		ill=il_use(ical)
		if (idd.ge.25 .and. ill.ne.2) then
			print *,
     +            ' For this id=',idd,' ilayer should be two!!! '
		        stop
		endif
		dyeps_save(idd,ill)=dyeps_save(idd,ill)+yp
		dzeps_save(idd,ill)=dzeps_save(idd,ill)+xp
		rotzplot_save(idd)=rotzplot_save(idd)+rotz*rott(3)
		counts_save(idd,ill)=counts_save(idd,ill)+1
	     endif
	  enddo
	endif
C--
C
C--





c	        write(6,*)value
		    
                ncyc=ncyc+1
		    
	      else 

                print *,' ud line missing for system ',sname,
     +                  ' at time ',nhour,':',nminu

* ud-part
              endif
* time-cut  
            endif
* st-part
	    endif
* Read Loop
          goto 3
*
*  End of story
*
   99 close(1)

      if (ilastseq.gt.0) then
        close(36)
        open(36,file='glucheck.dat')
        write(36,*)'***********************************************'
        write(36,*)'*******          GLU CHECKS            ********'
        write(36,4001)nhour,nminu
 4001   format(' *******    FOR TIME ',i2,':',i2.2,'
     +  ********')
        write(36,*)'***********************************************'
	if (itempcheck.eq.0) write(36,*)'STOP: ROEP EXPERT '
	if (itempcheck.eq.0) write(36,*)'STOP: TEMPERATUUR PROBLEEM '
	if (itape.eq.1) then
	write(36,*)'DENK OM SPACER-TAPE '
	write(36,*)'DENK OM DE STRIPS
     +  OP DE MIDDEN-TORENS EN OOST TORENS VANAF BUIS LAAG 3!!!!!!!'
	endif

       if (icount.lt.10) then
           iglu=0
           write(36,*)'ER ZIJN ONVOLDOENDE RASNIK SYSTEMEN UITGELEZEN'
           do ii=1,igfail
                write(36,*)'NIET LIJMKLAAR: ',gsname(ii),
     +          ' dZ= ',gxy(ii,1) , ' dY= ',gxy(ii,2)
           enddo
           do ii=1,icfail
                write(36,*)'NIET OK: ',csname(ii),
     +          ' dZ= ',cxy(ii,1) , ' dY= ',cxy(ii,2)
           enddo
           do ii=1,isfail
                write(36,*)'GEEN STRIP: ',ssname(ii),
     +          ' dZ= ',sxy(ii,1) , ' dY= ',sxy(ii,2)
           enddo
        else
C go tru 8 possibilitiiies
        if (iglu.eq.1 .and. istrip.eq.1 .and. icheck.eq.1) then
           write(36,*)'SETUP UNDEFINED: ROEP EXPERT OR FIX'
	elseif (iglu.eq.1 .and. istrip.eq.1 .and. icheck.eq.0) then
           write(36,*)'SETUP UNDEFINED: ROEP EXPERT OR FIX'
           do ii=1,icfail
                write(36,*)'NIET OK: ',csname(ii),
     +          ' dZ= ',cxy(ii,1) , ' dY= ',cxy(ii,2)
           enddo
	elseif (iglu.eq.1 .and. istrip.eq.0 .and. icheck.eq.1) then
           write(36,*)'SETUP IN LIJMSTAND: ALLES OK '
	elseif (iglu.eq.1 .and. istrip.eq.0 .and. icheck.eq.0) then
           write(36,*)'SETUP IN LIJMSTAND: ALLES OK '
	elseif (iglu.eq.0 .and. istrip.eq.1 .and. icheck.eq.1) then
           write(36,*)'SETUP UNDEFINED: ROEP EXPERT OR FIX'
           do ii=1,igfail
                write(36,*)'NIET LIJMKLAAR: ',gsname(ii),
     +          ' dZ= ',gxy(ii,1) , ' dY= ',gxy(ii,2)
           enddo
	elseif (iglu.eq.0 .and. istrip.eq.1 .and. icheck.eq.0) then
           write(36,*)'SETUP IN STRIP-STAND VOOR LIJMEN: ALLES OK '
	elseif (iglu.eq.0 .and. istrip.eq.0 .and. icheck.eq.1) then
           write(36,*)'SETUP IN CONTROLE STAND: RASNIKS WERKEN '
           write(36,*)'SETUP NIET IN EEN BUIS-LAAG LIJMSTAND - '
           write(36,*)'         SAGCOMPENSATIE WAARSCHIJNLIJK UIT '
           do ii=1,igfail
                write(36,*)'Wel OK - maar niet in lijmstand: '
     +          ,gsname(ii),
     +          ' dZ= ',gxy(ii,1) , ' dY= ',gxy(ii,2)
           enddo
	elseif (iglu.eq.0 .and. istrip.eq.0 .and. icheck.eq.0) then
           write(36,*)'SETUP UNDEFINED: ROEP EXPERT OR FIX'
           do ii=1,igfail
                write(36,*)'NIET LIJMKLAAR: ',gsname(ii),
     +          ' dZ= ',gxy(ii,1) , ' dY= ',gxy(ii,2)
           enddo
	else
           write(36,*)'SETUP UNDEFINED: ROEP EXPERT OR FIX'
           do ii=1,igfail
                write(36,*)'NIET LIJMKLAAR: ',gsname(ii),
     +          ' dZ= ',gxy(ii,1) , ' dY= ',gxy(ii,2)
           enddo
	endif ! 8 possiblilities
        endif ! icount
        write(36,*)'***********************************************'
	close(36)
	endif ! ilastseq




      close(33)
      close(34)
      close(35)
      close(37)

* write summary
	do igroup=1,4
	  do ilayer=1,3
	    if (nsum(igroup,ilayer).gt.0) then
		dysum(igroup,ilayer)=
     +               dysum(igroup,ilayer)/nsum(igroup,ilayer)
                dxsum(igroup,ilayer)=
     +               dxsum(igroup,ilayer)/nsum(igroup,ilayer)
                drsum(igroup,ilayer)=
     +               drsum(igroup,ilayer)/nsum(igroup,ilayer)
	     endif
	   enddo
	 enddo
	do igroup=1,4
	  print *,'DY for GROUP ',igroup
          write(*,1234)(dysum(igroup,ilayer)*1000.,ilayer=1,3)
          print *,'DX for GROUP ',igroup
          write(*,1234)(dxsum(igroup,ilayer)*1000.,ilayer=1,3)
          print *,'Drotz for GROUP ',igroup
          write(*,1234)(drsum(igroup,ilayer)*1000.,ilayer=1,3)
         enddo

 1234    format(3(2x,F7.1))

	print * ,'bef def '
      istat=system('rm deform.ascii')
      call deformation(5,37,38,39,40)
	print * ,'afterdef '

*       data iap/ 1,2,3,4/
*       data iam/ 5,6,7,8/
*       data icm/ 9,10,11,12/
*       data icp/ 21,22,23,24/
	call surfview(1,iaplast)
	call surfview(2,iamlast)
	call surfview(3,icmlast)
	call surfview(4,icplast)

      cpntup='cp ntuple.ascii '//fntup
      istat=system(cpntup)
	open(34,file='channels.dat')
	do i=1,100
          if (namech(i).ne.'empty') then
            write(kname,2004)i+99
 2004       format('id',I3,'.kumac')
	    open(35,file=kname)
	    write(35,*)'text 0 1.1 ',namech(i),' 0.4'
            close(35)
            write(34,*)i
          endif
	enddo
        close(34)
C v3 with calibration form 20000802 after sagcomp chrash
C v4 use 808 calibration all the way
C v5 use 808 calibration + global fit correction
C v6 use 808 calibration + global fit correction + after 709 sagadjusted
        open(34,file='surftit.kumac')
        write(34,*)'title \'',rname(5:12),
     +             '(v6) Stack and Deform\''
        close(34)
	open(34,file='rastit.kumac')
        write(34,*)'title \'',rname(5:12),
     +             '(v6) RASNIK and Temp vs Time\''
        close(34)
        open(34,file='temptit.kumac')
        write(34,*)'title \'',tname(8:15),
     +        ' Temperature vs Time\''
        close(34)
*        open(34,file='forcetit.kumac')
*        write(34,*)'title \'',rname(5:12),
*     +        ' Force vs Time\''
*        close(34)
        open(34,file='rasmove.kumac')
        write(34,*)'sh mv plot.ps plots/rasnik_',rname(5:12),'.ps'
        close(34)
        open(34,file='tempmove.kumac')
        write(34,*)'sh mv plot.ps plots/temp_',rname(5:12),'.ps'
        close(34)
*        open(34,file='forcemove.kumac')
*        write(34,*)'sh mv plot.ps plots/force_',rname(5:12),'.ps'
*        close(34)



	call I_spy

        

cgm updating of 'steer'-file : NOT YET checked

      if (ipass.eq.0) then
        print *,'NO DATA FOUND - CHECK FILE steer '
        print *,'DATA ignored before time ',timemin
      endif

C--
C write epsilons in icalmode
C--
	if (icalmode.eq.1) then
		call writeeps
	endif

	if (icalmode.eq.2) then
	        call exeseqs
	endif
C--
C
C--

      close(35)
      lun  = 35
      CALL HROPEN(lun,'oops','uit','N',1024,ISTAT)
      if (istat.ne.0) then
        CALL HROPEN(lun,'oops','uit','U',1024,ISTAT)
      endif
      call hrout(0,icycle,'T')
      call hrend('oops')
      close(lun)

      end



	subroutine deformation(igroup,ia,ib,ic,id)
	include 'Online.cmm'
	real xras(5000,4)
	real yras(5000,4)
	real sras(5000,4)
	real tras(5000,4)
	real rras(5000,4)
	character*500 line
	character*240 dline,sline
	character*3 iline
C--
C first fill rasnik vars from ntuple
C--
        ii=0
	icyc=0
	close(35)
	open(35,file='ntuple.ascii')
 10	continue
		read(35,'(a)',ERR=20,END=20)line
	        write(iline,*)line(2:4)
	        write(dline,*)line(10:249)
		read(iline,*,ERR=20,END=20)idch
		read(dline,*,ERR=20,END=20)
     +        time,dt,
     +        dtgra,dtfra,
     +        xp,yp,scale,rotz,ie,ir
		ii=ii+1
		   tras(ii,1)=-1.
		   tras(ii,2)=-2.
		   tras(ii,3)=-3.
		   tras(ii,4)=-4.
		k=0
		if (idch.eq.ia) k=1
		if (idch.eq.ib) k=2
		if (idch.eq.ic) k=3
		if (idch.eq.id) k=4
		if (k.ne.0) then
		   xras(ii,k)=xp
		   yras(ii,k)=yp
	           sras(ii,k)=scale
	           rras(ii,k)=rotz
	           tras(ii,k)=time
	           icyc=ii
                endif
 4003   format(I3,1x,a4,1x,F9.4,1x,F9.4,1x,F9.4,1x,F9.4,1x,
     +                 F9.4,1x,F9.4,1x,F9.4,
     +                 1x,F9.4,1x,I2,1x,I2)
        goto 10
 20	continue
	close(35)

C--
C synchronize
C--
C	group in ia ib ic id
	
	igood=0
	do ii=1,icyc
          if (tras(ii,1).gt.0.) then
            igood=igood+1
            ig=igood
            xrasp(ig,1)=xras(ii,1)
            yrasp(ig,1)=yras(ii,1)
            srasp(ig,1)=sras(ii,1)
            rrasp(ig,1)=rras(ii,1)
            trasp(ig,1)=tras(ii,1)
            t1=tras(ii,1)
           else
	     goto 30
	   endif 
C get corresponding ib
	  tmin=999999.
	  icom=1
	  do jj=1,icyc
            dt=abs(t1-tras(jj,2))
            if (dt.lt.tmin) then
		tmin=dt
		icom=jj
	    endif
	  enddo
          xrasp(ig,2)=xras(icom,2)
          yrasp(ig,2)=yras(icom,2)
          srasp(ig,2)=sras(icom,2)
          rrasp(ig,2)=rras(icom,2)
          trasp(ig,2)=tras(icom,2)
C get corresponding ic
          tmin=999999.
          do jj=1,icyc
            dt=abs(t1-tras(jj,3))
            if (dt.lt.tmin) then
                tmin=dt
                icom=jj
            endif
          enddo
          xrasp(ig,3)=xras(icom,3)
          yrasp(ig,3)=yras(icom,3)
          srasp(ig,3)=sras(icom,3)
          rrasp(ig,3)=rras(icom,3)
          trasp(ig,3)=tras(icom,3)
C get corresponding ib
          tmin=999999.
          do jj=1,icyc
            dt=abs(t1-tras(jj,4))
            if (dt.lt.tmin) then
                tmin=dt
                icom=jj
            endif
          enddo
          xrasp(ig,4)=xras(icom,4)
          yrasp(ig,4)=yras(icom,4)
          srasp(ig,4)=sras(icom,4)
          rrasp(ig,4)=rras(icom,4)
          trasp(ig,4)=tras(icom,4)
 30	continue
	enddo ! icyc for synchronizer
	
	call get_deform(igroup,igood)

C--
C write to file
C--
	open(35,file='deform.ascii')
 21	continue
        read(35,'(a)',END=22)line
	goto 21
 22	continue
	k=igroup
	do ii=1,igood
           dt=abs(trasp(ii,1)-trasp(ii,2))
           dt=dt+abs(trasp(ii,1)-trasp(ii,3))
           dt=dt+abs(trasp(ii,1)-trasp(ii,4))
	   dt=dt/3.
           if (dt.lt.3./60.) then ! skip large time differences
	      write(35,5003)igroup*1.,trasp(ii,1),
     +	      torque(k,ii),sagmsk(k,ii),
     +        sagccd(k,ii),saglen(k,ii),
     +        chasag(k,ii),chasgz(k,ii),
     +        temccd(k,ii),temmsk(k,ii),
     +        roxlen(k,ii),torqdy(k,ii)
 5003   format(11(F9.4,1x))
           endif
         enddo

	print *,'end deformation '
        end ! deformation

          
	subroutine get_deform(igroup,icyc)
	include 'Online.cmm'
        real xras(0:3)
        real yras(0:3)
        real zras(0:3)
        real rotZras(0:3)
	do ii=1,icyc
        ncyc=ii
	do ns=0,3
          k=ns+1
	  xras(ns)=xrasp(ii,k)
	  yras(ns)=yrasp(ii,k)
          zras(ns)=0.
	  if (srasp(ii,k).ne.0.) then
	    zras(ns)=2500./srasp(ii,k)-2500.
	  endif
	  rotZras(ns)=rrasp(ii,k)/1000. ! rotzrad in radians
	enddo
        call get_deform_one(igroup,ii,xras,yras,zras,rotZras)
        enddo
	end
	
	subroutine surfview(igroup,ilast)
        include 'Online.cmm'
	character*80 fnaam,fnaam1,fnaam2,fnaam3
        character*500 line
        character*240 dline,sline
        character*3 iline
        real xras(0:3)
        real yras(0:3)
        real zras(0:3)
        real rotZras(0:3)
        integer icol(51)
	integer iap(4)
	integer iam(4)
	integer icm(4)
	integer icp(4)
        integer irasas(4)
        data iap/ 1,2,3,4/
        data iam/ 5,6,7,8/
        data icm/ 9,10,11,12/
        data icp/ 21,22,23,24/
* 33 34 35 36
* 37 38 39 40
* 41 42 43 44
* 13 14 15 16
* 17 18 19 20
* 25 26 27 28
* 29 30 31 32
	real yplast(200),xplast(200),slast(200),
     +       rlast(200),dtfralast(200)
	do i=1,200
	  yplast(i)=0.
	  xplast(i)=0.
	  rlast(i)=0.
	  slast(i)=0.
	enddo
	if (igroup.eq.1) then
	     fnaam2='inarrow1.kumac'
	     fnaam1='surfcol1.kumac'
	     fnaam3='inpcol1.kumac'
	     fnaam='surfarrow1.kumac'
             do i=1,4
		irasas(i)=iap(i)
             enddo
	elseif (igroup.eq.2) then
	     fnaam2='inarrow2.kumac'
	     fnaam1='surfcol2.kumac'
	     fnaam3='inpcol2.kumac'
	     fnaam='surfarrow2.kumac'
             do i=1,4
                irasas(i)=iam(i)
             enddo
        elseif (igroup.eq.3) then
	     fnaam2='inarrow3.kumac'
	     fnaam1='surfcol3.kumac'
	     fnaam3='inpcol3.kumac'
	     fnaam='surfarrow3.kumac'
             do i=1,4
                irasas(i)=icm(i)
             enddo
        elseif (igroup.eq.4) then
	     fnaam2='inarrow4.kumac'
	     fnaam1='surfcol4.kumac'
	     fnaam3='inpcol4.kumac'
	     fnaam='surfarrow4.kumac'
             do i=1,4
                irasas(i)=icp(i)
             enddo
        else 
             print *,'no group selected in surfview'
	     stop
	endif

C--
C first fill rasnik vars from ntuple
C--
        ii=0
        close(35)
        open(35,file='ntuple.ascii')
 10     continue
                read(35,'(a)',ERR=20,END=20)line
                write(iline,*)line(2:4)
                write(dline,*)line(10:249)
                read(iline,*,ERR=20,END=20)idch
                read(dline,*,ERR=20,END=20)
     +        time,dt,
     +        dtgra,dtfra,
     +        xp,yp,scale,rotz,ie,ir
               ii=ii+1
             if (ii.le.ilast) then ! take it
		xplast(idch)=xp
		yplast(idch)=yp
		slast(idch)=scale
		rlast(idch)=rotz
                dtfralast(idch)=dtfra
             endif
        goto 10
 20     continue
        close(35)


	nzbin=20
	nxbin=20
	yvalmin=10000.
	yvalmax=-10000.
	call hbook1(igroup+60,'surface',nxbin,0.,5.,0.)
	call hbook1(igroup+70,'surface',nzbin,0.,2.,0.)
	call hbook2(igroup+50,'surface',nxbin,0.,5.,
     +                                  nzbin,0.,2.,0.)
	call hbook2(igroup+40,'surface',nxbin,0.,5.,
     +                                  nzbin,0.,2.,0.)
        call hbook2(igroup+30,'inplane',nxbin,0.,5.,
     +                                  nzbin,0.,2.,0.)

        do iz=1,nzbin
           do ix=1,nxbin
             x=(ix-1)*5.0/((nxbin-1)*1.)
             z=(iz-1)*2.0/((nzbin-1)*1.)
             dxx=x/5.0
             dzz=z/2.0
             c=xplast(irasas(4)) ! SW
             a=xplast(irasas(3)) ! SE
             d=xplast(irasas(1)) ! NW
             b=xplast(irasas(2)) ! NE
             
             call fpint(xval,dxx,dzz,a,b,c,d)
	     c=yplast(irasas(4)) ! SW
	     a=yplast(irasas(3)) ! SE
	     d=yplast(irasas(1)) ! NW
	     b=yplast(irasas(2)) ! NE
             call fpint(yval,dxx,dzz,a,b,c,d)
             ysaghv=(yplast(44)+1.5*yplast(43))/2.
             ysagro=(yplast(42)+1.5*yplast(41))/2.
             ysagro=ysagro*(1.-(1.-z)**2)
             ysaghv=ysaghv*(1.-(1.-z)**2)
             if (igroup.eq.2 .or. igroup.eq.3) then
                ysagro=-ysagro
		ysaghv=-ysaghv
	     endif
             ysagz=ysagro
	     ysagn=ysaghv
             if (igroup.eq.2 .or. igroup.eq.4) then
		ysagz=ysaghv
		ysagn=ysagro
	     endif
             yval=yval+ysagz*(1.-dxx)**2
             yval=yval+ysagn*(dxx)**2
             yval=yval*1000.
             call hix(60+igroup,ix,xf)
             call hix(70+igroup,iz,zf)
             xf=xf+0.01
             zf=zf+0.01
	     call hfill(50+igroup,xf,zf,yval)
	     if (yval.gt.yvalmax) yvalmax=yval
	     if (yval.lt.yvalmin) yvalmin=yval
	     call hfill(40+igroup,xf,zf,xval*1000.)
	enddo
	enddo

	call prepal(fnaam1,50+igroup,6.,yvalmin,yvalmax)

*            1 ------- 2
*            |         |
*            3 ------- 4   function values
         
C prepare arrows to represent rasasX in PAW
        x1=0.
        y1=0.27

	x2=0.63
        y2=0.45

	x3=0.37
	y3=0.0015

	x4=1.
	y4=0.15

	
	open(35,file=fnaam)
        dxne=x2-x4
        dyne=y2-y4
        rn=sqrt(dxne**2+dyne**2)
        b=xplast(irasas(2)) ! NE
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        x=x4-b*dxne/rn
        y=y4-b*dyne/rn
	write(35,*)'arrow ',x4,x,y4,y
C frascatie
        xf=(x4+x2)/2.
        yf=(y4+y2)/2.
        b=dtfralast(irasas(2))*23.*2.2/1000.
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        x=xf-b*dxne/rn
        y=yf-b*dyne/rn
        write(35,*)'arrow ',xf,x,yf,y
C


        b=xplast(irasas(1)) ! NW
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        x=x2-b*dxne/rn
        y=y2-b*dyne/rn
	write(35,*)'arrow ',x2,x,y2,y

        dxse=x1-x3
        dyse=y1-y3
        rn=sqrt(dxse**2+dyse**2)
        b=xplast(irasas(3)) ! SE
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        x=x3-b*dxse/rn
        y=y3-b*dyse/rn
        write(35,*)'arrow ',x3,x,y3,y

C frascatie
        b=dtfralast(irasas(3))*23.*2.2/1000.
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        xf=(x3+x1)/2.
        yf=(y3+y1)/2.
        x=xf-b*dxse/rn
        y=yf-b*dyse/rn
        write(35,*)'arrow ',xf,x,yf,y



        b=xplast(irasas(4)) ! SW
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        x=x1-b*dxse/rn
        y=y1-b*dyse/rn
        write(35,*)'arrow ',x1,x,y1,y

	write(35,*)'color 1 0 0 0 '
	close(35)

C now the inplanestuff
        do i=0,3
	  xras(i)=xplast(37+i)
	  yras(i)=yplast(37+i)
          if (slast(37+i).ne.0.) then
            zras(i)=2500./slast(37+i)-2500.
          endif
          rotZras(i)=rlast(37+i)/1000. ! rotzrad in radians
        enddo
        icyc=1
        call get_deform_one(igroup,icyc,xras,yras,zras,rotZras)

         print *,'torq ',-torque(igroup,1)
         print *,'roxl ',roxlen(igroup,1)
         print *,'chasag ',chasag(igroup,1)

             yvalmax=-100000.
             yvalmin=100000.
        do iz=1,nzbin
           do ix=1,nxbin
             x=(ix-1)*5.0/((nxbin-1)*1.)
             z=(iz-1)*2.0/((nzbin-1)*1.)
             xx=x-5.0/2.
             zz=z-2.0/2.
             yy=0.
             call shift(igroup,xx,yy,zz,xuse,yuse,zuse)
             call hix(60+igroup,ix,xf)
             call hix(70+igroup,iz,zf)
             xf=xf+0.01
             zf=zf+0.01
             yval=yuse*1000.
             call hfill(30+igroup,xf,zf,yval)
             if (yval.gt.yvalmax) yvalmax=yval
             if (yval.lt.yvalmin) yvalmin=yval
          enddo
          enddo
	
           call prepal(fnaam3,30+igroup,50.,yvalmin,yvalmax)
C prepare arrow for paw
        x1=0.
        y1=0.27
        x2=0.63
        y2=0.45
        x3=0.37
        y3=0.0015
        x4=1.
        y4=0.15
        open(35,file=fnaam2)
        dxne=x2-x4
        dyne=y2-y4
        rn=sqrt(dxne**2+dyne**2)
        b=chasgz(igroup,1)
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        xc=(x3+x4)/2.
        yc=(y3+y4)/2.
        x=xc-b*dxne/rn
        y=yc-b*dyne/rn
        write(35,*)'arrow ',xc,x,yc,y
        xc=(x1+x2)/2.
        yc=(y1+y2)/2.
        x=xc-b*dxne/rn
        y=yc-b*dyne/rn
        write(35,*)'arrow ',xc,x,yc,y

        b=temccd(igroup,1)*2.*0.025
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        x=x1-b*dxse/rn
        y=y1-b*dyse/rn
        write(35,*)'arrow ',x1,x,y1,y

        b=temmsk(igroup,1)*2.*0.025
        write(35,*)'color 1 0 0 1 '
        if (b.gt.0.012) write(35,*)'color 1 1 0 0 '
        if (b.lt.0.006) write(35,*)'color 1 0 1 0 '
        b=b*rn/0.100
        x=x4-b*dxse/rn
        y=y4-b*dyse/rn
        write(35,*)'arrow ',x4,x,y4,y

	close(35)
	end







*-- Author :    Marcel Vreeswijk   03/03/94
      SUBROUTINE FPINT(fval,dxx,dyy,a,b,c,d)
******************************************************************
*                                                                *
* FPINT (version 1.00)                                           *
*                                                                *
*                                                                *
* IN:
* interpolate linear on a four point grid                        *
* dyy= dy/ybinwid
* dxx= dx/xbinwid
*            c ------- d
*            |         |
*            a ------- b   function values                       *
* OUT:   fval corresponding to dxx dyy                           *
*                                                                *
*                                                                *
*  written by: Marcel Vreeswijk, 03/03/94 10.53.52               *

      real Fval,dxx,dyy,a,b,c,d
      Fval  = a+ dxx*(b-a)+ dyy*(
     +     (c+ dxx * (d -c) )-
     +     (a+ dxx * (b -a)) )
      end




        subroutine I_spy
        include 'Online.cmm'
        integer system
* get tunix
      istat=system(' date \'+%H\' > time.txt ')
      istat=system(' date \'+%M\' >> time.txt ')
      open(34,file='time.txt')
      read(34,*)ih
      read(34,*)im
      close(34)
      tunix=float(ih)+float(im)/60.
* read old stuff
        open(44,file='spy.raw')
        read(44,*)datum_old
        read(44,*)tunix_old
        read(44,*)trasnik_old(1),trasnik_old(2),nrasnik_old
        read(44,*)ttemp_old(1),ttemp_old(2),ntemp_old
        read(44,*)irasdataerror,itempdataerror
        close(44)
* write new stuff + check
        istat=system('date >> spynew.txt')
        open(44,file='spynew.txt')
           if (abs(trasnik(2)-tunix).gt.1 .and.
     +         abs(trasnik(2)-tunix).lt.22.5) then ! no data for one hour
             write(44,*)'FATAL: no RASNIK data for one hour '
             if (irasdataerror.eq.0 .or. irasdataerror.gt.11) then
                 istat=system('mail -s MRASNIK_PROBLEM h73 < mailinfo')
               if (idatum_org.eq.0) then
                 istat=system('mail -s RASNIK_PROBLEM h73 < mailinfo')
                 istat=system('mail -s RASNIK_PROBLEM d65 < mailinfo')
                 istat=system('mail -s RASNIK_PROBLEM d90 < mailinfo')
                 istat=system(
     +     'mail -s RASNIK_PROBLEM +31615012328@gin.nl < mailinfo')
                endif
                irasdataerror=1
             else
                irasdataerror=irasdataerror+1
             endif
           else
             irasdataerror=0
           endif
           if (abs(ttemp(2)-tunix).gt.1  .and.
     +         abs(ttemp(2)-tunix).lt.22.5) then ! no data for one hour
             write(44,*)'FATAL: no TEMP data for one hour '
             if (itempdataerror.eq.0 .or. itempdataerror.gt.11) then
                istat=system('mail -s MTEMP_PROBLEM h73 < mailinfo')
               if (idatum_org.eq.0) then
                istat=system('mail -s TEMP_PROBLEM h73 < mailinfo')
                istat=system('mail -s TEMP_PROBLEM d65 < mailinfo')
                istat=system('mail -s TEMP_PROBLEM d90 < mailinfo')
               endif
                itempdataerror=1
             else
                itempdataerror=itempdataerror+1
             endif
           else
             itempdataerror=0
           endif
        write(44,*)'datum: ',datum,' tijd:',tunix
        write(44,*)'RASNIK tijd: ',trasnik(1), ' to ',trasnik(2),
     +           ' # readings: ',nrasnik
        write(44,*)'TEMP tijd: ',ttemp(1), ' to ',ttemp(2),
     +           ' # readings: ',ntemp
        write(44,*)'********************************************'
        close(44)
        istat=system('cat spynew.txt >> spy.txt')
*
        open(44,file='spy.raw')
        write(44,*)datum
        write(44,*)tunix
        write(44,*)trasnik(1),trasnik(2),nrasnik
        write(44,*)ttemp(1),ttemp(2),ntemp
        write(44,*)irasdataerror,itempdataerror
        close(44)
        end

	include 'prepal.f'
 	include 'getcor.f'
  	include 'getcorbol1.f'

         include 'deform_shift.f'
         include 'rasfile_smb.f'
         include 'rasfile_h73.f'

