*
* $Id$
*
* $Log$
* Revision 1.4  1998/09/02 09:52:44  couet
* - Bug fixed in case of option P. The previous version was not working properly.
*
* Revision 1.3  1997/05/13 11:54:17  couet
* - call csinc1
*
* Revision 1.2  1996/09/11 14:59:35  couet
* - Hgetnt and Hgetn2 (old qp routines) are now replaced by hntld
*
* Revision 1.1.1.1  1996/03/01 11:38:44  mclareni
* Paw
*
*
#include "paw/pilot.h"
*CMZ :          13/02/96  16.02.40  by  O.Couet
*-- Author :    Rene Brun   03/01/89
      SUBROUTINE PAWUWF
*
*        Generates skeleton for a user selection function
*
#include "hbook/hcbook.inc"
#include "paw/pawcom.inc"
#include "paw/pcchar.inc"
#include "paw/quest.inc"
#include "paw/pcslas.inc"
#include "paw/pntold.inc"
#include "paw/pawlun.inc"
      DIMENSION    IOPT(3)
      EQUIVALENCE (IOPTE,IOPT(1)),(IOPTP,IOPT(2)),(IOPTT,IOPT(3))
      CHARACTER*11 CHTAGS(6)
      CHARACTER*9  CHVAR(6)
      CHARACTER*8  CHVART,CHOPT,CHVAR1
      CHARACTER*1  CHS,QUOTE
      LOGICAL      NTNEW
