Commit 4614f59b authored by Whitney Armstrong's avatar Whitney Armstrong

Initial commit

parents

Too many changes to show.

To preserve performance only 1000 of 1000+ files are displayed.

File added
This diff is collapsed.
This diff is collapsed.
implicit none
real size
integer i
cc
call set_plot_devices(18,6,14,7,0,'CM','LANDSCAPE',1)
call clear_plot
size = 10.
do i = 1, 5
call plot_r(1.,5.,3)
call plot_r(1.,5.+size,2)
call plot_r(1.+size,5.+size,2)
call plot_r(1.+size,5.,2)
call plot_r(1.,5.,2)
size = size*0.7
enddo
call psym(1.,1.,2.,'some string',0.,11)
call flush_plot
call nargsi(1)
call graphics_hardcopy(12)
stop
end
implicit none
cc
call set_plot_devices(18,6,14,7,0,'CM','PORTRAIT',1)
call clear_plot
call setnam('%XLOC',50.)
call setnam('%YLOC',95.)
call setnam('CURSOR',-2.)
call setnam('%TXTHIT',3.)
call setlab('FONT','ROMAN.SWISSL')
call setlab('TEXT',
* 'An example containing many fonts')
call setnam('%YLOC',90.)
call setlab('TEXT',
* '<FGOTHIC.ENGLISH>Gothic example <FSCRIPT.2>Script example')
call setnam('%YLOC',85.)
call setlab('TEXT','<FKANJI4>Kanji example')
call setnam('%YLOC',80.)
call setlab('TEXT','<FCYRILLIC.2>Cyrillic example')
call setnam('%YLOC',70.)
call setlab('TEXT','<FMATH>0123456789 SJKMOPQR')
call flush_plot
call nargsi(1)
call graphics_hardcopy(0)
stop
end
implicit none
real x(50), y(50)
real sf
integer i, itmp
logical*1 pchar(50), ltmp
equivalence (ltmp,itmp)
c
call set_plot_devices(18,6,14,7,0,'CM','PORTRAIT',1)
call clear_plot
c
sf = 25./640.
do i = 1, 10
call hatch_scale(i,sf)
enddo
do i = 1, 50
x(i) = i*10.
y(i) = abs( sin(i/10.) )
itmp = mod(i,10)+1
pchar(i) = ltmp
enddo
call setlab('FONT','TSAN')
call setnam('HISTYP',2.0)
call setnam('MASK',-1.0)
call nargsi(5)
call gplot(x,y,50,1,pchar)
call graphics_hardcopy(0)
stop
end
implicit none
real x(200), y(200), sf, pi
integer i
C Set up the device configuration:
C X window monitor, no second monitor, no bitmap
C units are inches, portrait mode
call set_plot_devices(18,6,0,7,0,'IN','PORTRAIT',1)
call clear_plot
sf = 10./640.
pi = acos(-1.)
do i = 1, 10
call hatch_scale(i,sf)
enddo
do i = 1, 100
x(i) = (i-1)*200./99.
y(i) = 3.*sin(x(i)*pi/180.)
enddo
do i = 101, 199
x(i) = x(200-i)
y(i) = sin(x(i)*3./2.*pi/180.)
enddo
call setlab('font','triumf.2')
call setnam('lintyp',103.)
call setnam('%ylaxis',55.)
call nargsi(4)
call gplot(x,y,199,1)
do i = 1, 10
x(i) = (i-1)*200./9.
y(i) = 3.*sin(x(i)*pi/180.)
enddo
x(11) = x(10)
y(11) = 0.0
x(12) = 300.0
y(12) = 0.0
x(13) = 0.0
y(13) = 0.0
C Use the bottom half of the page
call setnam('%yuaxis',45.)
call setnam('%ylaxis',15.)
call setnam('histyp',1.)
call setnam('lintyp',108.)
C Set the graph scales
call setnam('xmin',0.0)
call setnam('xmax',250.)
call setnam('nlxinc',5.0)
call setnam('ymin',-2.0)
call setnam('ymax',4.0)
call setnam('nlyinc',6.0)
call nargsi(4)
call gplot(x,y,13,1)
write(*,*)'Hit the enter key to end the program'
read(*,*)
stop
end
File added
/* AIX Fortran seems to have no GETC utility function */
#include <stdio.h>
int getc_()
{
return getc(stdin);
}
FUNCTION IBATCH()
LOGICAL IBATCH
C======================================================================C
C This is a UNIX replacement for VMS IBATCH.MAR, which returns C
C TRUE if the process is in batch mode. C
C This version returns TRUE if the standard output (Unit 6) is not C
C connected to a terminal. C
C Note: before calling this function Unit 6 must be opened, either C
C by writing to it or doing an explicit OPEN. C
C FWJ 31-MAR-1993 C
C
C AIX: apparently no 3F ISATTY function, and no success in
C implementing one using a C wrapper for 3 isatty().
C (Probably would clash with Fortran i/o anyway).
C So, use environment variable TRIUMF_TERMINAL_TYPE to set
C batch mode.
C======================================================================C
C LOGICAL ISATTY
C IBATCH=.NOT.ISATTY(6)
CHARACTER*5 NAME
CALL GET_TERMTYPE(NAME)
IBATCH=(NAME.EQ.'BATCH')
RETURN
END
void perror_()
{
perror(" ");
}
C DUMMY VERSION FOR AIX: NO FORTRAN STRUCTURE TYPE
SUBROUTINE PUT_DWG(X,Y,IPEN,ILIN)
WRITE(*,*)'WARNING: PUT_DWG CALLED'
WRITE(*,*)'NOT IMPLEMENTED ON IBM/AIX'
RETURN
END
/* RAN.C F.W. Jones, TRIUMF
*
* Replacement for DEC Fortran intrinsic RAN which currently (<=Version3.1)
* has the problem of occasionally returning numbers slightly greater
* than 1.0.
*
* Usage:
*
* EXTERNAL RAN
* ISEED=1234567
* X=RAN(ISEED)
* X=RAN(ISEED)
* ...etc.
*
* Note: to pick up this routine you must declare EXTERNAL RAN in each
* calling routine!
*
* Note: unlike the standard RAN, this routine does not alter ISEED.
* On the first call, ISEED is used as the seed and its value is recorded.
* On subsequent calls, ISEED is ignored if it is the same as the recorded
* value, and the random sequence continues unaltered. If ISEED is found
* to differ from the recorded value, then it is used as a new seed, its
* value is recorded, and a new random sequence begins.
* This means that to RE-START the sequence with the SAME seed as the
* previous one, the following construct is required:
*
* EXTERNAL RAN
* ISEED=1234567
* C Generate random sequence:
* X=RAN(ISEED) !seed with ISEED
* X=RAN(ISEED) !ISEED ignored
* X=RAN(ISEED) !ISEED ignored
* ...etc. ...
* C Generate the same random sequence:
* DUM=RAN(0) !seed with 0
* X=RAN(ISEED) !seed with ISEED
* X=RAN(ISEED) !ISEED ignored
* X=RAN(ISEED) !ISEED ignored
* ...etc. ...
*/
extern double drand48();
extern void srand48();
float ran_(iseed)
long *iseed;
{
static long iseed_save=0;
float x;
if (*iseed!=iseed_save) {
/* printf("seeding with %d\n",*iseed); */
srand48(*iseed);
iseed_save = *iseed;
}
x = (float)drand48();
return(x);
}
C DUMMY VERSION FOR AIX: NO FORTRAN ENCODE
SUBROUTINE RICON
WRITE(*,*)'WARNING: RICON CALLED'
WRITE(*,*)'NOT IMPLEMENTED YET ON IBM/AIX'
RETURN
END
SUBROUTINE TTYNAM(LUNIT,TTYNAME)
C Dummy for AIX which has no built-in TTYNAM
CHARACTER*(*) TTYNAME
TTYNAME='/dev/tty'
RETURN
END
This is a temporary space for hacked routines for ALPHA VMS. FWJ
This diff is collapsed.
SUBROUTINE DO_COMMAND(X,Y,HEIGHT,ANGLE,COMM,LENT,IDCNT,IUCNT
# ,JUSTIFY,PLEN,COSX,SINX,CLASSES,FONT,LENFONT