	subroutine axes(tit,tiu,xmin,xmax,ymin,ymax)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	character*8  axx(7),ayy(7)
	character*40 tit,tiu
	if(xmin.lt.xmax)then
	  delx=(xmax-xmin-360.)/5.
	else 
	  delx=(xmax-xmin)/5.
	endif
	xtit=xmin-delx
	do itit=1,6
	  xtit=xtit+delx
	  if(xtit.lt.0.)xtit=xtit+360.
	  write(axx(itit),421)xtit
	end do
	dely=(ymax-ymin)/4.
	ytit=ymin-dely
	do itit=1,5
	  ytit=ytit+dely
	  write(ayy(itit),421),ytit
	end do
421	format(f6.2,' $')
	yhei=yran/40.
	xlen=xran/16.
	xdel=xran/5.
	ydel=yran/4.
	call mire(1)
	xdc=xdeb-xlen/2
	ydc=ydeb-2.1*yhei
	do i=1,6
	  call gchar(axx(i),xdc,ydc,yhei)
	  xdc=xdc+xdel
	end do
	xdc=xdeb-yran/6.
	ydc=ydeb-yhei*0.5
	do i=1,5
	  call gchar(ayy(i),xdc,ydc,yhei)
	  ydc=ydc+ydel
	end do	
	return
	end

	subroutine axep(tit,tiu,xmin,xmax,ymin,ymax)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	character*8  axx(7),ayy(7)
	character*40 tit,tiu
	  delx=(xmax-xmin)/5.
	xtit=xmin-delx
	do itit=1,6
	  xtit=xtit+delx
	  if(xtit.lt.0.)xtit=xtit+360.
	  write(axx(itit),421)xtit
	end do
	dely=(ymax-ymin)/4.
	ytit=ymin-dely
	do itit=1,5
	  ytit=ytit+dely
	  write(ayy(itit),421),ytit
	end do
421	format(f6.2,' $')
	yhei=yran/40.
	xlen=xran/16.
	xdel=xran/5.
	ydel=yran/4.
	call mire(1)
	xdc=xdeb-xlen
	ydc=ydeb-2.1*yhei
	do i=1,6
	  call gchar(axx(i),xdc,ydc,yhei)
	  xdc=xdc+xdel
	end do
	xdc=xdeb-yran/6.
	ydc=ydeb-yhei*0.5
	do i=1,5
	  call gchar(ayy(i),xdc,ydc,yhei)
	  ydc=ydc+ydel
	end do	
	return
	end

	subroutine axesl(LUN,xmin,xmax,ymin,ymax)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	character*6  axx(7),ayy(7)
	if(xmin.lt.xmax)then
	  delx=(xmax-xmin-360.)/5.
	else 
	  delx=(xmax-xmin)/5.
	endif
	xtit=xmin-delx
	do itit=1,6
	  xtit=xtit+delx
	  if(xtit.lt.0.)xtit=xtit+360.
	  write(axx(itit),421)xtit
	end do
	dely=(ymax-ymin)/4.
	ytit=ymin-dely
	do itit=1,5
	  ytit=ytit+dely
	  write(ayy(itit),421),ytit
	end do
421	format(f6.2)
	yhei=yran/40.
	xlen=xran/18.
	xdel=xran/5.
	ydel=yran/4.
	call mirl(LUN)
	xdc=xdeb-xlen+0.5
	ydc=ydeb-2.1*yhei
	iydc=465.5-ydc
	if(LUN.ne.7)then
	  write(LUN,910)
910	  format(' W(I7)S(I0)')
	else
	  write(LUN,909)
909	  format(' W(I0)S(I7)')
	endif
	do i=1,6
	  ixdc=xdc-2
	  write(LUN,912)ixdc,iydc,axx(i)
