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

      include 'Online.cmm'

      character*15 tem
      character*12 ras
      integer system

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


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

C--
C-- see what timespan to process
      open(34,file='timespan.txt')
        read(34,*)timemin
        read(34,*)timemax
      close(34)
      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)
      ras='ras.'//datum
      rname=ras//'.res'
      write(*,*)rname

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






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

      print *
      print *,' # of succesful cycles : ',ncyc
	
      end

      subroutine read
*     ---------- ----

	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*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
      call rasfile(ifile,rname)

      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') 
      print *,' old ntuple remove ',istat
      open(33,file='raw.dat')
      open(34,file='correction.dat')
      open(35,file='ntuple.ascii')

      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
*  ---------
        nwrite=0
	iapfirst=0
	iamfirst=0
	icpfirst=0
	icmfirst=0
        iaplast=0
        iamlast=0
        icplast=0
        icmlast=0


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

           sname = chline(31:46)
           comm  = chline(67:125)

           read(chline,1002)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)') chline
             if( chline(1:2) .eq. 'ud' ) then

               read(chline,1001) value

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

               call get_offsets(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


               call get_correction(x,y,scale,rotz)
*              ----
               call get_txplate(time,txplate)
*              ----
* 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
     
 	       x=x-
     +             (19.*lxplate/1000.*
     +             (txplate-txplate_cal(xplate)))/1000.
*              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
                if (y.gt.10.) yp=y-26.011
                if (y.lt.-10) yp=y+26.011
*               if (yp.gt.0.029) yp=0.029
*               if (yp.lt.-0.029) yp=-0.029
                if (x.gt.10.) xp=x-15.017
*               if (xp.gt.0.029) xp=0.029
*               if (xp.lt.-0.029) xp=-0.029


               nwrite=nwrite+1
               write(35,2003)idch,dag,time,txplate-txplate_cal(xplate),
     +               dtgra,dtfra,
     +               xp,yp,scale,rotz,ierror(1),ierror(2)
 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 
*       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+') iaplast=nwrite
        if (sname(1:2).eq.'A-') iamlast=nwrite
        if (sname(1:2).eq.'C+') icplast=nwrite
        if (sname(1:2).eq.'C-') icmlast=nwrite


*     print comment only if 
*        . 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'

*
*     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
*
               dectime = float(nminu)/60.+float(nsec)/3600.

               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	        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)

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

      istat=system('rm deform.ascii')
      call deformation(5,37,38,39,40)

*       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
        open(34,file='surftit.kumac')
        write(34,*)'title \'',rname(5:12),
     +             '(v3) Stack and Deform\''
        close(34)
	open(34,file='rastit.kumac')
        write(34,*)'title \'',rname(5:12),
     +             '(v3) 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='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)


	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
	

      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

	include 'getcor.f'


	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
	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.
	  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
        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 get_deform_one(igroup,ncyc,
     +                          xras,yras,zras,rotZras)
	include 'Online.cmm'
        real xras(0:3)
        real yras(0:3)
        real zras(0:3)
        real rotZras(0:3)
        real Z(3)
        Z(1)=487.
        Z(2)=987.
        Z(3)=1080.
        nch=igroup

        tec=23.0E-6
c	Now all relevant in-plane data sits in xras, yras,
c	zras and rotZras. Now it really starts!

c	Torsion of chamber, expressed in relative rotation
c	around chamber X axis of the outer crossplates

	sum=0.
	do ns=0,3
	  sum=sum+rotZras(ns)
	enddo
	torque(nch,ncyc)=1000.*sum/4. ! torque in mrad
	
c	sag of MSK cross plate
	alf1=rotZras(0)+rotZras(1)-rotZras(2)-rotZras(3)
	c1=(z(1)+Z(2))/Z(3)
	alfmsk=-alf1/(2.*c1)
	sagmsk(nch,ncyc)=z(3)*alfmsk*2.
	
c	sag of CCD cross plates
	c1=z(1)/z(2)
	alf1=c1*rotZras(0)-rotZras(1)+rotZras(2)-c1*rotZras(3)
	c2=(z(2)/z(3)+(z(1)*z(2))/(z(2)*z(3)))
	alfccd=alf1/(2.*c2)
	sagccd(nch,ncyc)=z(3)*alfccd*2.

*        sagccd(nch,ncyc)=(rotZras(1)-rotZras(2))/3./2.*1080.
*        sagmsk(nch,ncyc)=(rotZras(0)-rotZras(3))/2./2.*1080.
	