*
      SAVE        QUOTE
      DATA        QUOTE  /''''/
*
*     called by UWFUNC
*     ================
      IF(IQUEST(99).NE.-1)THEN
         CALL KUGETC(CHID,N)
         CALL HNTLD(CHID)
         IF(IQUEST(1).LT.0)GO TO 99
         IF(ID.NE.0.AND.LCID.LE.0)GO TO 99
         CALL KUGETF(CHTITL,NCH)
         IF(NCH.LE.0)GO TO 99
         CALL KUGETC(CHOPT,N)
      ELSE
*
*     called by COMIS
*     ===============
         CALL CSINC1(CHTITL)
         NCH=LENOCC(CHTITL)
         CHOPT=' '
      ENDIF
      CALL UOPTC(CHOPT,'EPT',IOPT)
      NTNEW = .NOT.NTOLD
      IF (NTNEW) THEN
         IF (IOPTP .NE. 0)
     +      PRINT *,' UWFUNC: option P not valid for new Ntuple.'
         IF (IOPTT .NE. 0)
     +      PRINT *,' UWFUNC: option T not valid for new Ntuple.'
         IOPTP  = 0
         IOPTT  = 0
         ITRUNC = 0
      ENDIF
*
*           Check for .
*
      IOPTI=0
      IP=INDEX(CHTITL,'.')
      IF(IP.GT.0)THEN
         IF(IP.EQ.NCH)THEN
            NCH=NCH+1
            CHTITL(NCH:NCH)='F'
         ENDIF
         IF(CHTITL(IP+1:IP+1).NE.'F'.AND.CHTITL(IP+1:IP+1).NE.'f')THEN
            IOPTI=1
            IOPTP  = 0
            IOPTT  = 0
            ITRUNC = 0
         ENDIF
         CHFILE=CHTITL
         CHTEMP=CHTITL(1:IP-1)//'()'
         NCHF=IP-1
      ELSE
#if defined(CERNLIB_UNIX)
         CHFILE=CHTITL(1:NCH)//'.F'
#endif
#if defined(CERNLIB_APOLLO)
         CHFILE=CHTITL(1:NCH)//'.FTN'
#endif
#if defined(CERNLIB_VAX)
         CHFILE=CHTITL(1:NCH)//'.FOR'
#endif
#if defined(CERNLIB_IBM)
         CHFILE=CHTITL(1:NCH)//'.FORTRAN'
#endif
         CHTEMP=CHTITL(1:NCH)//'()'
         NCHF=NCH
      ENDIF
*
      CALL PALUNF(70,3,LUN)
      IF(LUN.EQ.0)GO TO 99
#if defined(CERNLIB_APOLLO)||defined(CERNLIB_UNIX)
*        CALL CUTOL(CHFILE)
#endif
*
      CALL KUOPEN(LUN,CHFILE,'UNKNOWN',ISTAT)
      IF(ISTAT.NE.0)GO TO 99
      LUNIT(LUN)=9
*
      IF (NTNEW) THEN
         CHOPT='P'
         IF(IOPTI.NE.0)CHOPT='PI'
         CALL HUWFUN(LUN, ID, CHTEMP(1:NCHF), ITRUNC,CHOPT)
         GOTO 30
      ENDIF
*
      NCH=LENOCC(CHTEMP)
      IF(IOPTI.EQ.0)THEN
         WRITE(LUN,1000)CHTEMP(1:NCH)
      ELSE
         WRITE(LUN,1001)
      ENDIF
      NVAR=IQ(LCID+2)
      ITAG1=IQ(LCID+10)
      KLOOP=2
      IF(IOPTP.NE.0.OR.IOPTT.NE.0)THEN
         KLOOP=3
      ENDIF
      DO 20 K=1,KLOOP
         DO 10 I=1,NVAR,6
            IF(I+5.GT.NVAR)THEN
               JMAX=MOD(NVAR,6)
            ELSE
               JMAX=6
            ENDIF
            DO 5 J=1,JMAX
               IVAR=I+J-1
               J1=2*I+2*J-4
               CALL UHTOC(IQ(LCID+ITAG1+J1),4,CHVART,8)
               IF(CHVART.EQ.' ')THEN
                  IF(IVAR.LT.10)THEN
                     WRITE(CHVART,5100)IVAR
                  ELSEIF(IVAR.LT.100)THEN
                     WRITE(CHVART,5200)IVAR
                  ELSE
                     WRITE(CHVART,5300)IVAR
                  ENDIF
               ENDIF
               IF (J1.EQ.0) CHVAR1=CHVART
               IF(K.EQ.3)THEN
                  IF(IVAR.LT.NVAR)THEN
                     CHTAGS(J)=QUOTE//CHVART//QUOTE//','
                  ELSE
                     CHTAGS(J)=QUOTE//CHVART//QUOTE//'/'
                  ENDIF
               ENDIF
               IF(IVAR.LT.NVAR)THEN
                  CHVAR(J)=CHVART//','
               ELSE
                  CHVAR(J)=CHVART
               ENDIF
               DO 2 L=1,8
                  CHS=CHVAR(J)(L:L)
                  IF(    CHS.EQ.'('.OR.CHS.EQ.')'
     +               .OR.CHS.EQ.'/'.OR.CHS.EQ.BSLASH
     +               .OR.CHS.EQ.'+'.OR.CHS.EQ.'-'
     +               .OR.CHS.EQ.'*'.OR.CHS.EQ.'.')THEN
                     IF(L.EQ.8)THEN
                        CHVAR(J)(L:L)=' '
                     ELSE
                        CHVAR(J)(L:L)='x'
                     ENDIF
                  ENDIF
   2           CONTINUE
   5        CONTINUE
*
            IF(K.NE.3)THEN
               WRITE(LUN,2000)(CHVAR(L),L=1,JMAX)
            ELSE
               WRITE(LUN,2000)(CHTAGS(L),L=1,JMAX)
            ENDIF
  10     CONTINUE
         IF(K.EQ.1) THEN
            WRITE(LUN,2500)
            WRITE(LUN,3000)
         ENDIF
         IF(K.EQ.2.AND.KLOOP.EQ.3)THEN
            WRITE(LUN,3010)NVAR,CHVAR1,NVAR
         ENDIF
  20  CONTINUE
*
      IF(IOPTP.NE.0)THEN
         WRITE(LUN,3500)CHTEMP(1:NCHF),NVAR
      ELSE
         IF(IOPTI.EQ.0)WRITE(LUN,4000)CHTEMP(1:NCHF)
      ENDIF
*
  30  CALL PACLOS(LUN)
      LUNIT(LUN)=0
*
*          Edit file if option 'E'
*
      IF(IOPTE.NE.0)CALL KUEDIT(CHFILE,ISTAT)
*
 1000 FORMAT(6X,'REAL FUNCTION ',A,/,6X,'REAL')
 1001 FORMAT(6X,'REAL')
 2000 FORMAT(5X,'+',6(A))
 2500 FORMAT(
     + '*',/,
     + '      LOGICAL         CHAIN',/,
     + '      CHARACTER*128   CFILE',/,
     + '*',/,
     + '      COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT',/,
     + '      COMMON /PAWCHC/ CFILE',/,
     + '*')
 3000 FORMAT(6X,'COMMON/PAWIDN/IDNEVT,OBS(13),')
 3010 FORMAT(6X,'DIMENSION XDUMMY(',I3,')',/,
     +6X,'EQUIVALENCE (XDUMMY(1),',A,')',/,
     +6X,'CHARACTER*8 CHTAGS(',I3,')',/,6X,'DATA CHTAGS/')
 3500 FORMAT('*',/,6X,A,'=1.',/,
     +6X,'PRINT 1000,IDNEVT',/,
     +6X,'DO 10 I=1,',I3,/,
     +9X,'PRINT 2000,I,CHTAGS(I),XDUMMY(I)',/,
     +'  10  CONTINUE',/,'*',/,
     +' 1000 FORMAT(8H IDNEVT=,I5)',/,
     +' 2000 FORMAT(5X,I3,5X,A,1H=,G14.7)',/,
     +6X,'END')
 4000 FORMAT('*',/,6X,A,'=1.',/,6X,'END')
 5100 FORMAT('V_',I1,5X)
 5200 FORMAT('V_',I2,4X)
 5300 FORMAT('V_',I3,3X)
  99  END
