	SUBROUTINE PSSBUF

	INCLUDE 'PSAMOI.INC'

	if(.not.yasetup)call pssetup

	DO 1 LB=79,1,-1
	IF(TBUF(LB).NE.' ')GOTO 2
1	CONTINUE
	RETURN

2	IF (MOUCHARD) WRITE(LUM,6000)(TBUF(I),I=1,LB)
6000		      FORMAT(1X,79A1)

	LB=LB+1
	TBUF(LB)=13              ! CR !

	IF (OKPS) CALL PSSEND(LB,TBUF)

	RETURN
	END



	SUBROUTINE PSSETUP    ! on fait un PSETUP si OKPS et not YASETUP

	INCLUDE 'PSAMOI.INC'

	DIMENSION ISTAT(2)

	ISTAT(1)=0
	ISTAT(2)=0

	IF (.NOT.YAREP)CALL PSWITH

	IF (MOUCHARD) WRITE(LUM,*) ' {...................PSETUP }'

	IF (YASETUP) RETURN

	YASETUP=.TRUE.
	IF (OKPS) CALL PSETUP(7,8,.FALSE.,1,ISTAT)

	RETURN
	END


	SUBROUTINE PSSEXIT    ! on fait un PSEXIT si OKPS et YASETUP

	INCLUDE 'PSAMOI.INC'

	DIMENSION ISTAT(2)

	if(.not.yasetup)call pssetup

	ISTAT(1)=0
	ISTAT(2)=0

	IF (MOUCHARD) WRITE(LUM,*) ' { ...................PSEXIT }'

	IF (OKPS .AND. YASETUP) CALL PSEXIT(2,ISTAT)
	yasetup=.false.

	RETURN

	END


	SUBROUTINE PSSVSTO(IVT,PL,X,Y,Z,C) ! Attention Z peut etre inutile

	INCLUDE 'PSAMOI.INC'

	INTEGER		IVT,ITPL,ITVEC
	LOGICAL		PL
	LOGICAL		TPL (50000)
	REAL		TVEC(50000*4)
	character	cpl

	DATA		ITPL,ITVEC/0,0/

	IF (IVT.EQ.0)THEN
			CALL PSSVEC(MEMIVT,ITPL,TVEC,TPL)
			ITPL =0
			ITVEC=0
			RETURN
		     END IF

	MEMIVT=IVT

	ITPL=ITPL+1
	TPL(ITPL)=PL

	ITVEC=ITVEC+1
	TVEC(ITVEC)=X
	ITVEC=ITVEC+1
	TVEC(ITVEC)=Y
	IF ( IVT.EQ.1 )THEN
			ITVEC=ITVEC+1
			TVEC(ITVEC)=C  ! couleur ou intensite
			if(     pl)cpl='l'
			if(.not.pl)cpl='p'
			IF(MOUPSV)WRITE(LUM,*)cPL,X,',',Y,',',Z,'i=',C
			RETURN
		       END IF
	IF ( IVT.EQ.2 )THEN
			ITVEC=ITVEC+1
			TVEC(ITVEC)=Z 
			ITVEC=ITVEC+1
			TVEC(ITVEC)=C  ! couleur ou intensite
			if(     pl)cpl='l'
			if(.not.pl)cpl='p'
			IF(MOUPSV)WRITE(LUM,*)cPL,X,',',Y,',',Z,'i=',C
			RETURN
		       END IF
	IF ( IVT.EQ.4 .OR. 
	1    IVT.EQ.6 )THEN
		 	ITVEC=ITVEC+1
			TVEC(ITVEC)=Z
			if(     pl)cpl='l'
			if(.not.pl)cpl='p'
			IF(MOUPSV)WRITE(LUM,*)cPL,X,',',Y,',',Z
			RETURN
		       END IF
			if(     pl)cpl='l'
			if(.not.pl)cpl='p'
	IF(MOUPSV)WRITE(LUM,*)cPL,X,',',Y
	RETURN
	END


	SUBROUTINE PSSVEC(IVT,NVEC,TVEC,TPL)    

 	INCLUDE 'PSAMOI.INC'

	INTEGER		IVT,NVEC
	REAL		TVEC(*)
	LOGICAL		TPL(*)

	INTEGER		IVC,ITVEC,ITPL,MAXPSV

	DIMENSION ISTAT(2)

	if(.not.yasetup)call pssetup

	ISTAT(1)=0
	ISTAT(2)=0

	IF (MOUCHARD) WRITE(LUM,*) ' ; { ..PSVECS of ',nvec,' vectors.}'

	IF (.NOT.OKPS)RETURN

	MAXPSV=2000
	IVEC =NVEC
	ITVEC=1
	ITPL =1