c	sag of LEN cross plate
	y1=yras(0)-yras(1)-yras(2)+yras(3)
	c1=Z(1)**2-Z(2)**2
	c2=2.*c1/(Z(3)**2)*sagmsk(nch,ncyc)
	c3=Z(2)**2-((Z(1)-Z(2))/2)**2
	c4=4.*c3/(Z(3)**2)
	saglen(nch,ncyc)=(y1-c2)/c4

	saglen(nch,ncyc)=y1/2./2.
	
c	chamber sag
	sum=0.
	do ns=0,3
	  sum=sum+yras(ns)
	enddo
	chasag(nch,ncyc)=sum/8.

	
c	chamber sag in Z direction (CCS):
	dx=xras(0)+xras(1)+xras(2)+xras(3)
	chasgz(nch,ncyc)=dx/8.

c	Tmsk - Tlen:
	temmsk(nch,ncyc)=
     &  -(xras(0)+xras(1)-xras(2)-xras(3))/
     &  (2.*tec*(Z(1)+Z(2)))
	
c	TCCD - Tlen
	dx=xras(0)-(Z(2)/Z(1))*(xras(1)-xras(2))-xras(3)
	den=2.*Z(2)*tec*(1.+(Z(2)/Z(1)))
	temccd(nch,ncyc)=-dx/den	

c	middle cross plate rotX (CCS):
	dy=yras(0)-yras(3)
	roxlen(nch,ncyc)=1000.*dy/(4.*Z(2))

c	torque from dy:
	dy=yras(1)-yras(2)
	c1=2.*roxlen(nch,ncyc)*(Z(2)-Z(1))/1000.
	torqdy(nch,ncyc)=-1000.*(dy+c1)/(Z(1)+Z(2))
	end
        
	  
	subroutine surfview(igroup,ilast)
        include 'Online.cmm'
	character*80 fnaam,fnaam1,fnaam2
        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'
	     fnaam='surfarrow1.kumac'
             do i=1,4
		irasas(i)=iap(i)
             enddo
	elseif (igroup.eq.2) then
	     fnaam2='inarrow2.kumac'
	     fnaam1='surfcol2.kumac'
	     fnaam='surfarrow2.kumac'
             do i=1,4
                irasas(i)=iam(i)
             enddo
        elseif (igroup.eq.3) then
	     fnaam2='inarrow3.kumac'
	     fnaam1='surfcol3.kumac'
	     fnaam='surfarrow3.kumac'
             do i=1,4
                irasas(i)=icm(i)
             enddo
        elseif (igroup.eq.4) then
	     fnaam2='inarrow4.kumac'
	     fnaam1='surfcol4.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

C prepare palette for PAW
       open(35,file=fnaam1)
       imax=yvalmax + 7 + 0.1*abs(yvalmax)
       imin=yvalmin - 7 - 0.1*abs(yvalmin)
       if (imax.lt.0) imax=0
       if (imin.gt.0) imin=0
       di=(imax-imin)/6.
       ni=nint(di)
       if (ni.ge.50) ni=50 ! to much colors
       imin=imax-ni*6.
	sclose=0.
	close=1000.
       do i=0,ni
         yval=imin+6*i
         if (abs(yval).lt.close) then
            close=abs(yval)
            sclose=yval
         endif
	ENDDO
         imin=imin-nint(sclose)
         imax=imax-nint(sclose)
         do i=1,ni
         ylow=imin+6*(i-1)
         yval=imin+6*i
         if (abs(yval).le.6 .and. abs(ylow).le.6) then
            icol(i)=3
	 elseif (abs(yval).le.12 .and. abs(ylow).le.12) then
            icol(i)=4
         else
            icol(i)=2
         endif
	ENDDO

       write(35,*)'att/pal 1 ',ni,' ',(icol(i),i=1,ni)
       write(35,*)'max ',50+igroup,' ',imax
       write(35,*)'min ',50+igroup,' ',imin
	
	close(35)

