
	program pixtrace

c   ===================================================================
c		Yves Langevin, 1990
c		Updated june 1995, S. Erard

c	Plots spectral maps on various devices (Mars sessions only).

c	Reads the data from the calibrated data files xxxeven/odd.cal
c	 written by Etalonne.for (the name of the input directory is in ch2).

c	See file "softinfo.txt" for instructions. This program must be linked 
c	 with fenetre.for, and possibly the Uniras library. It writes directly
c	 in Regis language, so it can be used without Uniras on vt color 
c	 screens and regis/sixel printers (although lots of compilations 
c	 warnings would occur).

c	Atmospheric absorption at 2.0 microns is corrected automatically 
c	 from geometric variations (brought back to a vertical geometry).
c	An average Minnaert correction is applied for albedo estimates (search 
c	variable ang and set it to 1. to discard this correction).


c   ===================================================================

	implicit none


	integer*2 	jpix1(10),jpix2(10),jpix(20),buff(72),buff1(72),
     &			imois(10),ij(10),buff2(14),long,hyp,
     &			k,nbf,iph,ips,ipm,ipd,igain,ipx,k1,k2,
     &			im,jh,jm,js,kh,km,ks,jtic,ipix1,ipix2,
     &			xold,yold,id,nspe,jsup,ielim,iphob,gpcol,
     &			ilis,ipuis,ipx1,ipx2,ititre,lsup,ksup,
     &			ka,lk,ic1,ic2,ms,ns,itemp1,itemp2,
     &			dx(4),dy(4),kv, repf

	integer*4 	icol1(18),icol2(18),icol3(18),modcol(6),lun,ilun,
     &			isort,ir,iolx,ioly,i,imode


	real*4	 	blong(6),blat(6),x,y,
     &			rapmin(10),rapmax(10),
     &			matrice(300,26,128),angles(300,26,11),
     &			temps(300,26),apx1,apx2,xmax,ymax,xmin,ymin,
     &			ax,ex,ainc,gomeg,pomeg,alo,ala,
     &			clong,clat,scirup,scirop,
     &			xlim1,xlim2,xdeb,xran,xfin,ydeb,yran,yfin,
     &			airmass,ang,
     &			dat1,dat2,scirap,eca,amoy,amoy2,blongm,blatm,
     &			pinc,pemer,phase

	character*1 	a1,a2
	character*4 	apix(10)

	character*55 	nom,ch2,ch,ch1
	character*15	fic
	character*25	nomf
	character*72 	tit,tiu,wdeb,wfin1,wfin2
	character*2 	sh,sm,ss,th,tm,tt

	common /graf/xdeb,ydeb,xran,yran,xfin,yfin
	common /recad/blongm,blatm,xmin,xmax,ymin,ymax,clong,clat

	data modcol/2,2,2,2,1,2/
	data icol1/0.,345.,330.,320.,300.,280.,240.,205.,190.,180.,
     &  172.,164.,156.,148.,140.,132.,126.,116./
	data icol2/ 4*40.,35.,40.,65.,60.,10*50/
	data icol3/ 6*100.,70.,90.,10*100./


50	jsup=0
5049	type *,' Month: (0 when done)'
	jsup=jsup+1
	accept *,imois(jsup)
	if(imois(jsup).lt.0)goto 5000
	if(imois(jsup).eq.0)goto 5050
	type *,' Day:'
	accept *,ij(jsup)
	goto 5049		