1	IF (IVEC.LE.MAXPSV)GOTO 2
	CALL PSVECS (IVT,MAXPSV,TVEC(ITVEC),TPL(ITPL),.FALSE.,ISTAT)	
	IVEC =IVEC -MAXPSV
	ITVEC=ITVEC+MAXPSV*3	
	ITPL =ITPL +MAXPSV	
	GOTO 1

2	CONTINUE
	CALL PSVECS (IVT,IVEC  ,TVEC(ITVEC),TPL(ITPL),.TRUE. ,ISTAT)	

	RETURN
	END

	SUBROUTINE PSSREAD(IC,ATB,IB)
	
	INCLUDE 'PSAMOI.INC'

	BYTE		ATB(240)
	INTEGER		IC,IB
	BYTE		TB(240)
	CHARACTER*240	B
	EQUIVALENCE	(B,TB)


	if(.not.yasetup)call pssetup

	IF (MOUCHARD)WRITE(LUM,6000)
6000	FORMAT(' { .......................PSREAD }')

	DO I=1,240
		ATB(I)=' '
	END DO

	IF (OKPS)THEN
		     CALL PSREAD(IC,ATB,IB)
		     IF (MOUCHARD) WRITE(LUM,'(1X,80A1)')(ATB(I),I=1,IB)
		     RETURN
		 END IF

	WRITE(LU6,6002)
6002    FORMAT(/' type the message ...max 240 car :')
	B=' '
	READ (5,'(A240)')B

	DO 1 I=1,240
1	ATB(I)=TB(I)
	IB=240

	IF (MOUCHARD) WRITE(LUM,'(1X,80A1)')(ATB(I),I=1,IB)

	RETURN
	END	

	SUBROUTINE PSWITH

	INCLUDE 'PSAMOI.INC'
	BYTE	REP

	WRITE(LU6,6000)
6000	FORMAT(/,'$  connexion with PS300 (y/n)..? :')
	CALL REPONSE(REP)
	OKPS=(REP.EQ.'Y'.or.REP.eq.'O')

	WRITE(LU6,6001)
6001	FORMAT(  '$  show pssend (y/n) ... :')
	CALL REPONSE(REP)
	MOUCHARD=(REP.EQ.'Y'.or.REP.eq.'O'.or.REP.eq.'P')

	LUM=LU6
	IF (REP.EQ.'P')THEN
			WRITE(LU6,6006)
6006			FORMAT('$  	logical unit ... :')
			READ (5,*)LUM
		       END IF

	MOUPSV=MOUCHARD
	IF (.NOT.MOUCHARD)RETURN
	WRITE(LU6,6002)
6002	FORMAT(  '$  show psvecs (y/n) ... :')
	CALL REPONSE(REP)
	MOUPSV=(REP.EQ.'Y'.or.REP.eq.'O')

	YAREP=.TRUE. ! Il faut savoir qu'on a deja pose la question du debug

	RETURN
	END

	SUBROUTINE REPONSE(R)
	BYTE R
	READ(5,'(A1)')R
	if ( r.ge.'a' .and. r.le.'z' )R= R .AND. '137'O    !  majuscule
	RETURN
	END
	
	SUBROUTINE PSSFIC(NOMFIC)

	INCLUDE 'PSAMOI.INC'

	OPEN (10,NAME=NOMFIC,TYPE='OLD',READONLY)

1	READ(10,'(A80)',END=9999)BUF
	CALL PSSBUF
	GOTO 1

9999	CLOSE(10)

	RETURN
	END

	SUBROUTINE PSSFIClu(lu)

	INCLUDE 'PSAMOI.INC'

1	READ(lu,'(A80)',END=9999)BUF
	CALL PSSBUF
	GOTO 1

9999	continue

	RETURN
	END