*            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)

        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
             call hfill(30+igroup,xf,zf,yuse*1000)
          enddo
          enddo
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 shift(igroup,xx,yy,zz,xuse,yuse,zuse)
      implicit none
        common/var1/torque,sagmsk
        common/var2/sagccd,saglen
        common/var3/chasag,chasgz
        common/var4/temccd,temmsk
        common/var5/roxlen,torqdy

       real torque(5,1000),sagmsk(5,1000)
       real sagccd(5,1000),saglen(5,1000)
       real chasag(5,1000),chasgz(5,1000)
       real temccd(5,1000),temmsk(5,1000)
       real roxlen(5,1000),torqdy(5,1000)

      real  xx,yy,zz,xuse,yuse,zuse
      integer igroup
      double precision axb1,axl1,axv1,dy1,dz1,ay1,az1,sagy1,sagz1
      double precision axb2,axl2,axv2,dy2,dz2,ay2,az2,sagy2,sagz2
      double precision axb3,axl3,axv3,dy3,dz3,ay3,az3,sagy3,sagz3
      double precision tn,ttn,stn,ctn,tn1,tn2,tn3
      double precision L1,L2,L3
      double precision xc1,xc2,xc3,yc1,yc2,yc3,zc1,zc2,zc3
      double precision wxb1,wxl1,wxv1,gx1
      double precision wxb2,wxl2,wxv2,gx2
      double precision wxb3,wxl3,wxv3,gx3
      double precision wxay1,wxay2,wxay3
      double precision wxsz1,wxsz2,wxsz3
      double precision wxaz1,wxaz2,wxaz3
      double precision wxsy1,wxsy2,wxsy3
      double precision hcham,dtemp
      double precision wxl,wxv
      double precision wxl_a,wxl_b,dz_b,dz_a,a,b
      double precision wxv_a,wxv_b,dy_b,dy_a
      double precision wzl1,wzl2,wzl3,wyl1,wyl2,wyl3
      double precision wzv1,wzv2,wzv3,wyv1,wyv2,wyv3
      double precision ts,xs,ys,zs,tnom,amdt,arpc,xn,yn,zn
      double precision ysagro,ysaghv,ysagln,ysagz,ysagn
      
      integer i
      hcham=50.

      axb3=-torque(igroup,1)/1000.
      axl3=roxlen(igroup,1)/1000.
      axv3=torque(igroup,1)/1000.
      ay3=0.
      az3=0.
      dy3=0.
      dz3=0.
      sagz3=chasgz(igroup,1)
      sagy3=chasag(igroup,1)
      dtemp=0.
      ysagro=sagmsk(igroup,1)
      ysaghv=sagccd(igroup,1)
      ysagln=saglen(igroup,1)

      xc3=0.
      zc3=0.
      yc3=0.
      yn=yy*1000.
      zn=zz*1000.
      xn=xx*1000.
*      tn=atan((yn-yn)/(zn-zn))
      tn=-2.
      tnom=-2.
      ttn=tan(tn)
      stn=sin(tn)
      ctn=cos(tn)

      include 'wxfunc.f'

c      print *,wzv1,wyv1




      zs=zn+dz3+ay3*(xn-xc3) -
     +      (axb3*wxb3)*(yn-yc3)
     +      -(axl3*wzl3+axv3*wzv3)
     +      +sagz3*gx3
      ys=yn+dy3+az3*(xn-xc3)+axb3*(zn-zc3)*wxb3+
     +            axl3
     +            *wyl3+axv3*wyv3+sagy3*gx3

C Xplate sag
             ysagro=ysagro*(1.-(zn/1000.)**2)
             ysaghv=ysaghv*(1.-(zn/1000.)**2)
             ysagln=ysagln*(1.-(zn/1000.)**2)
             if (igroup.eq.2 .or. igroup.eq.3) then
                ysagro=-ysagro
                ysaghv=-ysaghv
                ysagln=-ysagln
             endif
             ysagz=ysagro
             ysagn=ysaghv
             if (igroup.eq.2 .or. igroup.eq.4) then
                ysagz=ysaghv
                ysagn=ysagro
             endif
             if (xn.gt.0.) then
                ys=ys+ysagn*(xn/2500.)**2
             else 
                ys=ys+ysagz*(xn/2500.)**2
             endif
             ys=ys+ysagln*(1.-xn/2500.)**2



      tn3=-2.05

      ts=tn3+axb3*wxb3+axl3*wxl3+axv3*wxv3+ay3*wxay3+
     +     sagz3*wxsz3+az3*wxaz3+sagy3*wxsy3


      xs=xn
      xuse=xs
      yuse=ys 
      zuse=zs
      end

      double precision function wxl(x,L)
      implicit none
      double precision x,L
      wxl=((-abs(x)+L/2)/(L/2))
      end

      double precision function wxv(x,L)
      implicit none
      double precision x,L
      wxv=0.5*((-x+L/2)/(L/2))-0.5*((x+L/2)/(L/2))
      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 RASNIK_PROBLEM h73 < mailinfo')
*                istat=system('mail -s RASNIK_PROBLEM d65 < mailinfo')
*                istat=system('mail -s RASNIK_PROBLEM d90 < mailinfo')
                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 TEMP_PROBLEM h73 < mailinfo')
*                istat=system('mail -s TEMP_PROBLEM d65 < mailinfo')
*                istat=system('mail -s TEMP_PROBLEM d90 < mailinfo')
                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

