GEANT321/gxint/gxfca.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:49  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.33  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GXFCA(CHFUNC,NCH,JAD,IER)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *        To analize character string CHFUNC of length NCH        *
  17 C.    *        CHFUNC may be the name of a COMIS function              *
  18 C.    *        or a file name                                          *
  19 C.    *                                                                *
  20 C.    ******************************************************************
  21       COMMON/QUEST/IQUEST(100)
  22       CHARACTER*(*) CHFUNC
  23       CHARACTER*32 CHFILE
  24       INTEGER CSADDR
  25       CHARACTER*(*) BSLASH
  26 #if defined(CERNLIB_BSLASH)
  27       PARAMETER (BSLASH='\\')
  28 #endif
  29 #if !defined(CERNLIB_BSLASH)
  30       PARAMETER (BSLASH='\')
  31 #endif
  32 C.
  33 C.    ------------------------------------------------------------------
  34 C.
  35       JADF=0
  36       IQUEST(1)=0
  37 #if defined(CERNLIB_COMIS)
  38       IF(NCH.LE.1.AND.CHFUNC(1:1).EQ.'0')GO TO 50
  39       IF(NCH.LE.0)GO TO 99
  40       IFILE=0
  41       DO 10 I=1,NCH-1
  42          IF(CHFUNC(I:I).EQ.'.')THEN
  43 #endif
  44 #if (defined(CERNLIB_COMIS))&&(defined(CERNLIB_IBM))
  45             CHFUNC(I:I)=' '
  46 #endif
  47 #if defined(CERNLIB_COMIS)
  48             IF(IFILE.EQ.0)IFILE=I-1
  49          ENDIF
  50   10  CONTINUE
  51   20  IF(IFILE.NE.0)THEN
  52          CHFILE='!FILE '//CHFUNC(1:NCH)
  53          CALL CSEXEC(CHFILE,IRET)
  54          DO 30 I=IFILE,1,-1
  55             IF(CHFUNC(I:I).EQ.'/'.OR.
  56      +         CHFUNC(I:I).EQ.BSLASH.OR.
  57      +         CHFUNC(I:I).EQ.']'.OR.
  58      +         CHFUNC(I:I).EQ.'~')THEN
  59                   I1=I+1
  60                   GO TO 40
  61             ENDIF
  62   30     CONTINUE
  63          I1=1
  64   40     CHFILE=CHFUNC(I1:IFILE)
  65          JADF=CSADDR(CHFILE)
  66          CHFUNC=CHFILE
  67          NCH=IFILE-I1+1
  68       ELSE
  69          JADF=CSADDR(CHFUNC)
  70       ENDIF
  71 #endif
  72   50  JAD=JADF
  73 *
  74   99  END
  75