5050	jsup=jsup-1
	ch1='$1$DUA1:[PCCOMMON.BASEISM.CALIB]'
	open(unit=4,file=ch1//'orbit.dat',status='old',shared)
	do 5120 i=1,12
	  read(4,5200)id,im,jh,jm,js,kh,km,ks,nom,nomf,nspe,igain
	  read(4,5201)ax,ex,ainc,gomeg,pomeg,iph,ipm,ips,ipd,alo,ala
	  if(imois(1).eq.im.and.ij(1).eq.id)goto 5121
5120	continue
5200	format(1x,2i3,2x,6i3,1x,a13,a13,i5,i2)
5201	format(1x,f8.2,f9.6,f9.4,2f8.3,4i3,2f4.1)
5121	close(unit=4)
	ielim=2
	if(im.eq.2.and.id.lt.16)ielim=1
	type 5200,id,im,jh,jm,js,kh,km,ks,nom,nomf,nspe,igain
	type 5201,ax,ex,ainc,gomeg,pomeg,iph,ipm,ips,ipd,alo,ala


	fic='/'
	if(nom(1:9).eq.'mars0802.')then
		yold=9
		xold=296
		fic='pav'
	endif
	if(nom(1:9).eq.'mars1102.')then
		yold=9
		xold=274
		fic='bib'
	endif
	if(nom(1:9).eq.'mars0103.')then
		yold=26
		xold=121
		fic='syr'
	endif
	if(nom(1:9).eq.'mars1303.')then
		yold=26
		xold=91
		fic='oly'
	endif
	if(nom(1:9).eq.'mars0703.')then
		yold=26
		xold=121
		fic='vmc'
	endif
	if(nom(1:9).eq.'mars2102.')then
		yold=26
		xold=98
		fic='ara'
	endif
	if(nom(1:9).eq.'mars2702.')then
		yold=26
		xold=121
		fic='dae'
	endif
	if(nom(1:9).eq.'mars1203.')then
		yold=26
		xold=121
		fic='aur'
	endif
	if(nom(1:9).eq.'mars2603.')then
		yold=26
		xold=120
		fic='heb'
	endif
	if(nom(1:9).eq.'mars2103.')then
		yold=26
		xold=120
		fic='asc'
	endif
	if(nom(1:9).eq.'mars1403.')then
		yold=26
		xold=120
		fic='gor'
	endif
	iphob=1
	if(fic.eq.'/')then
	 iphob=2
	 type*,'Mars sessions only'
	endif

	call inigra

131	format(1x,I3,3x,3(E14.6))
716	format(3x,i3,3x,e11.5,3x,f6.4)
99	format(a14)


c	-----  Open and reads input files  -----

	ch2='$1$DUA1:[PCCOMMON.BASEISM.CAL_DATA.MARS]'
	ch='$1$DUA1:[PCCOMMON.BASEISM.GEOMETRY]'

	open(12,file='carte.dat',status='new')
	write(12,*)nom
	write(12,*)xold, yold

	long=36
	nbf=0

	open(unit=8,file=ch2//fic//'even.cal',form='unformatted',
     *	recl=long,access='direct',status='old')
	open(unit=9,file=ch2//fic//'odd.cal',form='unformatted',
     * 	recl=long,access='direct',status='old')
	open(unit=2,file=ch//fic//'_coor.dat',form='unformatted',
     * 	recl=7,access='direct',status='old')

	do x=1,xold
	 do y=2,yold

	  nbf=nbf+1
	  read(8'nbf)buff		!even channels
	  read(9'nbf)buff1		!odd channels
	  read(2'nbf)buff2		! coordinates and angles

	  jh=buff(1)
	  jm=buff(2)
	  js=buff(3)
	  jtic=buff(4)
	  temps(x,y)=jh*3600.+jm*60.+js+jtic*0.125	! Time in s
	  if (buff(5).ne.x)type*,'LŽzard en x', x, y
	  if (buff(6).ne.y)type*,'LŽzard en y', x, y

 	  do i=1,32
	   matrice(x,y,i*2)=buff(i+8)
	   matrice(x,y,i*2-1)=buff1(i+8)
	  enddo
	  do i=1,32
	   matrice(x,y,i*2+63)=buff(i+40)
	   matrice(x,y,i*2+64)=buff1(i+40)
	  enddo
	  do i=1,128
	   matrice(x,y,i)=matrice(x,y,i)/32767.0/2.
	  enddo
	
	  if (buff2(1).ne.x)type*,'LŽzard coord en x', x, y
	  if (buff2(2).ne.y)type*,'LŽzard coord en y', x, y
	  do k=1,11
	   angles(x,y,k)=buff2(k+2)/100.
	  enddo

	 enddo
	enddo
	close(8)
	close(9)
	close(2)
	if(nbf.eq.0) type*, 'Timing problem...'

	type*,'End in line',xold,', sample',yold
	type*,'Nb of spectra read:',nbf



5002	ipx1=0
	type *,' Smooth (1 = yes ) ?'
	accept *,ilis
936	type *,' # of 1st channels: (0 when done)'
	accept 54,ipix1
	if(ipix1.le.0)goto 937
	ipx1=ipx1+1
	jpix1(ipx1)=ipix1
	goto 936
937	if(ipx1.eq.0)goto 50
	apx1=1./float(ipx1)
	ipx2=0
938	type *,' # of 2nd channels: (0 when done)'
	accept 54,ipix2
	if(ipix2.lt.0.and.ipx2.eq.0)ipx2=-1
	if(ipix2.le.0)goto 939
	ipx2=ipx2+1
	jpix2(ipx2)=ipix2
	goto 938
54	format(i3)
945	format(i3,',')
946	format(i3,'/')
947	format(i3,' ')
939	ka=0
	type *,' Exponent : 1 or 2 ? (1 is standard) '
	accept *,ipuis
	if(ipx1.gt.1)then
	  do  k=1,(ipx1-1)
	    ka=ka+1
	    write(apix(ka),945)jpix1(k)
	  end do
	endif
	ka=ka+1
	write(apix(ka),946)jpix1(ipx1)
	if(ipx2.le.0)goto 959
	apx2=1./float(ipx2)
	if(ipx2.gt.1)then
	  do k=1,(ipx2-1)
	    ka=ka+1
	    write(apix(ka),945)jpix2(k)
	  end do
	endif
	ka=ka+1
	write(apix(ka),947)jpix2(ipx2)
959	ka=ka+1
	do k=ka,10
	  apix(k)='    '
	end do

	k2=1
	jpix(1)=jpix1(1)
	do k=1,ipx1
	  i=0
	  do k1=1,k2
	    if (jpix1(k).eq.jpix(k1)) i=1
	  enddo
	  if(i.ne.1)then
	    k2=k2+1
	    jpix(k2)=jpix1(k)
	  endif	
	end do
	do k=1,ipx2
	  i=0
	  do k1=1,k2
	    if (jpix2(k).eq.jpix(k1)) i=1
	  enddo
	  if(i.ne.1)then
	    k2=k2+1
	    jpix(k2)=jpix2(k)
	  endif	
	end do
	ipx=k2

	write(12,*)ipx1,(jpix1(k),k=1,ipx1)
	write(12,*)ipx2,(jpix2(k),k=1,ipx2)
	write(12,*)ipx,(jpix(k),k=1,ipx)

	
3500	type *,'  Eastern long. (<0 to change channels): '
	accept *,xmax
	if(xmax.lt.0.)goto 3000
	type *,'  Western long.: '
	accept *,xmin
	type *,'  Mini lat.: '
	accept *,ymin
	type *,'  Max lat.: '
	accept *,ymax
	imode=1
	if(xmax.gt.xmin)imode=2
8538	do ksup=1,jsup
	  type 8540,ksup
8540	format(' Mini value for file #',i2,'(<0 to change the scale)')
	  accept *, rapmin(ksup)
	  if(rapmin(1).lt.0.)goto 3500
	  type *,' Max value: '
	  accept *,rapmax(ksup)
	end do
	type *,'  Hypsometry ? (1 = yes)'
	accept *,hyp
	ititre=1
8539	type*,' VT340 (1) Regis file (2) GPX (3) PostScript (4) Other (5)'
	accept *,isort
	if (isort.gt.5) goto 8539
	if (isort.eq.5) isort=6
	if (isort.eq.2.or.isort.eq.4)then
	 type *,' With title (1 = yes)?'
	 accept *,ititre
	endif
	if(isort.eq.3)then
329	  type*,' B/W (1) or color (2)?'
	  accept*, gpcol
	  if (gpcol.lt.1.or.gpcol.gt.2)goto329
	  if (gpcol.eq.1)isort=5
	endif
c	repf=1
c	if(repf.eq.1)write(10,*)'Heure, ligne, echant, valeur, couleur'
	call inifen(isort)
	xlim1=xdeb+1.5*xran
	xlim2=xdeb+2.*xran
	ksup=1
	lsup=jsup

	if(isort.gt.2)then
	  call gmslev('I','I','T','A')
	  CALL GOPEN
	  call gcharf('SOFT')
	  call gcharf('CART')
	  if(modcol(isort).eq.1)then
	    call rcmode('BWS',16)
	    call ghalft
	    do i=2,16
	     call gcolor(i,(18-i),0,0,1)
	    enddo
	  else
	    call rcmode('HLS',100)
	    call gcolor(2,icol1,icol2,icol3,18)
	  endif
	  tit(1:5)='    $'
	  tiu(1:5)='    $'
	else
	  open(unit=2,file=ch1//'tabcol.dat',status='old')
	  LUN=6
	  if(isort.eq.2)then
	    type *,' Background white (1) or black (2) '
	    accept *,ilun
	    LUN=LUN+ilun
	    type *,'  title : '
	    accept 2226,tit
2226	    format(a72)
	    open(unit=LUN,file='regis.dat',status='new')
	  endif
	  do lk=1,29
	    read(2,881)wdeb
	    write(LUN,881)wdeb
	  end do
	  if(LUN.eq.7)then
	    write(LUN,923)
923	    format(' S(I7,E)')
	  endif
	  read(2,881)wfin1
	  read(2,881)wfin2
	  iolx=0
	  ioly=0
881	format(a72)
	endif
	if(iphob.ne.2)then
	  if(isort.gt.2)then
	    call axes(tit,tiu,xmin,xmax,ymin,ymax)
	  else
	    call axesl(LUN,xmin,xmax,ymin,ymax)
	  endif
	else
	  if(isort.gt.2)then
	    call axep(tit,tiu,0.,20.,0.,18.)
	  else
	    call axepl(LUN,0.,20.,0.,18.)
	  endif
	endif	
8000	ic1=0
	ic2=0
	amoy=0.
	amoy2=0.
8500	format(3i6,f11.2)
	write(12,*)rapmin(ksup),rapmax(ksup)


c 	----- Compute and plot the map ------


	do ms=1,xold
	 do ns=2,yold
	  if (angles(ms,ns,11).lt.0.) goto 6000
	  ic1=ic1+1
	  do k=1,4
	   blong(k)=360-angles(ms,ns,(k-1)*2+1)	!Back to Mars convention
	   if (blong(k).gt.360.) blong(k)=blong(k)-360.
	   blat(k)=angles(ms,ns,k*2)
	   bLongm=blong(k)
	   bLatm=blat(k)
	   call recads(imode)
	   blong(k)=clong
	   blat(k)=clat
	  enddo
	  pemer=angles(ms,ns,10)*3.14159/180.  	!Take the cosine
	  pinc=angles(ms,ns,9)*3.14159/180.
	  pinc=cos(pinc)
	  pemer=cos(pemer)
	  phase=angles(ms,ns,11)
c	repf=1

	  dat1=1.
	  do k=1,ipx1
	   k1=jpix1(k)
	   dat1=dat1*matrice(ms,ns,k1)
	  end do
	  dat2=1.
	  if(ipx2.gt.0)then
	    do k=1,ipx2
	     k2=jpix2(k)
	     dat2=dat2*matrice(ms,ns,k2)
	    end do
	  endif

	  if(dat2.le.0..or.dat1.le.0.)then
	    scirap=0.001
	  else	
	    scirap=dat1**apx1/(dat2**apx2)
	  endif
	  if(scirap.lt.0.005)goto 6000
	  if (ipuis.eq.2)scirap=scirap*scirap

	  if(ilis.eq.1)then		!Smoothing
	    dx(1)=0
	    dx(2)=0
	    dx(3)=1
	    dx(4)=-1
	    dy(1)=1
	    dy(2)=-1
	    dy(3)=-1
	    dy(4)=1
	    scirup=2.*scirap
	    do kv=1,4
	      if(matrice(ms+dx(kv),ns+dy(kv),8).lt.0.005)then
	        scirup=scirup+scirap
	      else
	        dat1=1.
	        do k=1,ipx1
	          k1=jpix1(k)
	          dat1=dat1*matrice(ms+dx(kv),ns+dy(kv),k1)
	        end do
	        dat2=1.
	        if(ipx2.gt.0)then
	          do k=1,ipx2
	            k2=jpix2(k)
	            dat2=dat2*matrice(ms+dx(kv),ns+dy(kv),k2)
	          end do
	        endif
	        if(dat2.le.0..or.dat1.le.0.)then
	          scirop=scirap
	        else	
	          scirop=dat1**apx1/(dat2**apx2)
	        endif
	        scirup=scirup+scirop
	      endif
	    end do
	    scirap=scirup/6.
	  endif


c		 Correct reflectance with Minnaert model, k=0.7
	  ang=pemer**0.30/pinc**0.70
	  if(ipx2.eq.0)scirap=scirap*ang

c                Correct atmospheric absorption from geometry
	  if(jpix1(1).eq.80.or.jpix1(1).eq.79.or.jpix1(1).eq.56
     &.or.jpix1(1).eq.57)then
	    if (pinc.ne.0.0.and.pemer.ne.0.0) then
		airmass=0.5*(1./pinc+1./pemer)
		scirap=1.-(1.-scirap)/airmass
	    endif
	  endif

	  if(modcol(isort).eq.1)then
	    ir=(scirap-rapmin(ksup))/(rapmax(ksup)-rapmin(ksup))*14.9999+2
	    if(ir.lt.2)ir=2
	    if(ir.gt.16)ir=16
	  else
	    ir=(scirap-rapmin(ksup))/(rapmax(ksup)-rapmin(ksup))*17.9999+2
	    if(ir.lt.2)ir=2
	    if(ir.gt.19)ir=19
	  endif
c	  if(iphob.eq.2)then
c	    irl=mod(LUN,2)
c	    if(ielim.eq.1.or.ic1.eq.1)then
c	      if(idat(i,32).lt.200)ir=irl
c	    else
c	      if(idat((i-1),32).lt.200)ir=irl
c	    endif
c	  endif
c	  if(blong(1).gt.xfin.and.ns.eq.2) goto 666

c	  if(blong(3).gt.xlim1.and.blong(3).lt.xlim2)goto 666
	  if(blong(1).gt.xlim1)goto 6000
	  if(blong(3).gt.xfin)goto 6000
	  if(blong(1).lt.xdeb)goto 6000
	  if(blat(2).lt.ydeb)goto 6000
	  if(blat(4).gt.yfin)goto 6000
	  if(blong(2).lt.alo+.1)goto 6000
	  if(blong(1).lt.alo+.1)goto 6000
	  if(blong(3).lt.alo+.1)goto 6000
	  if(blong(4).lt.alo+.1)goto 6000
	  amoy=amoy+scirap
	  amoy2=amoy2+scirap*scirap
	  ic2=ic2+1
c	  if(repf.eq.1)write(10,*)temps(ms,ns),ms,ns,scirap,ir
	  if(isort.gt.2)then
	    call rsurf(blong,blat,4,ir,0.0)
	  else
	    call lsurf(LUN,blong,blat,ir,iolx,ioly)
	  endif
6000	 enddo
	enddo


666	lsup=lsup-1
	if(lsup.eq.0)goto 9000
	ksup=ksup+1

	open(unit=3,file=ch1//'orbit.dat',status='old',shared)
	do 8120 i=1,12
	  read(3,5200)id,im,jh,jm,js,kh,km,ks,nom,nomf,nspe,igain
	  read(3,5201)ax,ex,ainc,gomeg,pomeg,iph,ipm,ips,ipd,alo,ala
	  if(imois(ksup).eq.im.and.ij(ksup).eq.id)goto 8121
8120    continue
8121	close(unit=3)

	ielim=2
	if(im.eq.2.and.id.lt.16)ielim=1

	fic='/'
	type*,nom
	if(nom(1:9).eq.'mars0802.')then
		yold=9
		xold=296
		fic='pav'
	endif
	if(nom(1:9).eq.'mars1102.')then
		yold=9
		xold=274
		fic='bib'
	endif
	if(nom(1:9).eq.'mars0103.')then
		yold=26
		xold=121
		fic='syr'
	endif
	if(nom(1:9).eq.'mars1303.')then
		yold=26
		xold=91
		fic='oly'
	endif
	if(nom(1:9).eq.'mars0703.')then
		yold=26
		xold=121
		fic='vmc'
	endif
	if(nom(1:9).eq.'mars2102.')then
		yold=26
		xold=98
		fic='ara'
	endif
	if(nom(1:9).eq.'mars2702.')then
		yold=26
		xold=121
		fic='dae'
	endif
	if(nom(1:9).eq.'mars1203.')then
		yold=26
		xold=121
		fic='aur'
	endif
	if(nom(1:9).eq.'mars2603.')then
		yold=26
		xold=120
		fic='heb'
	endif
	if(nom(1:9).eq.'mars2103.')then
		yold=26
		xold=120
		fic='asc'
	endif
	if(nom(1:9).eq.'mars1403.')then
		yold=26
		xold=120
		fic='gor'
	endif
	iphob=1
	if(fic.eq.'/')iphob=2

c	-----  Open and reads input files  -----

	write(12,*)nom

	long=36
	nbf=0

	open(unit=8,file=ch2//fic//'even.cal',form='unformatted',
     *	recl=long,access='direct',status='old')
	open(unit=9,file=ch2//fic//'odd.cal',form='unformatted',
     * 	recl=long,access='direct',status='old')
	open(unit=2,file=ch//fic//'_coor.dat',form='unformatted',
     * 	recl=7,access='direct',status='old')

	do x=1,xold
	 do y=2,yold

	  nbf=nbf+1
	  read(8'nbf)buff		!even channels
	  read(9'nbf)buff1		!odd channels
	  read(2'nbf)buff2		! coordinates and angles

	  jh=buff(1)
	  jm=buff(2)
	  js=buff(3)
	  jtic=buff(4)
	  temps(x,y)=jh*3600.+jm*60.+js+jtic*0.125	! Time in s
	  if (buff(5).ne.x)type*,'LŽzard en x', x, y
	  if (buff(6).ne.y)type*,'LŽzard en y', x, y

 	  do i=1,32
	   matrice(x,y,i*2)=buff(i+8)
	   matrice(x,y,i*2-1)=buff1(i+8)
	  enddo
	  do i=1,32
	   matrice(x,y,i*2+63)=buff(i+40)
	   matrice(x,y,i*2+64)=buff1(i+40)
	  enddo
	  do i=1,128
	   matrice(x,y,i)=matrice(x,y,i)/32767.0/2.
	  enddo
	
	  if (buff2(1).ne.x)type*,'LŽzard coord en x', x, y
	  if (buff2(2).ne.y)type*,'LŽzard coord en y', x, y
	  do k=1,11
	   angles(x,y,k)=buff2(k+2)/100.
	  enddo

	 enddo
	enddo

	close(8)
	close(9)
	close(2)
	if(nbf.eq.0) type*, 'Timing problem...'
	type*,'End in line',xold,', sample',yold
	type*,'Nb of spectra read:',nbf
	goto 8000

9000	if(ic2.ne.0)then
	  amoy=amoy/ic2
	  amoy2=amoy2/ic2
	endif
	eca=sqrt(abs(amoy2-amoy**2))
        write(sh,fmt=2221)jh
        write(sm,fmt=2221)jm
        write(ss,fmt=2221)js
        write(th,fmt=2221)kh
        write(tm,fmt=2221)km
        write(tt,fmt=2221)ks
2221	format(i2.2)
521	continue
	write(unit=tiu,fmt=2223)amoy,eca,(apix(k),k=1,9)
2223	format(f8.4,' +/-',f8.5,'  Chan: ' 9a4,'$')
	write(12,*)tiu
	if(isort.gt.2)then
	  call mire(1)
	else
	  call mirl(LUN)
	endif
	call echell3(isort,LUN,rapmin(1),rapmax(1))

	if(ititre.eq.1)call titre(isort,LUN,tiu,tit)
	write(12,*)nom
	write(12,*)tiu

	if(hyp.eq.1)
     &	    call hypsos(isort,LUN,xmin,xmax,ymin,ymax)
	if(isort.gt.2)then
	  CALL GCLOSE
	else
	  close(unit=2)
	  write(LUN,881)wfin1
	  if (isort.eq.1) accept 141,a1
	  write(LUN,881)wfin2
	  close(unit=LUN)
	endif
	type 2225,amoy,eca
	type *,tiu
2225	format(3x,' mean : ',f9.5,' std-dev : ',f9.5)
	if(isort.eq.2.or.isort.eq.4)goto 5000
	if(jsup.eq.1)goto 8537


	ksup=1
	open(unit=3,file=ch1//'orbit.dat',status='old',shared)
	do i=1,12
	  read(3,5200)id,im,jh,jm,js,kh,km,ks,nom,nomf,nspe,igain
	  read(3,5201)ax,ex,ainc,gomeg,pomeg,iph,ipm,ips,ipd,alo,ala
	  if(imois(ksup).eq.im.and.ij(ksup).eq.id)goto 8221
	enddo
8221	close(unit=3)

	ielim=2
	if(im.eq.2.and.id.lt.16)ielim=1
	itemp1=60*jh
	itemp1=60*itemp1+60*jm+js
	itemp2=60*kh
	itemp2=60*itemp2+60*km+ks

	if(nom(1:9).eq.'mars0802.')then
		yold=9
		xold=296
		fic='pav'
	endif
	if(nom(1:9).eq.'mars1102.')then
		yold=9
		xold=274
		fic='bib'
	endif
	if(nom(1:9).eq.'mars0103.')then
		yold=26
		xold=121
		fic='syr'
	endif
	if(nom(1:9).eq.'mars1303.')then
		yold=26
		xold=91
		fic='oly'
	endif
	if(nom(1:9).eq.'mars0703.')then
		yold=26
		xold=121
		fic='vmc'
	endif
	if(nom(1:9).eq.'mars2102.')then
		yold=26
		xold=98
		fic='ara'
	endif
	if(nom(1:9).eq.'mars2702.')then
		yold=26
		xold=121
		fic='dae'
	endif
	if(nom(1:9).eq.'mars1203.')then
		yold=26
		xold=121
		fic='aur'
	endif
	if(nom(1:9).eq.'mars2603.')then
		yold=26
		xold=120
		fic='heb'
	endif
	if(nom(1:9).eq.'mars2103.')then
		yold=26
		xold=120
		fic='asc'
	endif
	if(nom(1:9).eq.'mars1403.')then
		yold=26
		xold=120
		fic='gor'
	endif
	iphob=1
	if(fic.eq.'/')iphob=2

c	-----  Open and reads input files  -----

	write(12,*)nom

	long=36
	nbf=0

	open(unit=8,file=ch2//fic//'even.cal',form='unformatted',
     *	recl=long,access='direct',status='old')
	open(unit=9,file=ch2//fic//'odd.cal',form='unformatted',
     * 	recl=long,access='direct',status='old')
	open(unit=2,file=ch//fic//'_coor.dat',form='unformatted',
     * 	recl=7,access='direct',status='old')

	do x=1,xold
	 do y=2,yold

	  nbf=nbf+1
	  read(8'nbf)buff		!even channels
	  read(9'nbf)buff1		!odd channels
	  read(2'nbf)buff2		! coordinates and angles

	  jh=buff(1)
	  jm=buff(2)
	  js=buff(3)
	  jtic=buff(4)
	  temps(x,y)=jh*3600.+jm*60.+js+jtic*0.125	! Time in s
	  if (buff(5).ne.x)type*,'LŽzard en x', x, y
	  if (buff(6).ne.y)type*,'LŽzard en y', x, y

 	  do i=1,32
	   matrice(x,y,i*2)=buff(i+8)
	   matrice(x,y,i*2-1)=buff1(i+8)
	  enddo
	  do i=1,32
	   matrice(x,y,i*2+63)=buff(i+40)
	   matrice(x,y,i*2+64)=buff1(i+40)
	  enddo
	  do i=1,128
	   matrice(x,y,i)=matrice(x,y,i)/32767.0/2.
	  enddo
	
	  if (buff2(1).ne.x)type*,'LŽzard coord en x', x, y
	  if (buff2(2).ne.y)type*,'LŽzard coord en y', x, y
	  do k=1,11
	   angles(x,y,k)=buff2(k+2)/100.
	  enddo

	 enddo
	enddo

	close(8)
	close(9)
	close(2)


8537	type*,' Need to change the values/scale (y/n/q)?'
	accept 141,a2
	if (a2.eq.'y'.or.a2.eq.'Y')goto8538
	if (a2.eq.'q'.or.a2.eq.'Q')goto5000
	goto8539

3000	type *,' Another ratio ? (y = yes)'
	accept 141,a1
	if(a1.eq.'y'.or.a1.eq.'Y') then
	  go to 5002
	endif
	go to 50
141	format(a1)

5000	stop
      	end