912	  format(' P[',I3,',',I3,']T(A0)''',A6,'''')
	  xdc=xdc+xdel
	end do
	xdc=xdeb-yran/6.
 	ixdc=xdc+0.5
	ydc=ydeb-yhei*0.5
	do i=1,5
	  iydc=462.5-ydc
	  write(LUN,912)ixdc,iydc,ayy(i)
	  ydc=ydc+ydel
	end do	
	write(LUN,914)
914	format(' T(A1,M1) P[0,0]')
	return
	end

	subroutine axepl(LUN,xmin,xmax,ymin,ymax)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	character*6  axx(7),ayy(7)
	  delx=(xmax-xmin)/5.
	xtit=xmin-delx
	do itit=1,6
	  xtit=xtit+delx
	  if(xtit.lt.0.)xtit=xtit+360.
	  write(axx(itit),421)xtit
	end do
	dely=(ymax-ymin)/4.
	ytit=ymin-dely
	do itit=1,5
	  ytit=ytit+dely
	  write(ayy(itit),421),ytit
	end do
421	format(f6.2)
	yhei=yran/40.
	xlen=xran/18.
	xdel=xran/5.
	ydel=yran/4.
	call mirl(LUN)
	xdc=xdeb-xlen+0.5
	ydc=ydeb-2.1*yhei
	iydc=465.5-ydc
	if(LUN.ne.7)then
	  write(LUN,910)
910	  format(' W(I7)S(I0)')
	else
	  write(LUN,909)
909	  format(' W(I0)S(I7)')
	endif
	do i=1,6
	  ixdc=xdc-2
	  write(LUN,912)ixdc,iydc,axx(i)
912	  format(' P[',I3,',',I3,']T(A0)''',a6,'''')
	  xdc=xdc+xdel
	end do
	xdc=xdeb-yran/6.
 	ixdc=xdc+0.5
	ydc=ydeb-yhei*0.5
	do i=1,5
	  iydc=462.5-ydc
	  write(LUN,912)ixdc,iydc,ayy(i)
	  ydc=ydc+ydel
	end do	
	write(LUN,914)
914	format(' T(A1,M1) P[0,0]')
	return
	end

	subroutine inifen(isor)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	goto (501,501,502,504,502,505),isor
501	xdeb=85.	!Regis file/screen
	ydeb=35.
	xran=475.
	yran=380.
	xfin=xdeb+xran
	yfin=ydeb+yran
	return
502	xdeb=40		!Gpx display
	ydeb=80	!30 valeur pour le format complet,comme VT340
	xran=250
	yran=100	!200
	xfin=xdeb+xran
	yfin=ydeb+yran
	call groute('sel mgpx;ex')
	return
503	xdeb=17		!Dec ln03 laser printer
	ydeb=65
	xran=225
	yran=90
	xfin=xdeb+xran
	yfin=ydeb+yran
	call groute('sel gln03a;ex')
	return
504	xdeb=27		!PostScript printer
	ydeb=25
	xran=200
	yran=160
	xfin=xdeb+xran
	yfin=ydeb+yran
	call groute('sel mpost;ex')
	return
505	xdeb=35		!Any device (answer 'list' to Uniras prompt)
	ydeb=12
	xran=180
	yran=144
	xfin=xdeb+xran
	yfin=ydeb+yran
	call groute(' ')
	return
506	xdeb=17		!Small size for ln03a
	ydeb=65
	xran=150
	yran=60
	xfin=xdeb+xran
	yfin=ydeb+yran
	call groute('sel gln03a;ex')
	return
	end


	SUBROUTINE INIGRA
	COMMON/GRAPH/IG(8,8,22)
	open(unit=3,file='motif.dat',status='old')
	do 900 it=1,22
	  read(3,901)it1
	  do 900 iy=1,8
	    read(3,902)(ig(ix,iy,it),ix=1,8)
900	continue
901	format(i2)
902	format(8i2)
	close(3)
	RETURN
	END

	subroutine hachur(icol,nseg,iy,x1,NKOL)
	COMMON/GRAPH/IG(8,8,22)
	dimension x(2),y(2),X1(100),x2(100),NKOL(100)

	DO 884 J=1,NSEG-1
	X2(J)=X1(J+1)-1
884	CONTINUE


	DO 700 K=1,NSEG-1
        im=1
	it=NKOL(K)
	x(1)=X1(K)
	x(2)=X2(K)
c	if(icol.lt.3)then
c	  ix1=x1(k)+0.1
c	  ix2=x2(k)+0.1
c	  do 721 ix=ix1,ix2
c	    iix=mod(ix,8)+1
c	    goto (722,723),im
c722	    if(ig(iix,iiy,it).eq.1)then
c              jx=ic(ix)
c	      im=2
c	      ibuf(1)=29
c	      call wtall(1,ibuf,5,ierr)
c	    end if 
c	    goto 721
c723	    if(ig(iix,iiy,it).eq.0)then
c             jx=ic(ix-1)
c	      im=1
c	    call tryx(jy,jx,ibuf(1))
c	    call wtall(1,ibuf,4,ierr)
c	  end if 
c721	  continue
c	  jx=ic(ix2)
c	  if(im.eq.2)then
c	    call tryx(jy,jx,ibuf(1))
c	    call wtall(1,ibuf,4,ierr)
c	  else
c	    ibuf(1)=29
c	    call tryx(jy,jx,ibuf(2))
c	    call wtall(1,ibuf,5,ierr)
c	    call tryx(jy,jx,ibuf(1))
c	    call wtall(1,ibuf,4,ierr)  
c	  endif
c	else
	  call blicol(nkol(k),x,y,2)
c	endif
700 	continue
	return
	end

	subroutine recadr(imod,x,y,xmi,xma,ymi,yma,xr,yr)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	if(imod.eq.1)then
	  xr=xdeb+(x-xmi)/(xma-xmi)*xran
	else
	  if(x.le.(xmi+60.))then
	    x=x+360.
	  endif
	  xr=xran*(x-xmi-360.)/(xma-xmi-360.)+xdeb
	endif
	yr=yran*(y-ymi)/(yma-ymi)+ydeb
	return
	end

	subroutine recads(imod)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	common/recad/x,y,xmi,xma,ymi,yma,xr,yr
	if(imod.eq.1)then
	  xr=xdeb+(x-xmi)/(xma-xmi)*xran
	else
	  if(x.le.(xmi+60.))then
	    x=x+360.
	  endif
	  xr=xran*(x-xmi-360.)/(xma-xmi-360.)+xdeb
	endif
	yr=yran*(y-ymi)/(yma-ymi)+ydeb
	return
	end

	subroutine mire(is,LUN,icolb)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	if(is.gt.2)then
	  call gwicol(-1.,icolb)
	endif
	y1=ydeb
	y2=yfin
	DO 70 I=1,6
	x1=xdeb+(i-1)*0.2*xran
	x2=x1
	call gvect(x1,y1,0)
	call gvect(x2,y2,1)
70	CONTINUE
	x1=xdeb
	x2=xfin
	DO 170 I=1,5
	y1=ydeb+(i-1)*0.25*yran
	y2=y1
	call gvect(x1,y1,0)
	call gvect(x2,y2,1)
170	CONTINUE
	RETURN
	END

	subroutine mirl(LUN)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	y1=ydeb
	y2=yfin
	if(LUN.ne.7)then
	  write(LUN,910)
910	  format(' W(I7)S(I0)')
	else
	  write(LUN,909)
909	  format(' W(I0)S(I7)')
	endif
	DO 70 I=1,6
	x1=xdeb+(i-1)*0.2*xran
	x2=x1
	ix1=x1+0.5
	iy1=479.5-y1
	ix2=x2+0.5
	iy2=479.5-y2
	write(LUN,917)ix1,iy1,ix2,iy2
917	format(' P[',I3,',',I3,']V[',I3,',',I3,']')
70	CONTINUE
	x1=xdeb
	x2=xfin
	DO 170 I=1,5
	y1=ydeb+(i-1)*0.25*yran
	y2=y1
	ix1=x1+0.5
	iy1=479.5-y1
	ix2=x2+0.5
	iy2=479.5-y2
	write(LUN,917)ix1,iy1,ix2,iy2
170	CONTINUE
	RETURN
	END

	subroutine trace(icol,x,y,kf)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	dimension x(1500),y(1500)
	dimension xt(2),yt(2)
	call gwicol(-1.,icol)
	IMOD=1
	IF(X(1).LT.xdeb.OR.X(1).GT.xfin)IMOD=2
	IF(Y(1).LT.ydeb.OR.Y(1).GT.yfin)IMOD=2
	IF(IMOD.EQ.2)GOTO 499	
499	do 500 kc=2,kf	
	XC=X(KC)
	YC=Y(KC)
	GOTO(501,502),IMOD
501	IF(XC.LT.xdeb.OR.XC.GT.xfin)IMOD=2
	IF(YC.LT.ydeb.OR.YC.GT.yfin)IMOD=2
	IF(IMOD.EQ.2)THEN
	  IF(XC.LT.xdeb)THEN
	    AY=(xdeb-XC)/(X(KC-1)-XC)
            YC=AY*(Y(KC-1)-YC)+YC
	    XC=xdeb
	  ENDIF
	  IF(xc.GT.xfin)THEN
	    AY=(xfin-XC)/(X(KC-1)-XC)
            YC=AY*(Y(KC-1)-YC)+YC
	    XC=xfin
	  ENDIF
	  IF(yc.LT.ydeb)THEN
	    AX=(ydeb-YC)/(Y(KC-1)-YC)
            xc=AX*(X(KC-1)-XC)+XC
	    YC=ydeb
	  ENDIF
	  IF(yc.GT.yfin)THEN
	    AX=(yfin-YC)/(Y(KC-1)-YC)
            XC=AX*(X(KC-1)-XC)+XC
	    yc=yfin
	  ENDIF
	ENDIF
	xt(1)=x(kc-1)
	xt(2)=xc
	yt(1)=y(kc-1)
	yt(2)=yc
	call gvect(xt,yt,2)
	GOTO 500
502	IF(XC.LT.xdeb.OR.XC.GT.xfin)GOTO 500
	IF(YC.LT.ydeb.OR.YC.GT.yfin)GOTO 500
	IMOD=1
	xc1=X(KC-1)
	yc1=Y(KC-1)
	IF(xc1.LT.xdeb)THEN
	  AY=(xdeb-xc1)/(xc-xc1)
          yc1=AY*(yc-yc1)+yc1
	  xc1=xdeb
	ENDIF
	IF(xc1.GT.xfin)THEN
	  AY=(xfin-xc1)/(xc-xc1)
          yc1=AY*(yc-yc1)+yc1
	  xc1=xfin
	ENDIF
	IF(yc1.LT.ydeb)THEN
	  AX=(ydeb-yc1)/(yc-yc1)
          xc1=AX*(xc-xc1)+xc1
	  yc1=ydeb
	ENDIF
	IF(yc1.GT.yfin)THEN
	  AX=(yfin-yc1)/(yc-yc1)
          xc1=AX*(xc-xc1)+xc1
	  yc1=yfin
	ENDIF
	xt(1)=xc1
	xt(2)=xc
	yt(1)=yc1
	yt(2)=yc
	call gvect(xt,yt,2)
500 	continue	
	return
	end

	subroutine titre(isort,LUN,tiu,tit)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	character*60 tiu,tit
	if(isort.gt.3)then
	  yhei=yran/40.
	  call gchar(tiu,xdeb,(yfin+1.5*yhei),yhei)
	else
	  if(LUN.ne.7)then
	    write(LUN,910)
910	    format(' W(I7)S(I0)P[125,20]T(A0)')
	  else
	    write(LUN,909)
909	    format(' W(I0)S(I7)P[125,20]T(A0)')
	  endif
	  if(LUN.ne.6)then
	    write(LUN,902)tit
	  else
	    write(LUN,902)tiu
	  endif
902	  format(1x,'''',a60,'''')
	endif
	return
	end

	subroutine echell1(isort,LUN,rapmi,rapma)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	xech1=xfin+xran/25.
	xech2=xech1+xran/10.
	yram=0.85*yran
	ideb=ydeb
	iram=yram
	iech1=ideb+iram/8
	ifin=yfin
	idec=iram/18+1
	if(isort.eq.4)idec=iram/15
	if(isort.lt.3)then
	  ix1=xech1+3.5
	  ix2=xech2+0.5
	  ix3=ix1-3
	  iyecht=464-ideb-iram/20
	  if(LUN.ne.7)then
	    write(LUN,910)
910	    format(' W(I7)S(I0)')
	  else
	    write(LUN,909)
909	    format(' W(I0)S(I7)')
	  endif
	  write(LUN,912)ix3,iyecht,rapmi
912	  format(' P[',I3,',',I3,']T(A0)''',f6.3,'''')
	  iyecht=464-ifin+iram/20
	  write(LUN,912)ix3,iyecht,rapma
	  write(LUN,903)
903	  format(' T(A1,M1)')
	  do i=2,19
	    iy1=464-ideb-idec*(i-1)
	    iy2=iy1-idec
	    icolt=7
	    if(LUN.eq.7)icolt=0
	    write(LUN,916)icolt,ix1,iy1,ix2,iy1,ix2,iy2,ix1,iy2
	  end do
	endif
916	format(' W(I',i2,',S0)P[',I3,',',I3,']V(B)',	
     &  3('[',I3,',',I3,']'),'(E))W(S0)')
	return
	end

	subroutine echell2(isort,LUN,rapmi,rapma)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	integer*4 kcol1(20),kcol2(20),kmesh(20)
	data kmesh/1,1,1,1,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,1/
	data kcol1/0,4,8,9,10,10,12,12,11,11,1, 1,15,15,13,14,
     &             14,14,2,0/
	data kcol2/0,0,0,0, 0,12, 0,11, 0, 1,0,15, 0,13, 0,13,
     &              0, 2,0,0/
	xech1=xfin+xran/25.
	xech2=xech1+xran/10.
	yram=0.85*yran
	iram=yram
	ideb=ydeb
	ifin=yfin
	iyech1=ideb+iram/8
	idec=iram/18+1
	if(isort.eq.4)idec=iram/15+1
	if(isort.lt.3)then
	  ix1=xech1+3.5
	  ix2=xech2+0.5
	  ix3=ix1-3
	  if(LUN.ne.7)then
	    write(LUN,910)
910	    format(' W(I7)S(I0)')
	  else
	    write(LUN,909)
909	    format(' W(I0)S(I7)')
	  endif
	  write(LUN,903)
903	  format(' T(A1,M1)')
	  do i=2,19
	    iy1=464-ideb-idec*(i-1)
	    iy2=iy1-idec
	    if(kmesh(i).eq.2)then
	      write(LUN,914)kcol1(i),kcol2(i),
     &	      ix1,iy1,ix2,iy1,ix2,iy2,ix1,iy2
	    else
	      write(LUN,915)kcol1(i),
     &        ix1,iy1,ix2,iy1,ix2,iy2,ix1,iy2
	    endif
	  end do
	endif
914	format(' S(I',I2,')F(W(I',I2,',S"2")P[',I3,',',I3,']V(B)',
     &  3('[',I3,',',I3,']'),'(E))W(S0)')
915	format(' F(W(I',I2,',S1)P[',I3,',',I3,']V(B)',
     &  3('[',I3,',',I3,']'),'(E))W(S0)')
916	format(' W(I',i2,',S0)P[',I3,',',I3,']V(B)',	
     &  3('[',I3,',',I3,']'),'(E))W(S0)')
	return
	end

	subroutine echell3(isort,LUN,rapmi,rapma)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	dimension blo(5),bla(5)
	character*7 aniv
	integer*4 kcol1(20),kcol2(20),kmesh(20)
	data kmesh/1,1,1,1,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,1/
	data kcol1/0,4,8,9,10,10,12,12,11,11,1, 1,15,15,13,14,
     &             14,14,2,0/
	data kcol2/0,0,0,0, 0,12, 0,11, 0, 1,0,15, 0,13, 0,13,
     &              0, 2,0,0/
	xech1=xfin+xran/25.
	xech2=xech1+xran/11.8
	yram=0.85*yran
	yech1=ydeb+yram/12.
	ncase1=2
	ncase=19
	ydec=yram/18.
	if(isort.ge.4)then
	  ncase=16
	  ncase1=2
	  ydec=yram/15.
	endif
	if(isort.ge.3)then
	  blo(1)=xech1
	  blo(4)=xech1
	  blo(2)=xech2
	  blo(3)=xech2
	  bla(1)=yech1
	  bla(2)=yech1
	  bla(3)=yech1+ydec
	  bla(4)=yech1+ydec
	  do ic=ncase1,ncase
	    call rsurf(blo,bla,4,ic,0.3)
  	    do k=1,4
	      bla(k)=bla(k)+ydec
	    enddo
	  end do
	  write(aniv,641),rapmi
641	format(f6.3,'$')
	  call gchar(aniv,xech1-5.,(yech1-yran/25.),yran/40.)
	  write(aniv,641),rapma
	  call gchar(aniv,xech1-5.,(yech1+yram+yran/65.),yran/40.)
	else
	  ix1=xech1+3.5
	  ix2=xech2+0.5
	  ix3=ix1-3
	  iyecht=464.5-ydeb-yram/20
	  if(LUN.ne.7)then
	    write(LUN,910)
910	    format(' W(I7)S(I0)')
	  else
	    write(LUN,909)
909	    format(' W(I0)S(I7)')
	  endif
	  write(LUN,912)ix3,iyecht,rapmi
912	  format(' P[',I3,',',I3,']T(A0)''',f6.3,'''')
	  iyecht=463.5-yfin+yram/20.
	  write(LUN,912)ix3,iyecht,rapma
	  write(LUN,903)
903	  format(' T(A1,M1)')
	  do i=2,19
	    iy1=463.5-ydeb-ydec*(i-1)
	    iy2=iy1-ydec
	    if(kmesh(i).eq.2)then
	      write(LUN,914)kcol1(i),kcol2(i),
     &	      ix1,iy1,ix2,iy1,ix2,iy2,ix1,iy2
	    else
	      write(LUN,915)kcol1(i),
     &        ix1,iy1,ix2,iy1,ix2,iy2,ix1,iy2
	    endif
	    icolt=7
	    if(LUN.eq.7)icolt=0
	    write(LUN,916)icolt,ix1,iy1,ix2,iy1,ix2,iy2,ix1,iy2
	  end do
	endif
914	format(' S(I',I2,')F(W(I',I2,',S"2")P[',I3,',',I3,']V(B)',
     &  3('[',I3,',',I3,']'),'(E))W(S0)')
915	format(' F(W(I',I2,',S1)P[',I3,',',I3,']V(B)',
     &  3('[',I3,',',I3,']'),'(E))W(S0)')
916	format(' W(I',i2,',S0)P[',I3,',',I3,']V(B)',	
     &  3('[',I3,',',I3,']'),'(E))W(S0)')
	return
	end


	subroutine tracl(LUN,x,y,kf)
	common/graf/xdeb,ydeb,xran,yran,xfin,yfin
	character*21 wvec
	character*9 wvecs(8)
	dimension x(1500),y(1500)
	dimension xt(2),yt(2)
	IMOD=1
	IF(X(1).LT.xdeb.OR.X(1).GT.xfin)IMOD=2
	IF(Y(1).LT.ydeb.OR.Y(1).GT.yfin)IMOD=2
	JMOD=2
	kst=0
	do 500 kc=2,kf	
	XC=X(KC)
	YC=Y(KC)
	GOTO(501,502),IMOD
501	IF(XC.LT.xdeb.OR.XC.GT.xfin)IMOD=2
	IF(YC.LT.ydeb.OR.YC.GT.yfin)IMOD=2
	IF(IMOD.EQ.2)THEN
	  IF(XC.LT.xdeb)THEN
	    AY=(xdeb-XC)/(X(KC-1)-XC)
            YC=AY*(Y(KC-1)-YC)+YC
	    XC=xdeb
	  ENDIF
	  IF(xc.GT.xfin)THEN
	    AY=(xfin-XC)/(X(KC-1)-XC)
            YC=AY*(Y(KC-1)-YC)+YC
	    XC=xfin
	  ENDIF
	  IF(yc.LT.ydeb)THEN
	    AX=(ydeb-YC)/(Y(KC-1)-YC)
            xc=AX*(X(KC-1)-XC)+XC
	    YC=ydeb
	  ENDIF
	  IF(yc.GT.yfin)THEN
	    AX=(yfin-YC)/(Y(KC-1)-YC)
            XC=AX*(X(KC-1)-XC)+XC
	    yc=yfin
	  ENDIF
	ENDIF
	ixt2=xc+0.5
	iyt2=479.5-yc
 	if(JMOD.EQ.2)then
	  ixt1=x(kc-1)+0.5
	  iyt1=479.5-y(kc-1)
	  if(kst.ne.0)then
	    write(LUN,925)(wvecs(kt),kt=1,kst)
	    kst=0
	  endif
	  write(LUN,917)ixt1,iyt1,ixt2,iyt2
917	format(' P[',I3,',',I3,']V[',I3,',',I3,']')
	else
	  if(kst.eq.8)then
	    write(LUN,925)(wvecs(kt),kt=1,kst)
925	  format(1x,8A9)
	    kst=0
	  endif
	  kst=kst+1
	  write(wvecs(kst),918)(ixt2-iolx),(iyt2-ioly)
918	format('[',I3,',',I3,']')
	  if((ixt2-iolx).ge.0)wvecs(kst)(2:2)='+'
	  if((iyt2-ioly).ge.0)wvecs(kst)(6:6)='+'
	endif
	iolx=ixt2
	ioly=iyt2
	GOTO 500
502	IF(XC.LT.xdeb.OR.XC.GT.xfin)GOTO 500
	IF(YC.LT.ydeb.OR.YC.GT.yfin)GOTO 500
	IMOD=1
	xc1=X(KC-1)
	yc1=Y(KC-1)
	IF(xc1.LT.xdeb)THEN
	  AY=(xdeb-xc1)/(xc-xc1)
          yc1=AY*(yc-yc1)+yc1
	  xc1=xdeb
	ENDIF
	IF(xc1.GT.xfin)THEN
	  AY=(xfin-xc1)/(xc-xc1)
          yc1=AY*(yc-yc1)+yc1
	  xc1=xfin
	ENDIF
	IF(yc1.LT.ydeb)THEN
	  AX=(ydeb-yc1)/(yc-yc1)
          xc1=AX*(xc-xc1)+xc1
	  yc1=ydeb
	ENDIF
	IF(yc1.GT.yfin)THEN
	  AX=(yfin-yc1)/(yc-yc1)
          xc1=AX*(xc-xc1)+xc1
	  yc1=yfin
	ENDIF
	ixt1=xc1
	ixt2=xc
	iyt1=479.5-yc1
	iyt2=479.5-yc
	if(kst.ne.0)then
	  write(LUN,925)(wvecs(kt),kt=1,kst)
	  kst=0
	endif
	write(LUN,917)ixt1,iyt1,ixt2,iyt2
	iolx=ixt2
	ioly=iyt2
500 	JMOD=IMOD	
	if(kst.ne.0)then
	  write(LUN,925)(wvecs(kt),kt=1,kst)
	  kst=0
	endif
	return
	end


	subroutine hypsos(isort,LUN,xmin,xmax,ymin,ymax)
	INTEGER*2 	L2,L1
	dimension 	icr(16),ixmi(2),ixma(2)
	character*11 	nomfi1
	character*55 	ch
	dimension 	ax(1500),ay(1500)
	dimension 	x(1500),y(1500)
	data icr/19,18,17,16,23,22,21,20,11,10,9,8,15,14,13,12/
	pi=acos(-1.)
	KA=0
	im=1
	ch='$1$DUA1:[PCCOMMON.BASEISM.GEOMETRY]'
	nomfi1(1:4)='MARS'
	nomfi1(7:11)='h.dat'
	if(isort.lt.3)then
	  if(LUN.ne.7)then
	    write(LUN,911)
911	    format(' w(I7)S(I0)')
	  else
	    write(LUN,910)
910	    format(' w(I0)S(I7)')
	  endif
	endif	
	if(xmax.gt.xmin) im=2
	ixmax=(xmin-0.001)/45.+1		
	ixmin=(xmax+0.001)/45.+1
	iymin=(ymin+30.)/30.+1
	iymax=(ymax+29.999)/30.+1
	ktour=1
	ixma(1)=ixmax
	ixmi(1)=ixmin
	if(ixmin.gt.ixmax)then
	  ktour=2
	  ixma(1)=8
	  ixmi(2)=1
	  ixma(2)=ixmax
	endif
	do 7000 jcar=iymin,iymax
	do 7000 kto=1,ktour
	do 7000 icar=ixmi(kto),ixma(kto)
728	format(i2.2)
	KCAR=8*JCAR+ICAR-8
	write(nomfi1(5:6),728)ICR(KCAR)
121	format(3x,a11)
	if(icr(kcar).lt.8.or.icr(kcar).gt.23) goto 7000
	OPEN(UNIT=2,FILE=ch//nomfi1,
     1  STATUS='OLD',form='unformatted',SHARED)
	do 800 k=1,1000
	  read(2,end=820)k1,l1,l2,xmi,xma,ymi,yma
	  read(2)(x(j),y(j),j=1,k1)
	  do 810 j=1,k1
810	  call recadr(im,x(j),y(j),xmin,xmax,ymin,ymax,ax(j),ay(j))
	  if(isort.gt.2)then
	    call trace(1,ax,ay,k1)
	  else
	    call tracl(LUN,ax,ay,k1)
	  endif
800	continue
820	CLOSE(UNIT=2)
7000 	continue
	return	
	END

	subroutine lsurf(LUN,blong,blat,ir,iolx,ioly)
	dimension blong(6),blat(6)
	integer*4 ilong(6),ilat(6)
	character*4 along1,alat1
	character*3 along(6),alat(6)
	integer*4 kcol1(20),kcol2(20),kmesh(20)
	data kmesh/1,1,1,1,1,2,1,2,1,2,1,2,1,2,1,2,1,2,1,1/
	data kcol1/0,4,8,9,10,10,12,12,11,11,1, 1,15,15,13,14,
     &             14,14,2,0/
	data kcol2/0,0,0,0, 0,12, 0,11, 0, 1,0,15, 0,13, 0,13,
     &              0, 2,0,0/
      	do kl=1,4
	  ilong(kl)=blong(kl)+0.5
	  ilat(kl)=479.5-blat(kl)
	end do
	write(along1,898)(ilong(1)-iolx)
	if((ilong(1)-iolx).ge.0)along1(1:1)='+'
	write(alat1,898)(ilat(1)-ioly)
	if((ilat(1)-ioly).ge.0)alat1(1:1)='+'
	iolx=ilong(1)
	ioly=ilat(1)
	ilong(5)=ilong(1)
	ilat(5)=ilat(1)
      	do kl=2,5
	  write(along(kl),899)(ilong(kl)-ilong(kl-1))
	  if((ilong(kl)-ilong(kl-1)).ge.0)along(kl)(1:1)='+'
	  write(alat(kl),899)(ilat(kl)-ilat(kl-1))
	  if((ilat(kl)-ilat(kl-1)).ge.0)alat(kl)(1:1)='+'
	end do
898	format(i4)
899	format(i3)
	if(ir.eq.0)then
	  write(LUN,915)along1,alat1,ir,(along(kl),alat(kl),kl=2,5)
	else
	  if(kmesh(ir).eq.2)then
	    write(LUN,914)along1,alat1,kcol1(ir),kcol2(ir),
     &	    (along(kl),alat(kl),kl=2,5)
	  else
	    write(LUN,915)along1,alat1,kcol1(ir),
     &      (along(kl),alat(kl),kl=2,5)
	  endif
	endif
914	format(' P[',A4,',',A4,']S(I',I2,')F(W(I',I2,',S"2")V',
     &  4('[',A3,',',A3,']'),')')
915	format(' P[',A4,',',A4,']F(W(I',I2,',S1)V',
     &  4('[',A3,',',A3,']'),')')
	return
	end
