--- src/Imakefile.orig Fri Mar 20 22:08:10 1998 +++ src/Imakefile Wed Jul 29 01:13:14 1998 @@ -2,7 +2,7 @@ # Imakefile for topdrawer/src # -LIB = ../td.a +LIB = ../td_rtl.a #include "../Imakefile.def" @@ -32,7 +32,7 @@ t2tabl.o \ t2timf.o \ t2xfrm.o \ -td.o \ +td_rtl.o \ tdend.o \ tdtext.o \ token.o \ --- src/Makefile.tmpl.orig Mon Feb 19 21:54:56 1996 +++ src/Makefile.tmpl Wed Jul 29 01:13:14 1998 @@ -1,4 +1,4 @@ -LIB = ../td.a +LIB = ../td_rtl.a ifneq ($(strip $(RAN)),) RANLIB = $(RAN) $(LIB) @@ -39,7 +39,7 @@ t2tabl.o \ t2timf.o \ t2xfrm.o \ -td.o \ +td_rtl.o \ tdend.o \ tdtext.o \ token.o \ --- src/t2mesh.f.orig Fri Feb 2 02:45:08 1996 +++ src/t2mesh.f Wed Jul 29 01:13:14 1998 @@ -832,8 +832,10 @@ REAL ARRAY(NDIM0,NDIM1,NDIM2+1),DXYZ,DDXYZ INTEGER I,IPNT,JXYZ,JTXTUR,J1,J2,J3,J4 INTEGER NERR,NARG + save narg + integer*4 narg_c DATA NERR/0/,NARG/0/ - CALL NOARG(NARG) +c CALL NOARG(NARG) IF (NARG.LT.3 .OR. NARG.GT.10) THEN NERR=NERR+1 CALL T2ERRA(NERR,NARG) @@ -865,6 +867,10 @@ IF (NARG.ge.9) J3=N3 IF (NARG.ge.10) J4=N4 CALL T23HST(ARRAY,1,NDIM1,NDIM2,JXYZ,JTXTUR,DDXYZ,J1,J3,J2,J4) + return + entry td3hst_narg(narg_c) + narg = narg_c + return END SUBROUTINE TD3JIN(ARRAY,NDIM1,NDIM2,IXYZ,ITXTUR,N1,N2,N3,N4) IMPLICIT NONE @@ -970,8 +976,10 @@ REAL ARRAY(NDIM0,NDIM1,NDIM2+1) INTEGER I,IPNT,JXYZ,JTXTUR,J1,J2,J3,J4 INTEGER NERR,NARG + save narg + integer*4 narg_c DATA NERR/0/,NARG/0/ - CALL NOARG(NARG) +c CALL NOARG(NARG) IF (NARG.LT.3 .OR. NARG.GT.9) THEN NERR=NERR+1 CALL T2ERRA(NERR,NARG) @@ -1001,6 +1009,10 @@ IF (NARG.ge.8) J3=N3 IF (NARG.ge.9) J4=N4 CALL T23JIN(ARRAY,1,NDIM1,NDIM2,JXYZ,JTXTUR,J1,J3,J2,J4) + return + entry td3jin_narg(narg_c) + narg = narg_c + return END SUBROUTINE T2_READ_MESH(INFOIN,CARDIN) INTEGER INFOIN(10) --- src/td_rtl.f.orig Thu Jul 30 14:44:33 1998 +++ src/td_rtl.f Wed Jul 29 01:13:14 1998 @@ -19,363 +19,363 @@ C exclusive right to use and disseminate same for any C purpose whatsoever is expressly reserved to the U.S. C and the University. - PROGRAM TD - IMPLICIT NONE - INTEGER PUTENV - INTEGER IARGC - INTEGER NCARG - INTEGER T2BTRIM - LOGICAL ISAFILE - REAL CPUTIM,RELTIM - INTEGER I,J,N,IOSTAT,ICODE - INTEGER INFO(10) - CHARACTER DEFLT*16, TEXT*256, EXT*4, TDDEV*80 - COMMON /T2FLGC/ FLAGS(200), LTRAP,LHANDL,LSYERR,LSCREV - LOGICAL FLAGS, LTRAP,LHANDL,LSYERR,LSCREV(3) - INTEGER RELFLAG - PARAMETER (RELFLAG=151) - INTEGER IWINLEV - INTEGER NWINLEV , MAX_FILL - PARAMETER (NWINLEV =4) - PARAMETER (MAX_FILL=4) - REAL GRDSYM, GRDSIZ, DATDAT(2,8), H2STAT(12), TITLIN(4), TITFA - *C(4), TITLOC(4), TITMAR(4), TITLMX(4), TIKFAC, TITINX, TITX1, TIT - *Y1, TITX, TITY, TITZ, TITSIZ, TITCON(5), REVLEV, REDUCE(5), XFR - *M12(12), XFRM13(12), XFRM14(12), XFRM23(12), XFRM24(12), XFRM34(6 - *), XVARSX(20), CIRSIZ(2,3), ASIZE, AFLARE, SMSZDF, ORAXES(3), EY - *EDIR(3), VUEDIR(3), VUECEN(3), VERTCL(3), EYESEP, SCRD, SCRZ, EYE - *DIS, EYEPNT(3), XYPART(2, 2), BARSIZ(3), BARBRK(3), TIKSIZ(3), XY - *ZBAS(3), TTHETA, TPHI, FRELBL(4), PATRN(20,30), SCLPRM(10,3), WI - *NDOW(4), SCREEN(2), SYMBOL, NOSYMB, FACTXY(19), LBLSIZ, SYMSIZ, X - *YZLIM(3,2), WORLD(3), RADRMX, RADRMN, RADAMN, RADANG, RADX0, RADY - *0, XUNUSD(6), AXANG(3), REDFAC, DSCAL, PATSZ, MARGIN(4), PSCR(2 - *), OREAL, OCPU, CSCRD, DATPTS, ERRPTS, DATXMN, DATXMX, DATYMN, DA - *TYMX, DATZMN, DATZMX, DATSUM, ERRSUM, DATAVE, ERRAVE, DATCEN, ERR - *CEN, DATSTD, ERRSTD, WINREL(2,2,NWINLEV),WINABS(2,2,NWINLEV),WINL - *IM(2,2), FMARKER(3,8), SYDIR(3), GRDIR(3), EXYZLIM(3,2), DSLOPE(2 - *,2) - REAL PLOT_EXTENT(2,2),FILL_ANGLE(MAX_FILL),FILL_WIDTH(MAX_FILL) - INTEGER FILL_INDEX, FILL_TEX(MAX_FILL), N_LINES(6) - EQUIVALENCE (DATDAT, DATPTS) - INTEGER MAXREP - PARAMETER (MAXREP=5) - INTEGER IPATRN, NPATRN(30), NXYLIM(3,2), NPLOTS, NCSETS, NCCOL, N - *CROW, IYEAR, IMONTH, IDAY, ISIGFG, ITXPRI, ITXSEC, ITITDT(3), L - *ENCRD, IPROP, IHTEX, IBLINK, IERASE, ITCNTR, IUNUSD, NXYZ1(3), - *NXYZ2(3), LBLFMT(3), LBLCHR(3), NDIMNS(3), IBLKTP, IDIMNS, NMES - *H0, NMESH1, NMESH2, MESH1, MESH2, MESH3, MESH2D, MESHN(3), NMESHN( - *2), NFIELD, IFIELD(19), NINCR, NPOINT, IVARBL(19), IVPTR(19), I_ - *VORDER(19,2), LINEAR(4), NONLIN(4), MXECHO, LINES, MAXLNS, USRK - *BD, USRSCR, PLTFIL, LINWID, LINCOL, LINTEX, ICPOIN(3), IREPCT(MA - *XREP), LEVREP, GRDTYP, GRDTEX, OUTTEX, IAXTEX, TITEX, LETSET, LAB - *TEX, TICTEX, SHADOWTYP,SHADOWTEX, NXYZDEF1(10), NXYZDEF2(10), IF - *ILE_CASE ,MAX_SUBST - INTEGER MAX_CYCLE - PARAMETER (MAX_CYCLE=20) - INTEGER N_CYCLE, ITX_CYCLE(MAX_CYCLE) - REAL SYM_CYCLE(MAX_CYCLE) - EQUIVALENCE (NMESH1,NMESHN) - EQUIVALENCE (MESH1,MESHN) - INTEGER IBUFFR(400) - REAL BUFFER(400) - INTEGER NCHSAVE - PARAMETER (NCHSAVE=2*512) - INTEGER*4 ICHSAVE(NCHSAVE) - INTEGER*4 IVRPTR(15) - CHARACTER*512 OUTSTR,C_FILE, C_NAME, C_SELECT - CHARACTER C_TIT_ESCAPE*1,C_TIT_SUBSTITUTE*2 - INTEGER N_FILE, N_NAME, N_SELECT - CHARACTER*8 PXNAME - CHARACTER*64 INPFMT - LOGICAL LTDATA, OUTSID(4) - COMMON /T2COM/ PXNAME, REDUCE, TITX, TITY ,XFRM12, XFRM13, XFRM1 - *4, XFRM23 ,XFRM24, XFRM34 ,XVARSX ,TITSIZ, GRDSYM, GRDSIZ, CIRS - *IZ, ASIZE, AFLARE ,SMSZDF, ORAXES, EYEDIR, VUEDIR, VUECEN ,VERTC - *L, EYESEP, SCRD, SCRZ, EYEDIS, EYEPNT ,XYPART, BARSIZ, TIKSIZ, XY - *ZBAS, TTHETA ,TPHI, FRELBL, IPATRN, NPATRN, PATRN ,SCLPRM, WINDO - *W, SCREEN, SYMBOL, NOSYMB ,FACTXY, LBLSIZ, SYMSIZ, XYZLIM, WORLD - *,RADRMX, RADRMN, RADAMN, RADANG, RADX0, RADY0, XUNUSD ,USRKBD, U - *SRSCR, PLTFIL ,ITITDT, LENCRD ,INPFMT, GRDTYP, LINWID, LINCOL, L - *INTEX, TITCON, ITCNTR ,IUNUSD, NXYZ1, NXYZ2 ,LBLCHR, NDIMNS, IBL - *KTP, IDIMNS ,NMESH1, NMESH2, MESH1, MESH2, MESH3, NFIELD ,IFIELD - *, NINCR ,IVARBL, IVRPTR ,LINEAR, NONLIN ,NPOINT, LETSET ,MXECH - *O, LINES, MAXLNS ,AXANG, MESH2D, REDFAC, GRDTEX, OUTTEX, IAXTEX, - *TITEX, DSCAL ,OUTSTR, IPROP, IHTEX, IBLINK, IERASE, LABTEX, TICTE - *X, NXYLIM, PATSZ ,MARGIN, PSCR, ITXPRI, ITXSEC, OREAL, OCPU, CSCR - *D, OUTSID ,TITLIN, TITINX, TITZ, TITX1, TITY1, LTDATA, NPLOTS, RE - *VLEV ,LBLFMT, IYEAR, IMONTH, IDAY, ISIGFG ,DATPTS, ERRPTS, DATXM - *N, DATXMX, DATYMN, DATYMX, DATZMN, DATZMX ,DATSUM, ERRSUM, DATAVE - *, ERRAVE, DATCEN, ERRCEN, DATSTD, ERRSTD ,NCSETS, NCCOL, NCROW, F - *MARKER, H2STAT, TITFAC, TITLOC, TITMAR ,TIKFAC, IWINLEV, WINREL, - *WINABS, WINLIM ,ICPOIN, LEVREP, IREPCT, SYDIR, GRDIR, NMESH0, EXY - *ZLIM, IVPTR ,TITLMX, NXYZDEF1, NXYZDEF2, IFILE_CASE, N_CYCLE, ITX - *_CYCLE ,SYM_CYCLE, PLOT_EXTENT, FILL_ANGLE, FILL_WIDTH, FILL_TEX - *,FILL_INDEX ,N_LINES ,DSLOPE ,MAX_SUBST, BARBRK ,I_VORDER,SHADOW - *TYP,SHADOWTEX - COMMON /T2SCRT/ BUFFER, IBUFFR, N_FILE,N_NAME,N_SELECT, ICHSAVE - COMMON /T2_CHAR/ C_TIT_ESCAPE,C_TIT_SUBSTITUTE - COMMON /T2_SCRT/ C_FILE, C_NAME, C_SELECT - INTEGER JOUFIL, ERRFIL, OUTFIL, DBGFIL, INPFIL, NINMAX - PARAMETER (NINMAX=20) - INTEGER NINP(NINMAX) - COMMON /T2TRBK/NINP, JOUFIL, ERRFIL, OUTFIL, DBGFIL, INPFIL - CHARACTER*512 STRNG, STJOU - LOGICAL LTOKEN - REAL FLOTNG - INTEGER INTERP, KEYORD, NSTRNG, MAXSTR, NSTJOU, LSTJOU, NTOKEN - INTEGER*4 INTEG - COMMON /TOKENC/ INTERP, INTEG, FLOTNG, KEYORD, NSTRNG, MAXSTR, ST - *RNG, NSTJOU, LSTJOU, STJOU, LTOKEN, NTOKEN - CHARACTER*80 PRMP1, PRMP2 - INTEGER NPRMP1, NPRMP2 - COMMON /T2PRMP/NPRMP1, PRMP1, NPRMP2, PRMP2 - LOGICAL LTEMP,INTRAC - EXTERNAL INTRAC - INTEGER I - CHARACTER DEVNAM*256 - CHARACTER TDINIT*20,DEFVAL*80,DEFSTR*80 - LOGICAL T2_VIRT,TDSHOW,DMMY,SIGREF - DATA INFO/10*0/ - DATA EXT/'.TOP'/ - DATA DEFLT/'4013 INTERACTIVE'/ - DATA DEVNAM/' '/,ISAFILE/.FALSE./ - DATA TDINIT/'/.topdrawrc'/ - DATA DEFVAL,DEFSTR/2*' '/ - OUTFIL=-8 - INPFIL=9 - DBGFIL=8 - ERRFIL=6 - IF(INTRAC(I)) THEN - JOUFIL=-7 - ELSE - JOUFIL=0 - ENDIF - DO I=1,IARGC() - CALL GETARG(I,TEXT) - IF (TEXT(1:1).NE.'-') THEN - IF (DEVNAM.EQ.'-d') THEN - DEVNAM=TEXT - ELSEIF (DEFVAL.EQ.'-V') THEN - DEFVAL='TD_V_'//TEXT - CALL T2UPCS(DEFVAL) - IF (PUTENV(DEFVAL(:T2BTRIM(DEFVAL))).NE.0) GOTO 91000 - ELSEIF (DEFSTR.EQ.'-S') THEN - DEFSTR='TD_S_'//TEXT - CALL T2UPCS(DEFSTR(:MAX(INDEX(DEFSTR,'='),5))) - IF (PUTENV(DEFSTR(:T2BTRIM(DEFSTR))).NE.0) GOTO 91000 - ELSE - IF (ISAFILE) GOTO 91000 ! duplicate file - N=T2BTRIM(TEXT) - INQUIRE(FILE=TEXT(:N),EXIST=ISAFILE) - IF (.NOT.ISAFILE) THEN - TEXT(N+1:)='.top' - INQUIRE(FILE=TEXT(:N+4),EXIST=ISAFILE) - IF (.NOT.ISAFILE) THEN - TEXT(N+1:)='.tdr' - INQUIRE(FILE=TEXT(:N+4),EXIST=ISAFILE) - ENDIF - ENDIF - IF (.NOT.ISAFILE) THEN - WRITE(*,*) ' Input file not found ' - WRITE(*,*) ' >',TEXT(:N),'<' - CALL EXIT(3) - ENDIF - OPEN(INPFIL,FILE=TEXT,STATUS='OLD',FORM='FORMATTED') - CALL SET_LNTRAC - ENDIF - ELSE - IF (DEVNAM.EQ.'-d'.OR. - * DEFVAL.EQ.'-V'.OR.DEFSTR.EQ.'-S') GOTO 91000 - IF (TEXT(2:2).EQ.'d') THEN - IF (TEXT(3:).NE.' ') THEN - DEVNAM=TEXT(3:) - ELSE - DEVNAM='-d' - ENDIF - ELSEIF (TEXT(2:2).EQ.'V') THEN - IF (TEXT(3:).NE.' ') THEN - DEFVAL='TD_V_'//TEXT(3:) - CALL T2UPCS(DEFVAL) - IF (PUTENV(DEFVAL(:T2BTRIM(DEFVAL))).NE.0) GOTO 91000 - ELSE - DEFVAL='-V' - ENDIF - ELSEIF (TEXT(2:2).EQ.'S') THEN - IF (TEXT(3:).NE.' ') THEN - DEFSTR='TD_S_'//TEXT(3:) - CALL T2UPCS(DEFSTR(:MAX(INDEX(DEFSTR,'='),5))) - IF (PUTENV(DEFSTR(:T2BTRIM(DEFSTR))).NE.0) GOTO 91000 - ELSE - DEFSTR='-S' - ENDIF - ELSE IF (TEXT(2:).EQ.'b') THEN - CALL TD0UGS ! set new TDR (UGS compatible) - ELSE IF (TEXT(2:).EQ.'w' .AND. .NOT.INTRAC()) THEN - CALL SIGSET ! set SIGNAL acceptable - ELSE IF (TEXT(2:).EQ.'h'.OR. - * TEXT(2:).EQ.'-help') THEN - GOTO 91100 - ELSE - GOTO 91000 - ENDIF - ENDIF - ENDDO - CALL GETENV('HOME',TEXT) - N=T2BTRIM(TEXT) - INQUIRE(FILE=TEXT(:N)//TDINIT,EXIST=ISAFILE) - IF (ISAFILE) THEN - OPEN(98,FILE=TEXT(:N)//TDINIT,STATUS='OLD',FORM='FORMATTED') - CALL SET_TDINIT - ENDIF - IF (DEVNAM.EQ.'-d') GOTO 91000 ! no device name - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_PSP' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_PSP=postscr,orient=3' ) - * - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_PS' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_PS=postscr' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_P' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_P=postscr' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_F' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_F=postscr' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_X' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_X=xwindow' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_W' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_W=xwindow' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_D' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_D=xwindow' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_POR' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_POR=qms1200,portrait' ) - * - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_TA' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_TA=qms1200' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_TE' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_TE=tektronix' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_T' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_T=tektronix' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_M' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_M=tektronix' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_S' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_S=tektronix' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_V' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_V=tektronix' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_4' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_4=tektronix' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_C' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_C=tektronix' ) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_2' , TDDEV ) - IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_2=tektronix' ) - TEXT = 'PERMANENT,' - TEXT(11:)=DEVNAM - N = T2BTRIM ( TEXT ) - DEFLT = TEXT(11:) - CALL T2UPCS(DEFLT) - TDDEV = ' ' - CALL GETENV ( 'TD_DEV_'//DEFLT(:N-10),TDDEV ) - IF ( TDDEV .NE. ' ' ) THEN - TEXT(11:) = TDDEV - N = T2BTRIM ( TEXT ) - ENDIF - INFO(1) = N - DO 10131 J=2,10 - INFO(J)=0 -10131 CONTINUE -10132 CONTINUE - CALL TXDEVC(INFO,TEXT) - FLAGS(59)=.TRUE. - FLAGS(57)=.FALSE. -C CALL T2_VIRT(5120) - DMMY=T2_VIRT(5120) ! for unix-fortran - OREAL=RELTIM(0.0) - OCPU=CPUTIM(0.0) -10241 CONTINUE - FLAGS(23)=.FALSE. - CALL T2MAIN(ICODE,' ') - CALL TXVOID - IF (FLAGS(58) .and. ERRFIL.eq.86) THEN - IF(6.gt.0) THEN - WRITE(6,10250) - IF(6.le.NINMAX)NINP(6)=NINP(6)+1 - ENDIF -10250 FORMAT (' ===> Error messages') - REWIND 86 - IF (FLAGS(53)) THEN - LTEMP=.false. - CALL T2WAIT(PRMP2(1:NPRMP2),LTEMP) - IF(.not.LTEMP) goto 10260 - ENDIF -C CALL TDSHOW('ERRORS') - DMMY=TDSHOW('ERRORS') ! for unix-fortran - IF(6.gt.0) THEN - WRITE(6,10270) - IF(6.le.NINMAX)NINP(6)=NINP(6)+1 - ENDIF -10270 FORMAT (' ===> End of error messages') - IF (FLAGS(53)) THEN - LTEMP=.false. - CALL T2WAIT(PRMP2(1:NPRMP2),LTEMP) - ENDIF -10260 CONTINUE - ENDIF - IF (.not.FLAGS(53)) THEN - IF(6.gt.0) THEN - WRITE(6,10280)NPLOTS - IF(6.le.NINMAX)NINP(6)=NINP(6)+1 - ENDIF -10280 FORMAT (' Plot',I3,' Done.') - ELSE - IF(.not. FLAGS(99) .or. SIGREF()) THEN - LTEMP=.true. - CALL T2WAIT(PRMP2(1:NPRMP2),LTEMP) - IF (.not.LTEMP) THEN - IF (INPFIL.eq.9) ICODE=1 - DO 10291 I=INPFIL,9+1,-1 - CLOSE(UNIT=I) -10291 CONTINUE -10292 CONTINUE - INPFIL=9 - ENDIF - ENDIF - ENDIF - IF(ICODE.eq.1)GOTO 10242 - IF (FLAGS(58)) THEN - REWIND 86 - FLAGS(58)=.false. - ENDIF - CALL TXNEXT - CALL T2REST - GOTO 10241 -10242 CONTINUE - CALL TXEND - CALL EXIT(0) -91000 WRITE(*,*) ' Command line invalid \n' -91100 WRITE(*,*) ' Usage: td [options] [filename] ' - WRITE(*,*) ' -d device' - WRITE(*,*) ' xwindow (default), postscr, tek4010' - WRITE(*,*) ' -b : UGS-compatible CASE control' - WRITE(*,*) ' (default is Old-Topdraw type)' - WRITE(*,*) ' -V variable=value' - WRITE(*,*) ' -S variable="string"' - WRITE(*,*) ' -w : wait for signal (as subprocess)' - WRITE(*,*) ' -h, --help : show this message' - CALL EXIT(3) - END +c PROGRAM TD +c IMPLICIT NONE +c INTEGER PUTENV +c INTEGER IARGC +c INTEGER NCARG +c INTEGER T2BTRIM +c LOGICAL ISAFILE +c REAL CPUTIM,RELTIM +c INTEGER I,J,N,IOSTAT,ICODE +c INTEGER INFO(10) +c CHARACTER DEFLT*16, TEXT*256, EXT*4, TDDEV*80 +c COMMON /T2FLGC/ FLAGS(200), LTRAP,LHANDL,LSYERR,LSCREV +c LOGICAL FLAGS, LTRAP,LHANDL,LSYERR,LSCREV(3) +c INTEGER RELFLAG +c PARAMETER (RELFLAG=151) +c INTEGER IWINLEV +c INTEGER NWINLEV , MAX_FILL +c PARAMETER (NWINLEV =4) +c PARAMETER (MAX_FILL=4) +c REAL GRDSYM, GRDSIZ, DATDAT(2,8), H2STAT(12), TITLIN(4), TITFA +c *C(4), TITLOC(4), TITMAR(4), TITLMX(4), TIKFAC, TITINX, TITX1, TIT +c *Y1, TITX, TITY, TITZ, TITSIZ, TITCON(5), REVLEV, REDUCE(5), XFR +c *M12(12), XFRM13(12), XFRM14(12), XFRM23(12), XFRM24(12), XFRM34(6 +c *), XVARSX(20), CIRSIZ(2,3), ASIZE, AFLARE, SMSZDF, ORAXES(3), EY +c *EDIR(3), VUEDIR(3), VUECEN(3), VERTCL(3), EYESEP, SCRD, SCRZ, EYE +c *DIS, EYEPNT(3), XYPART(2, 2), BARSIZ(3), BARBRK(3), TIKSIZ(3), XY +c *ZBAS(3), TTHETA, TPHI, FRELBL(4), PATRN(20,30), SCLPRM(10,3), WI +c *NDOW(4), SCREEN(2), SYMBOL, NOSYMB, FACTXY(19), LBLSIZ, SYMSIZ, X +c *YZLIM(3,2), WORLD(3), RADRMX, RADRMN, RADAMN, RADANG, RADX0, RADY +c *0, XUNUSD(6), AXANG(3), REDFAC, DSCAL, PATSZ, MARGIN(4), PSCR(2 +c *), OREAL, OCPU, CSCRD, DATPTS, ERRPTS, DATXMN, DATXMX, DATYMN, DA +c *TYMX, DATZMN, DATZMX, DATSUM, ERRSUM, DATAVE, ERRAVE, DATCEN, ERR +c *CEN, DATSTD, ERRSTD, WINREL(2,2,NWINLEV),WINABS(2,2,NWINLEV),WINL +c *IM(2,2), FMARKER(3,8), SYDIR(3), GRDIR(3), EXYZLIM(3,2), DSLOPE(2 +c *,2) +c REAL PLOT_EXTENT(2,2),FILL_ANGLE(MAX_FILL),FILL_WIDTH(MAX_FILL) +c INTEGER FILL_INDEX, FILL_TEX(MAX_FILL), N_LINES(6) +c EQUIVALENCE (DATDAT, DATPTS) +c INTEGER MAXREP +c PARAMETER (MAXREP=5) +c INTEGER IPATRN, NPATRN(30), NXYLIM(3,2), NPLOTS, NCSETS, NCCOL, N +c *CROW, IYEAR, IMONTH, IDAY, ISIGFG, ITXPRI, ITXSEC, ITITDT(3), L +c *ENCRD, IPROP, IHTEX, IBLINK, IERASE, ITCNTR, IUNUSD, NXYZ1(3), +c *NXYZ2(3), LBLFMT(3), LBLCHR(3), NDIMNS(3), IBLKTP, IDIMNS, NMES +c *H0, NMESH1, NMESH2, MESH1, MESH2, MESH3, MESH2D, MESHN(3), NMESHN( +c *2), NFIELD, IFIELD(19), NINCR, NPOINT, IVARBL(19), IVPTR(19), I_ +c *VORDER(19,2), LINEAR(4), NONLIN(4), MXECHO, LINES, MAXLNS, USRK +c *BD, USRSCR, PLTFIL, LINWID, LINCOL, LINTEX, ICPOIN(3), IREPCT(MA +c *XREP), LEVREP, GRDTYP, GRDTEX, OUTTEX, IAXTEX, TITEX, LETSET, LAB +c *TEX, TICTEX, SHADOWTYP,SHADOWTEX, NXYZDEF1(10), NXYZDEF2(10), IF +c *ILE_CASE ,MAX_SUBST +c INTEGER MAX_CYCLE +c PARAMETER (MAX_CYCLE=20) +c INTEGER N_CYCLE, ITX_CYCLE(MAX_CYCLE) +c REAL SYM_CYCLE(MAX_CYCLE) +c EQUIVALENCE (NMESH1,NMESHN) +c EQUIVALENCE (MESH1,MESHN) +c INTEGER IBUFFR(400) +c REAL BUFFER(400) +c INTEGER NCHSAVE +c PARAMETER (NCHSAVE=2*512) +c INTEGER*4 ICHSAVE(NCHSAVE) +c INTEGER*4 IVRPTR(15) +c CHARACTER*512 OUTSTR,C_FILE, C_NAME, C_SELECT +c CHARACTER C_TIT_ESCAPE*1,C_TIT_SUBSTITUTE*2 +c INTEGER N_FILE, N_NAME, N_SELECT +c CHARACTER*8 PXNAME +c CHARACTER*64 INPFMT +c LOGICAL LTDATA, OUTSID(4) +c COMMON /T2COM/ PXNAME, REDUCE, TITX, TITY ,XFRM12, XFRM13, XFRM1 +c *4, XFRM23 ,XFRM24, XFRM34 ,XVARSX ,TITSIZ, GRDSYM, GRDSIZ, CIRS +c *IZ, ASIZE, AFLARE ,SMSZDF, ORAXES, EYEDIR, VUEDIR, VUECEN ,VERTC +c *L, EYESEP, SCRD, SCRZ, EYEDIS, EYEPNT ,XYPART, BARSIZ, TIKSIZ, XY +c *ZBAS, TTHETA ,TPHI, FRELBL, IPATRN, NPATRN, PATRN ,SCLPRM, WINDO +c *W, SCREEN, SYMBOL, NOSYMB ,FACTXY, LBLSIZ, SYMSIZ, XYZLIM, WORLD +c *,RADRMX, RADRMN, RADAMN, RADANG, RADX0, RADY0, XUNUSD ,USRKBD, U +c *SRSCR, PLTFIL ,ITITDT, LENCRD ,INPFMT, GRDTYP, LINWID, LINCOL, L +c *INTEX, TITCON, ITCNTR ,IUNUSD, NXYZ1, NXYZ2 ,LBLCHR, NDIMNS, IBL +c *KTP, IDIMNS ,NMESH1, NMESH2, MESH1, MESH2, MESH3, NFIELD ,IFIELD +c *, NINCR ,IVARBL, IVRPTR ,LINEAR, NONLIN ,NPOINT, LETSET ,MXECH +c *O, LINES, MAXLNS ,AXANG, MESH2D, REDFAC, GRDTEX, OUTTEX, IAXTEX, +c *TITEX, DSCAL ,OUTSTR, IPROP, IHTEX, IBLINK, IERASE, LABTEX, TICTE +c *X, NXYLIM, PATSZ ,MARGIN, PSCR, ITXPRI, ITXSEC, OREAL, OCPU, CSCR +c *D, OUTSID ,TITLIN, TITINX, TITZ, TITX1, TITY1, LTDATA, NPLOTS, RE +c *VLEV ,LBLFMT, IYEAR, IMONTH, IDAY, ISIGFG ,DATPTS, ERRPTS, DATXM +c *N, DATXMX, DATYMN, DATYMX, DATZMN, DATZMX ,DATSUM, ERRSUM, DATAVE +c *, ERRAVE, DATCEN, ERRCEN, DATSTD, ERRSTD ,NCSETS, NCCOL, NCROW, F +c *MARKER, H2STAT, TITFAC, TITLOC, TITMAR ,TIKFAC, IWINLEV, WINREL, +c *WINABS, WINLIM ,ICPOIN, LEVREP, IREPCT, SYDIR, GRDIR, NMESH0, EXY +c *ZLIM, IVPTR ,TITLMX, NXYZDEF1, NXYZDEF2, IFILE_CASE, N_CYCLE, ITX +c *_CYCLE ,SYM_CYCLE, PLOT_EXTENT, FILL_ANGLE, FILL_WIDTH, FILL_TEX +c *,FILL_INDEX ,N_LINES ,DSLOPE ,MAX_SUBST, BARBRK ,I_VORDER,SHADOW +c *TYP,SHADOWTEX +c COMMON /T2SCRT/ BUFFER, IBUFFR, N_FILE,N_NAME,N_SELECT, ICHSAVE +c COMMON /T2_CHAR/ C_TIT_ESCAPE,C_TIT_SUBSTITUTE +c COMMON /T2_SCRT/ C_FILE, C_NAME, C_SELECT +c INTEGER JOUFIL, ERRFIL, OUTFIL, DBGFIL, INPFIL, NINMAX +c PARAMETER (NINMAX=20) +c INTEGER NINP(NINMAX) +c COMMON /T2TRBK/NINP, JOUFIL, ERRFIL, OUTFIL, DBGFIL, INPFIL +c CHARACTER*512 STRNG, STJOU +c LOGICAL LTOKEN +c REAL FLOTNG +c INTEGER INTERP, KEYORD, NSTRNG, MAXSTR, NSTJOU, LSTJOU, NTOKEN +c INTEGER*4 INTEG +c COMMON /TOKENC/ INTERP, INTEG, FLOTNG, KEYORD, NSTRNG, MAXSTR, ST +c *RNG, NSTJOU, LSTJOU, STJOU, LTOKEN, NTOKEN +c CHARACTER*80 PRMP1, PRMP2 +c INTEGER NPRMP1, NPRMP2 +c COMMON /T2PRMP/NPRMP1, PRMP1, NPRMP2, PRMP2 +c LOGICAL LTEMP,INTRAC +c EXTERNAL INTRAC +c INTEGER I +c CHARACTER DEVNAM*256 +c CHARACTER TDINIT*20,DEFVAL*80,DEFSTR*80 +c LOGICAL T2_VIRT,TDSHOW,DMMY,SIGREF +c DATA INFO/10*0/ +c DATA EXT/'.TOP'/ +c DATA DEFLT/'4013 INTERACTIVE'/ +c DATA DEVNAM/' '/,ISAFILE/.FALSE./ +c DATA TDINIT/'/.topdrawrc'/ +c DATA DEFVAL,DEFSTR/2*' '/ +c OUTFIL=-8 +c INPFIL=9 +c DBGFIL=8 +c ERRFIL=6 +c IF(INTRAC(I)) THEN +c JOUFIL=-7 +c ELSE +c JOUFIL=0 +c ENDIF +c DO I=1,IARGC() +c CALL GETARG(I,TEXT) +c IF (TEXT(1:1).NE.'-') THEN +c IF (DEVNAM.EQ.'-d') THEN +c DEVNAM=TEXT +c ELSEIF (DEFVAL.EQ.'-V') THEN +c DEFVAL='TD_V_'//TEXT +c CALL T2UPCS(DEFVAL) +c IF (PUTENV(DEFVAL(:T2BTRIM(DEFVAL))).NE.0) GOTO 91000 +c ELSEIF (DEFSTR.EQ.'-S') THEN +c DEFSTR='TD_S_'//TEXT +c CALL T2UPCS(DEFSTR(:MAX(INDEX(DEFSTR,'='),5))) +c IF (PUTENV(DEFSTR(:T2BTRIM(DEFSTR))).NE.0) GOTO 91000 +c ELSE +c IF (ISAFILE) GOTO 91000 ! duplicate file +c N=T2BTRIM(TEXT) +c INQUIRE(FILE=TEXT(:N),EXIST=ISAFILE) +c IF (.NOT.ISAFILE) THEN +c TEXT(N+1:)='.top' +c INQUIRE(FILE=TEXT(:N+4),EXIST=ISAFILE) +c IF (.NOT.ISAFILE) THEN +c TEXT(N+1:)='.tdr' +c INQUIRE(FILE=TEXT(:N+4),EXIST=ISAFILE) +c ENDIF +c ENDIF +c IF (.NOT.ISAFILE) THEN +c WRITE(*,*) ' Input file not found ' +c WRITE(*,*) ' >',TEXT(:N),'<' +c CALL EXIT(3) +c ENDIF +c OPEN(INPFIL,FILE=TEXT,STATUS='OLD',FORM='FORMATTED') +c CALL SET_LNTRAC +c ENDIF +c ELSE +c IF (DEVNAM.EQ.'-d'.OR. +c * DEFVAL.EQ.'-V'.OR.DEFSTR.EQ.'-S') GOTO 91000 +c IF (TEXT(2:2).EQ.'d') THEN +c IF (TEXT(3:).NE.' ') THEN +c DEVNAM=TEXT(3:) +c ELSE +c DEVNAM='-d' +c ENDIF +c ELSEIF (TEXT(2:2).EQ.'V') THEN +c IF (TEXT(3:).NE.' ') THEN +c DEFVAL='TD_V_'//TEXT(3:) +c CALL T2UPCS(DEFVAL) +c IF (PUTENV(DEFVAL(:T2BTRIM(DEFVAL))).NE.0) GOTO 91000 +c ELSE +c DEFVAL='-V' +c ENDIF +c ELSEIF (TEXT(2:2).EQ.'S') THEN +c IF (TEXT(3:).NE.' ') THEN +c DEFSTR='TD_S_'//TEXT(3:) +c CALL T2UPCS(DEFSTR(:MAX(INDEX(DEFSTR,'='),5))) +c IF (PUTENV(DEFSTR(:T2BTRIM(DEFSTR))).NE.0) GOTO 91000 +c ELSE +c DEFSTR='-S' +c ENDIF +c ELSE IF (TEXT(2:).EQ.'b') THEN +c CALL TD0UGS ! set new TDR (UGS compatible) +c ELSE IF (TEXT(2:).EQ.'w' .AND. .NOT.INTRAC()) THEN +c CALL SIGSET ! set SIGNAL acceptable +c ELSE IF (TEXT(2:).EQ.'h'.OR. +c * TEXT(2:).EQ.'-help') THEN +c GOTO 91100 +c ELSE +c GOTO 91000 +c ENDIF +c ENDIF +c ENDDO +c CALL GETENV('HOME',TEXT) +c N=T2BTRIM(TEXT) +c INQUIRE(FILE=TEXT(:N)//TDINIT,EXIST=ISAFILE) +c IF (ISAFILE) THEN +c OPEN(98,FILE=TEXT(:N)//TDINIT,STATUS='OLD',FORM='FORMATTED') +c CALL SET_TDINIT +c ENDIF +c IF (DEVNAM.EQ.'-d') GOTO 91000 ! no device name +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_PSP' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_PSP=postscr,orient=3' ) +c * +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_PS' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_PS=postscr' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_P' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_P=postscr' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_F' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_F=postscr' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_X' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_X=xwindow' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_W' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_W=xwindow' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_D' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_D=xwindow' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_POR' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_POR=qms1200,portrait' ) +c * +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_TA' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_TA=qms1200' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_TE' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_TE=tektronix' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_T' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_T=tektronix' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_M' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_M=tektronix' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_S' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_S=tektronix' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_V' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_V=tektronix' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_4' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_4=tektronix' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_C' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_C=tektronix' ) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_2' , TDDEV ) +c IF ( TDDEV .EQ. ' ' ) I = PUTENV ( 'TD_DEV_2=tektronix' ) +c TEXT = 'PERMANENT,' +c TEXT(11:)=DEVNAM +c N = T2BTRIM ( TEXT ) +c DEFLT = TEXT(11:) +c CALL T2UPCS(DEFLT) +c TDDEV = ' ' +c CALL GETENV ( 'TD_DEV_'//DEFLT(:N-10),TDDEV ) +c IF ( TDDEV .NE. ' ' ) THEN +c TEXT(11:) = TDDEV +c N = T2BTRIM ( TEXT ) +c ENDIF +c INFO(1) = N +c DO 10131 J=2,10 +c INFO(J)=0 +c10131 CONTINUE +c10132 CONTINUE +c CALL TXDEVC(INFO,TEXT) +c FLAGS(59)=.TRUE. +c FLAGS(57)=.FALSE. +cC CALL T2_VIRT(5120) +c DMMY=T2_VIRT(5120) ! for unix-fortran +c OREAL=RELTIM(0.0) +c OCPU=CPUTIM(0.0) +c10241 CONTINUE +c FLAGS(23)=.FALSE. +c CALL T2MAIN(ICODE,' ') +c CALL TXVOID +c IF (FLAGS(58) .and. ERRFIL.eq.86) THEN +c IF(6.gt.0) THEN +c WRITE(6,10250) +c IF(6.le.NINMAX)NINP(6)=NINP(6)+1 +c ENDIF +c10250 FORMAT (' ===> Error messages') +c REWIND 86 +c IF (FLAGS(53)) THEN +c LTEMP=.false. +c CALL T2WAIT(PRMP2(1:NPRMP2),LTEMP) +c IF(.not.LTEMP) goto 10260 +c ENDIF +cC CALL TDSHOW('ERRORS') +c DMMY=TDSHOW('ERRORS') ! for unix-fortran +c IF(6.gt.0) THEN +c WRITE(6,10270) +c IF(6.le.NINMAX)NINP(6)=NINP(6)+1 +c ENDIF +c10270 FORMAT (' ===> End of error messages') +c IF (FLAGS(53)) THEN +c LTEMP=.false. +c CALL T2WAIT(PRMP2(1:NPRMP2),LTEMP) +c ENDIF +c10260 CONTINUE +c ENDIF +c IF (.not.FLAGS(53)) THEN +c IF(6.gt.0) THEN +c WRITE(6,10280)NPLOTS +c IF(6.le.NINMAX)NINP(6)=NINP(6)+1 +c ENDIF +c10280 FORMAT (' Plot',I3,' Done.') +c ELSE +c IF(.not. FLAGS(99) .or. SIGREF()) THEN +c LTEMP=.true. +c CALL T2WAIT(PRMP2(1:NPRMP2),LTEMP) +c IF (.not.LTEMP) THEN +c IF (INPFIL.eq.9) ICODE=1 +c DO 10291 I=INPFIL,9+1,-1 +c CLOSE(UNIT=I) +c10291 CONTINUE +c10292 CONTINUE +c INPFIL=9 +c ENDIF +c ENDIF +c ENDIF +c IF(ICODE.eq.1)GOTO 10242 +c IF (FLAGS(58)) THEN +c REWIND 86 +c FLAGS(58)=.false. +c ENDIF +c CALL TXNEXT +c CALL T2REST +c GOTO 10241 +c10242 CONTINUE +c CALL TXEND +c CALL EXIT(0) +c91000 WRITE(*,*) ' Command line invalid \n' +c91100 WRITE(*,*) ' Usage: td [options] [filename] ' +c WRITE(*,*) ' -d device' +c WRITE(*,*) ' xwindow (default), postscr, tek4010' +c WRITE(*,*) ' -b : UGS-compatible CASE control' +c WRITE(*,*) ' (default is Old-Topdraw type)' +c WRITE(*,*) ' -V variable=value' +c WRITE(*,*) ' -S variable="string"' +c WRITE(*,*) ' -w : wait for signal (as subprocess)' +c WRITE(*,*) ' -h, --help : show this message' +c CALL EXIT(3) +c END SUBROUTINE DEBUG COMMON /T2FLGC/ FLAGS(200), LTRAP,LHANDL,LSYERR,LSCREV LOGICAL FLAGS, LTRAP,LHANDL,LSYERR,LSCREV(3) --- src/tdend.f.orig Fri Feb 2 02:48:59 1996 +++ src/tdend.f Wed Jul 29 01:13:14 1998 @@ -236,6 +236,9 @@ PARAMETER (RELFLAG=151) INTEGER IAND INTEGER NERR,NARG + save narg + integer*4 narg_c + logical tdcrcl_narg DATA NERR/0/,NARG/0/ C CALL NOARG(NARG) IF (NARG.LT.2 .OR. NARG.GT.6) THEN @@ -260,6 +263,10 @@ FLAGS(23)=.false. CALL T2CRCL(XYZ,IMODE,SIZE,ITXTUR,CRCLIM,rot) TDCRCL=FLAGS(23) + return + entry tdcrcl_narg(narg_c) + narg=narg_c + return END LOGICAL FUNCTION TDARRO(XYZ,SIZE,MODE,JTXTUR) IMPLICIT NONE @@ -503,6 +510,8 @@ EXTERNAL T2INTR,T2REAL REAL HNONE INTEGER NERR,NARG + save narg + integer*4 narg_c DATA HNONE /-666.666/ DATA NERR/0/,NARG/0/ C CALL NOARG(NARG) @@ -552,6 +561,10 @@ 10082 CONTINUE FLAGS(30)=.FALSE. IF(FLAGS(54))CALL TXVOID + return + entry tdhist_narg(narg_c) + narg = narg_c + return END SUBROUTINE TDJOIN(NP,X,Y,DX,DY,LEVEL,MODE,Z,DZ) IMPLICIT NONE @@ -659,6 +672,9 @@ EXTERNAL T2INTR,T2REAL REAL HNONE INTEGER NERR,NARG + save narg + integer*4 narg_c + DATA HNONE /-666.666/ DATA NERR/0/,NARG/0/ C CALL NOARG(NARG) @@ -700,6 +716,10 @@ ENDIF FLAGS(30)=.FALSE. IF(FLAGS(54))CALL TXVOID + return + entry tdjoin_narg(narg_c) + narg=narg_c + return END SUBROUTINE TDLIMS(CARDIN,NP,VALS,ERRS) IMPLICIT NONE @@ -1329,6 +1349,8 @@ CHARACTER*2 CSYM REAL HNONE INTEGER NERR,NARG + save narg + integer*4 narg_c DATA HNONE /-666.666/ DATA CSYM/' '/ DATA NERR/0/,NARG/0/ @@ -1373,6 +1395,10 @@ LINCOL=LCSAV LINWID=LWSAV FLAGS(30)=.FALSE. + return + entry tdplot_narg(narg_c) + narg=narg_c + return END SUBROUTINE TDPLT(CSYM,NP,X,Y,DX,DY,JTYPE,Z,DZ) IMPLICIT NONE @@ -1487,6 +1513,8 @@ REAL TXSYM REAL HNONE INTEGER NERR,NARG + save narg + integer*4 narg_c DATA HNONE /-666.666/ DATA NERR/0/,NARG/0/ C CALL NOARG(NARG) @@ -1534,6 +1562,9 @@ LINCOL=LCSAV LINWID=LWSAV FLAGS(30)=.FALSE. + return + entry tdplt_narg(narg_c) + narg = narg_c END INTEGER FUNCTION T2INTR(IVALUE) INTEGER*4 IVALUE @@ -2221,12 +2252,12 @@ CALL T2STL1(YVALS,YERRS,HNONE,HNONE, NP,NONLIN(2),IFLAG(3),EXTREM( *3),1,1,1,1) IF (ZVALS(1) .ne. HNONE) THEN - CALL T2STL1(ZVALS,ZERRS,HNONE,NP,NONLIN(3),IFLAG(5),EXTREM(5) ,1, - *1,1,1) + CALL T2STL1(ZVALS,ZERRS,HNONE,hnone, NP,NONLIN(3),IFLAG(5), + & EXTREM(5) ,1,1,1,1) FLAGS(56)=NDIMNS(1).ne.2 ELSE - CALL T2STL1(0.0,ZERRS,HNONE,1,NONLIN(3),IFLAG(5),EXTREM(5),1,1,1,1 - *) + CALL T2STL1(0.0,ZERRS,HNONE,hnone,1,NONLIN(3),IFLAG(5), + & EXTREM(5),1,1,1,1) ENDIF DO 10531 J=1,3 DO 10541 I=1,2 --- src/tdtext.f.orig Fri Sep 15 23:48:45 1995 +++ src/tdtext.f Wed Jul 29 01:13:14 1998 @@ -108,9 +108,12 @@ INTEGER INFOIN(10) CHARACTER*34 STR INTEGER NERR,NARG + integer*4 narg_c + logical tdtext_narg + save narg DATA BLANK/' '/ DATA NERR/0/,NARG/0/ - CALL NOARG(NARG) +c CALL NOARG(NARG) IF (NARG.LT.3 .OR. NARG.GT.6) THEN NERR=NERR+1 CALL T2ERRA(NERR,NARG) @@ -145,6 +148,10 @@ *LEN(CASE))//BLANK(1:IBLANK)) JOUFIL=JOUSAV TDTEXT=FLAGS(23) + return + entry tdtext_narg(narg_c) + narg = narg_c + return END LOGICAL FUNCTION TDSHOW(options) IMPLICIT NONE